Horizontal scrolling with the mouse wheel is now supported

diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt
index 371a8a3f20a1434309f100763c150fd118d4af12..7755e8159278673298d6cc4a3fbf8fea8efb33d4 100644 (file)
--- a/TODO.FACTOR.txt
+++ b/TODO.FACTOR.txt
@@ -1,37 +1,29 @@
 - auto-invoke code gc
 - fix alien-callback/SEH bug on win32
-- maybe simplify list into displaying list a sequence of strings
 - x11: scroll up/down wiggles caret
-- slider needs to be modelized
-- some way of intercepting all gestures
-- better help result ranking
-- help search looks funny
-- menus should not require mouse to be held
 - tab completion: add a USE: if necessary
-- completion is not ideal: eg, search for "buttons"
-- live search: timer delay would be nice
+- cocoa: horizontal wheel scrolling
+- rollover is not updated on window focus changes
+- cocoa: windows are not updated while resizing
 
 + ui:
 
-- [ ] write in the UI breaks stuff
-- pane output in UI should use less memory
+- command presentation shouldn't really be a presentation at all
+- completion is not ideal: eg, search for "buttons"
+- live search: timer delay would be nice
+- some way of intercepting all gestures
+- slider needs to be modelized
+- better help result ranking
+- help search looks funny
+- menus should not require mouse to be held
 - variable width word wrap
-  - needs layout tricks
-- add-gadget, model-changed, set-model should compile
 - graphical module manager tool
-  - list of modules -- loaded, not loaded
-  - each module has a list of files
-  - modules can be (re)loaded
-  - keyboard navigation
 - ui browser: show currently selected vocab & words
 - auto-update browser and help when sources reload
 - how do we refer to command shortcuts in the docs?
-- figure out if we need both set-model and set-model*
 - roundoff is still not quite right with tracks
 - fix top level window positioning
-- x11.app has a problem with A+ keys
 - services do not launch if factor not running
-- fix ui listener delay
 - editor:
   - double/triple click
   - autoscroll
@@ -39,19 +31,9 @@
   - more efficient multi-line inserts
   - write "foo| " and put caret at | then select word element: selects
     space
-- fonts/ should go inside the .app -- we need multi-tier resource-path
-- should be possible to drop an image file on the .app to run it
-- support x11's large selections, if needed
-- own-selection violates ICCCM
-- cocoa: windows are not updated while resizing
 - grid slows down with 2000 lines
 - see if its possible to only repaint dirty regions
-- x11 title bars are funny
-- rollover is not updated on window focus changes
-- x11 input methods
-- cocoa:
-  - horizontal wheel scrolling
-  - polish OS X menu bar code
+- polish OS X menu bar code
 - structure editor
 
 + module system:
@@ -59,7 +41,6 @@
 - convention for main entry point of a module
 - convention for main help article of a module
 - track a list of assets loaded from each module's file
-- generic 'define ( asset def -- )'
 - C types should be words
   - TYPEDEF: float { ... } { ... } ;   ==> \ float T{ c-type ... } "c-type" swp
   - TYPEDEF: float FTFloat ;  ==> \ float \ FTFloat "c-type" swp
@@ -71,12 +52,8 @@
 
 - more compact relocation info
 - cocoa: support real redefinition
-- problem if major gc happens during relocation
-  - in fact relocation should not cons at all
+- relocation should not cons at all
 - stdcall callbacks
-- see if alien calls can be made faster
-- compiler tests are not as reliable now because of try-compile usage
-  - we can just do [ t ] [ \ foo compiled? ] unit-test
 - [ [ dup call ] dup call ] infer hangs
 - callstack overflow when compiling mutually recursive inline words
 - test what is done in the case of an invalid declaration on an inline
@@ -105,9 +82,7 @@
 - minor GC takes too long now, we should card mark code heap
 - buffer-ptr should be an alien
 - swap nappend ==> nappend
-- sometimes darcs get fails with the httpd
 - gdb triggers 'mutliple i/o ops on port' error
-- factorcode httpd crashed: bad file descriptor
 - growable data heap
 - incremental GC
 - UDP

diff --git a/library/ui/cocoa/view-utils.factor b/library/ui/cocoa/view-utils.factor
index 60fd4aacd3e88b371b8ec478d392e53421b45766..3d895f53c95b128b4f47607cd02d9d90fe4e9e82 100644 (file)
--- a/library/ui/cocoa/view-utils.factor
+++ b/library/ui/cocoa/view-utils.factor
@@ -100,8 +100,10 @@ opengl sequences ;
     mouse-location rot window send-button-up ;
 
 : send-wheel$ ( view event -- )
