Even more UI documentation

TODO.txt

@@ -5,6 +5,7 @@
 - browser: tile titles should respond to right-clicks and/or have a
   menu popup button
 - ui docs
+- calling 'see' with an unknown method should be an error
 
 + 0.88:
 

core/ui/gadgets.facts

@@ -91,6 +91,7 @@ HELP: <gadget>
 HELP: delegate>gadget
 { $values { "tuple" tuple } }
 { $description "Sets the tuple's delegate to a new " { $link gadget } "." }
+{ $side-effects "tuple" }
 { $see-also <gadget> } ;
 
 HELP: relative-loc

core/ui/layouts.facts

@@ -83,6 +83,7 @@ HELP: <pack>
 HELP: delegate>pack
 { $values { "orientation" "either " { $snippet "{ 1 0 }" } " or " { $snippet "{ 0 1 }" } } { "tuple" tuple } }
 { $description "Sets the tuple's delegate to a new pack." }
+{ $side-effects "tuple" }
 { $see-also <pack> <pile> <shelf> } ;
 
 HELP: <pile>

core/ui/load.factor

@@ -49,8 +49,10 @@ PROVIDE: core/ui
     "gestures.facts"
     "hierarchy.facts"
     "layouts.facts"
+    "models.facts"
     "paint.facts"
     "text.facts"
+    "timers.facts"
     "world.facts"
     "windows.facts"
     "text/editor.facts"

core/ui/models.factor

@@ -3,7 +3,7 @@
 IN: models
 USING: generic kernel math sequences timers ;
 
-TUPLE: model connections value dependencies ref ;
+TUPLE: model value connections dependencies ref ;
 
 C: model ( value -- model )
     [ set-model-value ] keep
@@ -11,10 +11,12 @@ C: model ( value -- model )
     V{ } clone over set-model-dependencies
     0 over set-model-ref ;
 
-: add-dependency ( model model -- )
+M: model equal? eq? ;
+
+: add-dependency ( dep model -- )
     model-dependencies push ;
 
-: remove-dependency ( model model -- )
+: remove-dependency ( dep model -- )
     model-dependencies delete ;
 
 DEFER: add-connection
@@ -50,11 +52,11 @@ DEFER: remove-connection
 
 GENERIC: model-changed ( observer -- )
 
-: add-connection ( obj model -- )
+: add-connection ( observer model -- )
     dup model-connections empty? [ dup activate-model ] when
     model-connections push ;
 
-: remove-connection ( obj model -- )
+: remove-connection ( observer model -- )
     [ model-connections delete ] keep
     dup model-connections empty? [ dup deactivate-model ] when
     drop ;
@@ -74,7 +76,7 @@ M: model set-model
 : (change-model) ( model quot -- )
     ((change-model)) set-model-value ; inline
 
-: delegate>model ( obj -- )
+: delegate>model ( tuple -- )
     f <model> swap set-delegate ;
 
 TUPLE: filter model quot ;
@@ -127,7 +129,7 @@ C: history ( value -- history )
 : go-forward ( history -- )
     dup history-back over history-forward go-back/forward ;
 
-: add-history
+: add-history ( history -- )
     dup history-forward delete-all
     dup history-back (add-history) ;
 

core/ui/models.facts

