Clean up double click handling -- its done in the cross-platform part of the UI now

TODO.FACTOR.txt

@@ -5,7 +5,6 @@
 [ 1 2 3 4 5 6 7 8 9 10 10 10 10 10 10 10 10 10 10 11 11 11 113 
 ]
 - prettier printing of hashtable literals, alists, cond, ...
-- x11 double click
 - menu should stay up if mouse button released
 - roundoff is still not quite right with tracks
 - fix compiled gc check

library/ui/cocoa/view-utils.factor

@@ -91,16 +91,11 @@ opengl sequences ;
 : mouse-event>gesture ( event -- modifiers button )
     dup event-modifiers swap button ;
 
-: update-click-count ( event -- )
-    -> clickCount 1 max hand-click# set-global ;
-
 : send-button-down$ ( view event -- )
-    [ update-click-count ] keep
     [ mouse-event>gesture <button-down> ] 2keep
     mouse-location rot window send-button-down ;
 
 : send-button-up$ ( view event -- )
-    [ update-click-count ] keep
     [ mouse-event>gesture <button-up> ] 2keep
     mouse-location rot window send-button-up ;
 

library/ui/gestures.factor

@@ -81,6 +81,9 @@ V{ } clone hand-buttons set-global
 SYMBOL: scroll-direction
 { 0 0 } scroll-direction set-global
 
+SYMBOL: double-click-timeout
+100 double-click-timeout set-global
+
 : button-gesture ( gesture -- )
     hand-clicked get-global 2dup handle-gesture [
         >r generalize-gesture r> handle-gesture drop
@@ -150,20 +153,23 @@ SYMBOL: scroll-direction
 : hand-click-rel ( gadget -- loc )
     hand-click-loc get-global relative-loc ;
 
-: update-click# ( button -- )
-    hand-last-button get = [
-        global [ hand-click# inc ] bind
-    ] [
-        1 hand-click# set-global
-    ] if ;
+: multi-click? ( button -- ? )
+    millis hand-last-time get - double-click-timeout get <=
+    swap hand-last-button get = and ;
 
-: button-down ( button timeout -- )
-    millis hand-last-time get - rot < [
-        dup update-click#
+: update-click# ( button -- )
+    global [
+        multi-click? [
+            hand-click# inc
         ] [
-        1 hand-click# set-global
+            1 hand-click# set
         ] if
+    ] bind ;
+
+: update-clicked ( button -- )
     hand-last-button set-global
+    hand-gadget get-global hand-clicked set-global
+    hand-loc get-global hand-click-loc set-global
     millis hand-last-time set-global ;
  
 : under-hand ( -- seq )
@@ -171,10 +177,6 @@ SYMBOL: scroll-direction
     #! the current gadget, with all parents in between.
     hand-gadget get-global parents <reversed> ;
 
-: update-clicked ( -- )
-    hand-gadget get-global hand-clicked set-global
-    hand-loc get-global hand-click-loc set-global ;
-
 : move-hand ( loc world -- )
     dup hand-world set-global
     under-hand >r over hand-loc set-global
@@ -184,8 +186,10 @@ SYMBOL: scroll-direction
 
 : send-button-down ( gesture loc world -- )
     move-hand
-    update-clicked
-    dup button-down-# hand-buttons get-global push
+    dup button-down-#
+    dup update-click#
+    dup update-clicked
+    hand-buttons get-global push
     button-gesture ;
 
 : send-button-up ( gesture loc world -- )

library/ui/windows/ui.factor

@@ -165,17 +165,14 @@ SYMBOL: hWnd
 : mouse-lparam ( lParam -- seq ) [ lo-word ] keep hi-word 2array ;
 : mouse-wheel ( lParam -- n ) mouse-lparam [ sgn neg ] map ;
 
-: win32-button-down ( button -- )
-    GetDoubleClickTime dup button-down <button-down> ;
-
 : mouse-event>gesture ( uMsg -- button )
     key-modifiers swap
     {
-        { [ dup WM_LBUTTONDOWN = ] [ drop 1 win32-button-down ] }
+        { [ dup WM_LBUTTONDOWN = ] [ drop 1 <button-down> ] }
         { [ dup WM_LBUTTONUP = ] [ drop 1 <button-up> ] }
-        { [ dup WM_MBUTTONDOWN = ] [ drop 2 win32-button-down ] }
+        { [ dup WM_MBUTTONDOWN = ] [ drop 2 <button-down> ] }
         { [ dup WM_MBUTTONUP = ] [ drop 2 <button-up> ] }
-        { [ dup WM_RBUTTONDOWN = ] [ drop 3 win32-button-down ] }
+        { [ dup WM_RBUTTONDOWN = ] [ drop 3 <button-down> ] }
         { [ dup WM_RBUTTONUP = ] [ drop 3 <button-up> ] }
         { [ t ] [ "bad button" throw ] }
     } cond ;
@@ -306,7 +303,8 @@ SYMBOL: hWnd
     "MSG" <c-object> msg-obj set
     random-class-name class-name set
     class-name get <malloc-string> ui-wndproc
-    register-wndclassex win32-error=0 ;
+    register-wndclassex win32-error=0
+    GetDoubleClickTime double-click-timeout set-global ;
 
 : cleanup-win32-ui ( -- )
     class-name get <malloc-string> f UnregisterClass drop ;