-    [ -> deltaY 0 > ] 2keep mouse-location
-    rot window send-wheel ;
+    over >r
+    dup -> deltaX sgn neg over -> deltaY sgn neg 2array -rot
+    mouse-location
+    r> window send-wheel ;
 
 : send-action$ ( view event gesture -- junk )
     >r drop window r> send-action f ;

diff --git a/library/ui/gadgets/scrolling.factor b/library/ui/gadgets/scrolling.factor
index c2e76140804b0289b9563f08cb80097ec41c6ee2..d760a1904a8d3655428ed657c09fd9effc8f8577 100644 (file)
--- a/library/ui/gadgets/scrolling.factor
+++ b/library/ui/gadgets/scrolling.factor
@@ -16,17 +16,21 @@ TUPLE: scroller viewport x y follows ;
 
 : find-scroller [ scroller? ] find-parent ;
 
+: scroll-up-page scroller-y -1 swap slide-by-page ;
+
+: scroll-down-page scroller-y 1 swap slide-by-page ;
+
 : scroll-up-line scroller-y -1 swap slide-by-line ;
 
 : scroll-down-line scroller-y 1 swap slide-by-line ;
 
-: scroll-up-page scroller-y -1 swap slide-by-page ;
-
-: scroll-down-page scroller-y 1 swap slide-by-page ;
+: do-mouse-scroll ( scroller -- )
+    scroll-direction get-global first2
+    pick scroller-y slide-by-line
+    swap scroller-x slide-by-line ;
 
 scroller H{
-    { T{ wheel-up } [ scroll-up-line ] }
-    { T{ wheel-down } [ scroll-down-line ] }
+    { T{ mouse-scroll } [ do-mouse-scroll ] }
     { T{ slider-changed } [ relayout-1 ] }
 } set-gestures
 

diff --git a/library/ui/gestures.factor b/library/ui/gestures.factor
index 2f8f9aa4146f5878268b4a99fd7b7f13a8f24f1c..d77689de18a631229c4c3f2a308cbfd99de49793 100644 (file)
--- a/library/ui/gestures.factor
+++ b/library/ui/gestures.factor
@@ -27,8 +27,7 @@ TUPLE: motion ;
 TUPLE: drag # ;
 TUPLE: button-up mods # ;
 TUPLE: button-down mods # ;
-TUPLE: wheel-up ;
-TUPLE: wheel-down ;
+TUPLE: mouse-scroll ;
 TUPLE: mouse-enter ;
 TUPLE: mouse-leave ;
 TUPLE: lose-focus ;
@@ -74,6 +73,9 @@ SYMBOL: hand-click-loc
 SYMBOL: hand-buttons
 V{ } clone hand-buttons set-global
 
+SYMBOL: scroll-direction
+{ 0 0 } scroll-direction set-global
+
 : button-gesture ( gesture -- )
     hand-clicked get-global 2dup handle-gesture [
         >r generalize-gesture r> handle-gesture drop
@@ -170,10 +172,11 @@ SYMBOL: menu-mode?
     dup button-up-# hand-buttons get-global delete
     button-gesture ;
 
-: send-wheel ( up/down loc world -- )
+: send-wheel ( direction loc world -- )
     move-hand
-    T{ wheel-up } T{ wheel-down } ?
-    hand-gadget get-global handle-gesture drop ;
+    scroll-direction set-global
+    T{ mouse-scroll } hand-gadget get-global handle-gesture
+    drop ;
 
 : send-action ( world gesture -- )
     swap world-focus handle-gesture drop ;

diff --git a/library/ui/x11/ui.factor b/library/ui/x11/ui.factor
index f0a836375b89ff964d29c20cab8ca4f72e6a8456..db32afb79122f68f4877034ac0f9b63486440a34 100644 (file)
--- a/library/ui/x11/ui.factor
+++ b/library/ui/x11/ui.factor
@@ -108,8 +108,11 @@ M: world button-up-event
     >r mouse-event>gesture >r <button-up> r> r>
     send-button-up ;
 
+: mouse-event>scroll-direction ( event -- pair )
+    XButtonEvent-button 4 = 1 -1 ? 0 swap 2array ;
+
 M: world wheel-event
-    >r dup XButtonEvent-button 4 = swap mouse-event-loc r>
+    >r dup mouse-event>scroll-direction swap mouse-event-loc r>
     send-wheel ;
 
 M: world enter-event motion-event ;