From 9f6361ff873f68ff1c11c7fb9d0706d1121c70c6 Mon Sep 17 00:00:00 2001
From: slava <slava@factorcode.org>
Date: Sat, 25 Mar 2006 22:41:40 +0000
Subject: [PATCH] UI button cleanups

---
 doc/handbook/tools.facts   |  2 +-
 library/ui/browser.factor  | 19 +++++++++++--------
 library/ui/buttons.factor  | 18 +++++++-----------
 library/ui/gestures.factor |  4 ++--
 4 files changed, 21 insertions(+), 22 deletions(-)

diff --git a/doc/handbook/tools.facts b/doc/handbook/tools.facts
index 3af24c1450..405a06dcb5 100644
--- a/doc/handbook/tools.facts
+++ b/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" }
diff --git a/library/ui/browser.factor b/library/ui/browser.factor
index 5ee01e2816..4f4ebccd14 100644
--- a/library/ui/browser.factor
+++ b/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? [
-        drop browser-window
-    ] [
+    [ browser-button-object ] keep find-browser [
         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 ;
diff --git a/library/ui/buttons.factor b/library/ui/buttons.factor
index 3cdc875241..96adf4f714 100644
--- a/library/ui/buttons.factor
+++ b/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
-    over mouse-clicked? and over set-button-pressed?
+    dup mouse-clicked? button-down? and over set-button-pressed?
     relayout-1 ;
 
-: button-clicked ( button -- )
-    #! If the mouse is released while still inside the button,
-    #! fire an action gesture.
-    dup button-update dup button-rollover?
-    [ [ action ] swap handle-gesture ] when drop ;
+: if-clicked ( button quot -- )
+    >r dup button-update dup button-rollover? r> when drop ;
 
-: button-action ( action -- quot )
-    [ [ swap handle-gesture drop ] cons ] [ [ drop ] ] if* ;
+: button-clicked ( button -- )
+    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
diff --git a/library/ui/gestures.factor b/library/ui/gestures.factor
index 79667f1d7f..3806771521 100644
--- a/library/ui/gestures.factor
+++ b/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
-    hand-buttons get-global delete ;
+    dup hand-buttons get-global delete
+    [ button-up ] button-gesture ;
 
 : send-wheel ( up/down loc world -- )
     move-hand