Merge branch 'master' into new_ui

basis/io/files/links/links-tests.factor

@@ -1,5 +1,6 @@
-USING: io.directories io.files.links tools.test
+USING: io.directories io.files.links tools.test sequences
-io.files.unique tools.files fry ;
+io.files.unique tools.files fry math kernel math.parser
+io.pathnames namespaces ;
 IN: io.files.links.tests
 
 : make-test-links ( n path -- )

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 <model> ]
+            m2 [ 2 <model> ]
+            c [ { m1 m2 } <compose> ]
+            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

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 ;
 

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 <commands-menu> show-menu ;
+
+: <operations-menu> ( target hook -- menu )
+    over object-operations <commands-menu> ;
+
+: show-operations-menu ( gadget target -- )
+    [ ] <operations-menu> show-menu ;

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
+    [ [ dup hook>> call ] [ object>> ] bi ] dip
-    [ object>> ] dip invoke-command ;
+    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 ;
 
 : <presentation> ( 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 ;
 
-: <operations-menu> ( presentation -- menu )
+: show-operations-menu ( presentation -- )
-    [ object>> ]
+    [ ] [ object>> ] [ dup hook>> curry ] tri
-    [ dup hook>> curry ]
+    <operations-menu> show-menu ;
-    [ object>> object-operations ]
-    tri <commands-menu> ;
-
-: operations-menu ( presentation -- )
-    dup <operations-menu> show-menu ;
 
 presentation H{
-    { T{ button-down f f 3 } [ operations-menu ] }
+    { T{ button-down f f 3 } [ show-operations-menu ] }
-    { T{ mouse-leave } [ dup hide-status button-update ] }
+    { 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