diff --git a/basis/io/files/links/links-tests.factor b/basis/io/files/links/links-tests.factor index 2d142ce900..bc03e42f92 100644 --- a/basis/io/files/links/links-tests.factor +++ b/basis/io/files/links/links-tests.factor @@ -1,5 +1,6 @@ -USING: io.directories io.files.links tools.test -io.files.unique tools.files fry ; +USING: io.directories io.files.links tools.test sequences +io.files.unique tools.files fry math kernel math.parser +io.pathnames namespaces ; IN: io.files.links.tests : make-test-links ( n path -- ) diff --git a/basis/models/compose/compose-tests.factor b/basis/models/compose/compose-tests.factor index 16a5ab339c..0644bb6841 100644 --- a/basis/models/compose/compose-tests.factor +++ b/basis/models/compose/compose-tests.factor @@ -1,5 +1,5 @@ USING: arrays generic kernel math models namespaces sequences assocs -tools.test models.compose accessors ; +tools.test models.compose accessors locals ; IN: models.compose.tests ! Test compose @@ -22,3 +22,25 @@ IN: models.compose.tests [ { 4 5 } ] [ "c" get value>> ] unit-test [ ] [ "c" get deactivate-model ] unit-test + +TUPLE: an-observer { i integer } ; + +M: an-observer model-changed nip [ 1+ ] change-i drop ; + +[ 1 0 ] [ + [let* | m1 [ 1 ] + m2 [ 2 ] + c [ { m1 m2 } ] + o1 [ an-observer new ] + o2 [ an-observer new ] | + + o1 m1 add-connection + o2 m2 add-connection + + c activate-model + + "OH HAI" m1 set-model + o1 i>> + o2 i>> + ] +] unit-test \ No newline at end of file diff --git a/basis/models/compose/compose.factor b/basis/models/compose/compose.factor index a2c3385248..386a06781d 100644 --- a/basis/models/compose/compose.factor +++ b/basis/models/compose/compose.factor @@ -18,7 +18,8 @@ TUPLE: compose < model ; M: compose model-changed nip - [ [ value>> ] composed-value ] keep set-model ; + dup [ value>> ] composed-value >>value + notify-connections ; M: compose model-activated dup model-changed ; diff --git a/basis/ui/gadgets/menus/menus.factor b/basis/ui/gadgets/menus/menus.factor index 2aef0b8417..c482f31896 100644 --- a/basis/ui/gadgets/menus/menus.factor +++ b/basis/ui/gadgets/menus/menus.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2005, 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: locals accessors arrays ui.commands ui.gadgets +USING: locals accessors arrays ui.commands ui.operations ui.gadgets ui.gadgets.buttons ui.gadgets.worlds ui.gestures generic hashtables kernel math models namespaces opengl sequences math.vectors ui.gadgets.theme ui.gadgets.packs @@ -54,3 +54,9 @@ M: menu-glass layout* gadget-child prefer ; : show-commands-menu ( target commands -- ) [ dup [ ] ] dip show-menu ; + +: ( target hook -- menu ) + over object-operations ; + +: show-operations-menu ( gadget target -- ) + [ ] show-menu ; \ No newline at end of file diff --git a/basis/ui/gadgets/presentations/presentations.factor b/basis/ui/gadgets/presentations/presentations.factor index 61a55e926b..f05ea5ae5d 100644 --- a/basis/ui/gadgets/presentations/presentations.factor +++ b/basis/ui/gadgets/presentations/presentations.factor @@ -11,8 +11,8 @@ IN: ui.gadgets.presentations TUPLE: presentation < button object hook ; : invoke-presentation ( presentation command -- ) - over dup hook>> call - [ object>> ] dip invoke-command ; + [ [ dup hook>> call ] [ object>> ] bi ] dip + invoke-command ; : invoke-primary ( presentation -- ) dup object>> primary-operation @@ -23,7 +23,7 @@ TUPLE: presentation < button object hook ; invoke-presentation ; : show-mouse-help ( presentation -- ) - dup object>> over show-summary button-update ; + [ [ object>> ] keep show-summary ] [ button-update ] bi ; : ( label object -- button ) swap [ invoke-primary ] presentation new-button @@ -35,18 +35,13 @@ M: presentation ungraft* dup hand-gadget get-global child? [ dup hide-status ] when call-next-method ; -: ( presentation -- menu ) - [ object>> ] - [ dup hook>> curry ] - [ object>> object-operations ] - tri ; - -: operations-menu ( presentation -- ) - dup show-menu ; +: show-operations-menu ( presentation -- ) + [ ] [ object>> ] [ dup hook>> curry ] tri + show-menu ; presentation H{ - { T{ button-down f f 3 } [ operations-menu ] } - { T{ mouse-leave } [ dup hide-status button-update ] } + { T{ button-down f f 3 } [ show-operations-menu ] } + { T{ mouse-leave } [ [ hide-status ] [ button-update ] bi ] } { T{ mouse-enter } [ show-mouse-help ] } ! Responding to motion too allows nested presentations to ! display status help properly, when the mouse leaves a