models: adding ?set-model.

diff --git a/basis/models/models-docs.factor b/basis/models/models-docs.factor
index 80cd0c11e8ba1cb5cbab3ed26e885bb871235bf0..480611b17d1c973edd1d069a1d1ee96597028363 100644 (file)
--- a/basis/models/models-docs.factor
+++ b/basis/models/models-docs.factor
@@ -64,6 +64,10 @@ HELP: set-model
 { $values { "value" object } { "model" model } }
 { $description "Changes the value of a model and calls " { $link model-changed } " on all observers registered with " { $link add-connection } "." } ;
 
+HELP: ?set-model
+{ $values { "value" object } { "model" model } }
+{ $description "Similar to " { $link set-model } ", but only sets the value if the new value is different." } ;
+
 { set-model change-model change-model* (change-model) push-model pop-model } related-words
 
 HELP: change-model

diff --git a/basis/models/models.factor b/basis/models/models.factor
index 65d13df9c4aa2092947c4590e9ddd819f7aaf0cd..59a04f8031620b2c11c7aa2f7ba94b0b17121217 100644 (file)
--- a/basis/models/models.factor
+++ b/basis/models/models.factor
@@ -87,6 +87,9 @@ M: model update-model drop ;
         ] with-locked-model
     ] if ;
 
+: ?set-model ( value model -- )
+    2dup value>> = [ 2drop ] [ set-model ] if ;
+
 : ((change-model)) ( model quot -- newvalue model )
     over [ [ value>> ] dip call ] dip ; inline