@@ -0,0 +1,130 @@
+IN: models
+USING: help generic kernel ;
+
+HELP: model
+{ $class-description "A mutable placeholder for a single value. When the value is changed, a sequence of connected objects are notified. Models have the following slots:"
+    { $list
+        { { $link model-value } " - the value of the model. Use " { $link set-model } " to change the value." }
+        { { $link model-connections } " - a sequence of objects implementing the " { $link model-changed } " generic word, to be notified when the model's value changes." }
+        { { $link model-dependencies } " - a sequence of models which should have this model added to their sequence of connections when activated." }
+        { { $link model-ref } " - a reference count tracking the number of models which depend on this one." }
+    }
+"Other classes may delegate to " { $link model } "."
+} ;
+
+HELP: <model>
+{ $values { "value" object } { "model" "a new " { $link model } } }
+{ $description "Creates a new model with an initial value." } ;
+
+HELP: add-dependency
+{ $values { "dep" model } { "model" model } }
+{ $description "Registers a dependency. When " { $snippet "model" } " is activated, it will be added to " { $snippet "dep" } "'s connections and notified when " { $snippet "dep" } " changes." }
+{ $notes "This word should not be called directly unless you are implementing your own model class." }
+{ $see-also remove-dependency activate-model deactivate-model } ;
+
+HELP: remove-dependency
+{ $values { "dep" model } { "model" model } }
+{ $description "Unregisters a dependency." }
+{ $notes "This word should not be called directly unless you are implementing your own model class." }
+{ $see-also add-dependency activate-model deactivate-model } ;
+
+HELP: model-activated
+{ $values { "model" model } }
+{ $contract "Called after a model has been activated." }
+{ $see-also activate-model deactivate-model } ;
+
+HELP: activate-model
+{ $values { "model" model } }
+{ $description "Increments the reference count of the model. If it was previously zero, this model is added as a connection to all models registered as dependencies by " { $link add-dependency } "." }
+{ $warning "Calls to " { $link activate-model } " and " { $link deactivate-model } " should be balanced to keep the reference counting consistent, otherwise " { $link model-changed } " might be called at the wrong time or not at all." } ;
+
+HELP: deactivate-model
+{ $values { "model" model } }
+{ $description "Decrements the reference count of the model. If it reaches zero, this model is removed as a connection from all models registered as dependencies by " { $link add-dependency } "." }
+{ $warning "Calls to " { $link activate-model } " and " { $link deactivate-model } " should be balanced to keep the reference counting consistent, otherwise " { $link model-changed } " might be called at the wrong time or not at all." } ;
+
+HELP: model-changed
+{ $values { "observer" object } }
+{ $contract "Called to notify observers of a model that the model value has changed as a result of a call to " { $link set-model } ". Observers can be registered with " { $link add-connection } "." }
+{ $see-also remove-connection } ;
+
+HELP: add-connection
+{ $values { "observer" object } { "model" model } }
+{ $contract "Registers an object interested in being notified of changes to the model's value. When the value is changed as a result of a call to " { $link set-model } ", the " { $link model-changed } " word is called on the observer." }
+{ $see-also remove-connection add-dependency } ;
+
+HELP: remove-connection
+{ $values { "observer" object } { "model" model } }
+{ $contract "Unregisters an object no longer interested in being notified of changes to the model's value." }
+{ $see-also add-connection remove-dependency } ;
+
+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 } "." }
+{ $see-also change-model } ;
+
+HELP: set-model-value ( value model -- )
+{ $values { "value" object } { "model" model } }
+{ $description "Changes the value of a model without notifying any observers registered with " { $link add-connection } "." }
+{ $notes "There are very few reasons for user code to call this word. Instead, call " { $link set-model } ", which notifies observers." }
+{ $see-also change-model } ;
+
+HELP: change-model
+{ $values { "model" model } { "quot" "a quotation with stack effect " { $snippet "( obj -- newobj )" } } }
+{ $description "Applies the quotation to the current value of the model to yield a new value, then changes the value of the model to the new value, and calls " { $link model-changed } " on all observers registered with " { $link add-connection } "." }
+{ $see-also set-model } ;
+
+HELP: (change-model)
+{ $values { "model" model } { "quot" "a quotation with stack effect " { $snippet "( obj -- newobj )" } } }
+{ $description "Applies the quotation to the current value of the model to yield a new value, then changes the value of the model to the new value without notifying any observers registered with " { $link add-connection } "." }
+{ $notes "There are very few reasons for user code to call this word. Instead, call " { $link change-model } ", which notifies observers." }
+{ $see-also set-model } ;
+
+HELP: delegate>model
+{ $values { "tuple" tuple } }
+{ $description
+    "Sets the tuple's delegate to a new " { $link model } " with an initial value of " { $link f } "."
+} ;
+
+HELP: filter
+{ $class-description "Filter model values are computed by applying a quotation to the value of another model. Filters are automatically updated when the underlying model changes. Filters are constructed by " { $link <filter> } "." } ;
+
+HELP: <filter>
+{ $values { "model" model } { "quot" "a quotation with stack effect " { $snippet "( obj -- newobj )" } } { "filter" "a new " { $link filter } } }
+{ $description "Creates a new instance of " { $link filter } ". The value of the new filter model is computed by applying the quotation to the value." } ;
+
+HELP: compose
+{ $class-description "Compose model values are computed by collecting the values from a sequence of underlying models into a new sequence. Compose models are automatically updated when underlying models change. Compose models are constructed by " { $link <compose> } "." } ;
+
+HELP: <compose>
+{ $values { "models" "a sequence of models" } { "compose" "a new " { $link compose } } }
+{ $description "Creates a new instance of " { $link compose } ". The value of the new compose model is obtained by mapping " { $link model-value } " over the given sequence of models." } ;
+
+HELP: history
+{ $class-description "History models record a timeline of previous values on calls to " { $link add-history } ", and can travel back and forth on the timeline with " { $link go-back } " and " { $link go-forward } ". History models are constructed by " { $link <history> } "." } ;
+
+HELP: <history>
+{ $values { "value" object } { "history" "a new " { $link history } } }
+{ $description "Creates a new history model with an initial value." }
+{ $see-also add-history go-back go-forward } ;
+
+HELP: go-back
+{ $values { "history" history } }
+{ $description "Restores the previous value and calls " { $link model-changed } " on all observers registered with " { $link add-connection } "." }
+{ $see-also add-history go-forward } ;
+
+HELP: go-forward
+{ $values { "history" history } }
+{ $description "Restores the value set prior to the last call to " { $link go-back } " and calls " { $link model-changed } " on all observers registered with " { $link add-connection } "." }
+{ $see-also add-history go-back } ;
+
+HELP: add-history
+{ $values { "history" history } }
+{ $description "Adds the current value to the history." } ;
+
+HELP: delay
+{ $class-description "Delay models have the same value as their underlying model, however the value only changes after a timer expires. If the underlying model's value changes again before the timer expires, the timer restarts. Delay models are constructed by " { $link <delay> } "." } ;
+
+HELP: <delay>
+{ $values { "model" model } { "timeout" "a positive integer" } { "delay" delay } }
+{ $description "Creates a new instance of " { $link delay } ". A timer of " { $snippet "timeout" } " milliseconds must elapse from the time the underlying model last changed to when the delay model value is changed and its connections are notified." } ;

core/ui/timers.facts

@@ -0,0 +1,22 @@
+IN: timers
+USING: generic help ;
+
+HELP: tick
+{ $values { "object" object } }
+{ $description "Called to notify an object registered with a timer that the timer has fired." }
+{ $see-also add-timer remove-timer do-timers } ;
+
+HELP: add-timer
+{ $values { "object" object } { "delay" "a positive integer" } { "initial" "a positive integer" } }
+{ $description "Registers a timer. Every " { $snippet "delay" } " milliseconds, " { $link tick } " will be called on the object. The initial delay from the time " { $link add-timer } " is called to when " { $link tick } " is first called is " { $snippet "initial" } " milliseconds." }
+{ $see-also remove-timer do-timers } ;
+
+HELP: remove-timer
+{ $values { "object" object } }
+{ $description "Unregisters a timer." }
+{ $see-also add-timer do-timers } ;
+
+HELP: do-timers
+{ $description "Fires all registered timers which are due to fire." }
+{ $notes "This word is automatically called from the UI event loop, however it should be called manually if timers are being used outside of the UI." }
+{ $see-also tick add-timer remove-timer } ;