UI button cleanups

doc/handbook/tools.facts

@@ -12,7 +12,7 @@ ARTICLE: "tools" "Development tools"
 { $subsection "images" } ;
 
 ARTICLE: "listener" "The listener"
-"The listener reads Factor expressions from a stream and evaluates them. The listener is the primary interface to the Factor runtime. Typically, you write Factor code in a text editor, then load it using the listener and test it."
+"The listener evaluates Factor expressions read from a stream. The listener is the primary interface to the Factor runtime. Typically, you write Factor code in a text editor, then load it using the listener and test it."
 $terpri
 "The classical first program can be run in the listener:"
 { $example "\"Hello, world\" print" "Hello, world" }

library/ui/browser.factor

@@ -83,22 +83,25 @@ TUPLE: browser-button object ;
 
 : browser-window ( obj -- ) <browser> "Browser" open-window ;
 
-: new-browser? ( gadget -- ? )
-    find-browser not 3 hand-buttons get-global member? or ;
-
 : browser-button-action ( button -- )
-    [ browser-button-object ] keep dup new-browser? [
+    [ browser-button-object ] keep find-browser [
-        drop browser-window
-    ] [
         find-browser dup save-current browse
-    ] if ;
+    ] [
+        browser-window
+    ] if* ;
+
+: browser-button-gestures ( gadget -- )
+    [
+        [ browser-button-object browser-window ] if-clicked
+    ] [ button-up 3 ] set-action ;
 
 C: browser-button ( gadget object -- button )
     [ set-browser-button-object ] keep
     [
         >r [ browser-button-action ] <roll-button> r>
         set-gadget-delegate
-    ] keep ;
+    ] keep
+    dup browser-button-gestures ;
 
 M: browser-button gadget-help ( button -- string )
     browser-button-object dup word? [ synopsis ] [ summary ] if ;

library/ui/buttons.factor

@@ -5,7 +5,7 @@ USING: gadgets gadgets-borders gadgets-layouts gadgets-theme
 generic io kernel lists math namespaces sequences sequences
 styles threads ;
 
-TUPLE: button rollover? pressed? ;
+TUPLE: button rollover? pressed? quot ;
 
 : button-down? ( -- ? )
     hand-buttons get-global empty? not ;
@@ -18,21 +18,17 @@ TUPLE: button rollover? pressed? ;
 
 : button-update ( button -- )
     dup mouse-over? over set-button-rollover?
-    dup button-rollover? button-down? and
+    dup mouse-clicked? button-down? and over set-button-pressed?
-    over mouse-clicked? and over set-button-pressed?
     relayout-1 ;
 
-: button-clicked ( button -- )
+: if-clicked ( button quot -- )
-    #! If the mouse is released while still inside the button,
+    >r dup button-update dup button-rollover? r> when drop ;
-    #! fire an action gesture.
-    dup button-update dup button-rollover?
-    [ [ action ] swap handle-gesture ] when drop ;
 
-: button-action ( action -- quot )
+: button-clicked ( button -- )
-    [ [ swap handle-gesture drop ] cons ] [ [ drop ] ] if* ;
+    dup button-quot if-clicked ;
 
 : button-gestures ( button quot -- )
-    dupd [ action ] set-action
+    over set-button-quot
     dup [ button-clicked ] [ button-up ] set-action
     dup [ button-update ] [ button-down ] set-action
     dup [ button-update ] [ mouse-leave ] set-action

library/ui/gestures.factor

@@ -143,8 +143,8 @@ V{ } clone hand-buttons set-global
 
 : send-button-up ( button# loc world -- )
     move-hand
-    dup [ button-up ] button-gesture
+    dup hand-buttons get-global delete
-    hand-buttons get-global delete ;
+    [ button-up ] button-gesture ;
 
 : send-wheel ( up/down loc world -- )
     move-hand