From f710a2df78af8644cd5011c46f4eefca5e5832ad Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@factorcode.org>
Date: Mon, 14 Nov 2005 06:54:40 +0000
Subject: [PATCH] UI fix

---
 TODO.FACTOR.txt          |  2 --
 library/ui/events.factor |  9 ++-------
 library/ui/hand.factor   | 17 ++++++++++-------
 library/ui/menus.factor  |  5 ++++-
 library/ui/world.factor  | 11 ++++++++++-
 5 files changed, 26 insertions(+), 18 deletions(-)

diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt
index 0296b147c7..b224ce7681 100644
--- a/TODO.FACTOR.txt
+++ b/TODO.FACTOR.txt
@@ -7,8 +7,6 @@
 - default library names are not useful
 - fix remaining GL issues
 - fix up the min thumb size hack
-- bug: left click to bring up context menu, click splitter bar
-  and pane grows to 100%
 - bug: click tutorial, full screen, the right-most arrow icon
   loses the vertical bar
 - signal handler should not lose stack pointers
diff --git a/library/ui/events.factor b/library/ui/events.factor
index cc602eb253..ffd68f5a76 100644
--- a/library/ui/events.factor
+++ b/library/ui/events.factor
@@ -9,16 +9,11 @@ GENERIC: handle-event ( event -- )
 M: object handle-event ( event -- )
     drop ;
 
-: button-gesture ( button gesture -- )
-    swap add hand get hand-clicked handle-gesture drop ;
-
 M: button-down-event handle-event ( event -- )
-    button-event-button dup hand get button/
-    [ button-down ] button-gesture ;
+    button-event-button button/ ;
 
 M: button-up-event handle-event ( event -- )
-    button-event-button dup hand get button\
-    [ button-up ] button-gesture ;
+    button-event-button button\ ;
 
 : motion-event-loc ( event -- loc )
     dup motion-event-x swap motion-event-y 0 3array ;
diff --git a/library/ui/hand.factor b/library/ui/hand.factor
index dda7dc7820..5b81a784f4 100644
--- a/library/ui/hand.factor
+++ b/library/ui/hand.factor
@@ -16,14 +16,17 @@ TUPLE: hand click-loc click-rel clicked buttons gadget focus ;
 C: hand ( -- hand )
     dup delegate>gadget V{ } clone over set-hand-buttons ;
 
-: button/ ( n hand -- )
-    dup hand-gadget over set-hand-clicked
-    dup screen-loc over set-hand-click-loc
-    dup hand-gadget over relative over set-hand-click-rel
-    hand-buttons push ;
+: button-gesture ( button gesture -- )
+    swap add hand get hand-clicked handle-gesture drop ;
 
-: button\ ( n hand -- )
-    hand-buttons delete ;
+: button/ ( n -- )
+    update-clicked
+    dup hand get hand-buttons push
+    [ button-down ] button-gesture ;
+
+: button\ ( n -- )
+    dup hand get hand-buttons delete
+    [ button-up ] button-gesture ;
 
 : drag-gesture ( hand gadget gesture -- )
     #! Send a gesture like [ drag 2 ].
diff --git a/library/ui/menus.factor b/library/ui/menus.factor
index 33de851c5c..5a3702909a 100644
--- a/library/ui/menus.factor
+++ b/library/ui/menus.factor
@@ -9,9 +9,12 @@ namespaces sequences ;
     hand get [ hand-gadget ] keep 2dup hand-clicked eq?
     [ 2dup set-hand-clicked update-hand ] unless 2drop ;
 
+: retarget-click ( -- )
+    update-hand-gadget update-clicked ;
+
 : menu-actions ( glass -- )
     dup [ drop retarget-drag ] [ drag 1 ] set-action
-    [ drop hide-glass ] [ button-down 1 ] set-action ;
+    [ drop hide-glass retarget-click ] [ button-down 1 ] set-action ;
 
 : fit-bounds ( loc dim max -- loc )
     #! Adjust loc to fit inside max.
diff --git a/library/ui/world.factor b/library/ui/world.factor
index 59f5943514..ddd565e43a 100644
--- a/library/ui/world.factor
+++ b/library/ui/world.factor
@@ -72,14 +72,23 @@ M: f set-message 2drop ;
     #! the current gadget, with all parents in between.
     hand get hand-gadget parents reverse-slice ;
 
+: update-hand-gadget ( -- )
+    hand-grab hand get set-hand-gadget ;
+
 : hand-grab ( -- gadget )
     hand get rect-loc world get pick-up ;
 
 : move-hand ( loc -- )
     under-hand >r hand get set-rect-loc
-    hand-grab hand get set-hand-gadget
+    update-hand-gadget
     under-hand r> hand-gestures update-help ;
 
+: update-clicked ( -- )
+    hand get
+    dup hand-gadget over set-hand-clicked
+    dup screen-loc over set-hand-click-loc
+    dup hand-gadget over relative swap set-hand-click-rel ;
+
 M: motion-event handle-event ( event -- )
     motion-event-loc move-hand ;