Code somplification

TODO.FACTOR.txt

@@ -17,6 +17,7 @@
 + ui:
 
 - editor:
+  - delegation issue with fields and interactors
   - multi-line inserts
   - scroll to caret
   - only redraw visible lines

library/ui/gadgets/panes.factor

@@ -1,25 +1,23 @@
 ! Copyright (C) 2005, 2006 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 IN: gadgets-panes
-USING: arrays gadgets gadgets-buttons gadgets-controls
+USING: gadgets gadgets-buttons gadgets-controls gadgets-labels
-gadgets-frames gadgets-grids gadgets-labels gadgets-scrolling
+gadgets-scrolling gadgets-theme generic hashtables io kernel
-gadgets-theme generic hashtables io kernel math namespaces
+namespaces sequences ;
-sequences strings ;
 
-TUPLE: pane output active current prototype scrolls? ;
+TUPLE: pane output current prototype scrolls? ;
 
 : add-output 2dup set-pane-output add-gadget ;
 
-: init-line ( pane -- )
+: add-current 2dup set-pane-current add-gadget ;
-    dup pane-prototype clone swap set-pane-current ;
 
 : prepare-line ( pane -- )
-    dup init-line dup pane-active unparent
+    dup pane-prototype clone swap add-current ;
-    [ pane-current 1array make-shelf ] keep
-    2dup set-pane-active add-gadget ;
 
 : pane-clear ( pane -- )
-    dup pane-output clear-incremental pane-current clear-gadget ;
+    dup
+    pane-output clear-incremental
+    pane-current clear-gadget ;
 
 C: pane ( -- pane )
     <pile> over set-delegate
@@ -58,11 +56,7 @@ C: pane ( -- pane )
 M: pane stream-flush ( pane -- ) drop ;
 
 : scroll-pane ( pane -- )
-    dup pane-scrolls? [
+    dup pane-scrolls? [ scroll>bottom ] [ drop ] if ;
-        find-scroller [ scroll>bottom ] when*
-    ] [
-        drop
-    ] if ;
 
 M: pane stream-terpri ( pane -- )
     dup pane-current prepare-print

library/ui/gadgets/scrolling.factor

@@ -16,12 +16,6 @@ TUPLE: scroller viewport x y follows ;
 
 : find-scroller [ scroller? ] find-parent ;
 
-: scroll>gadget ( gadget -- )
-    #! Scroll the scroller that contains this gadget, if any, so
-    #! that the gadget becomes visible.
-    dup find-scroller dup
-    [ [ set-scroller-follows ] keep relayout ] [ 2drop ] if ;
-
 : scroll-up-line scroller-y -1 swap slide-by-line ;
 
 : scroll-down-line scroller-y 1 swap slide-by-line ;
@@ -63,15 +57,15 @@ C: scroller ( gadget -- scroller )
     dupd over scroller-y update-slider
     position-viewport ;
 
-: scroll>bottom ( scroller -- )
+: scroll>bottom ( gadget -- )
-    t swap set-scroller-follows ;
+    find-scroller [ t swap set-scroller-follows ] when* ;
 
 : update-scroller ( scroller -- )
-    dup scroller-follows [
+    dup dup scroller-follows [
         f over set-scroller-follows
-        dup rect-dim { 0 1 } v*
+        scroller-viewport viewport-dim { 0 1 } v*
     ] [
-        drop dup scroller-origin
+        scroller-origin
     ] if scroll ;
 
 M: scroller layout* ( scroller -- )

library/ui/tools/listener.factor

@@ -27,23 +27,34 @@ TUPLE: listener-gadget input output stack ;
     [ >r clear r> init-namespaces listener-thread ] in-thread
     drop ;
 
-: <listener-input> ( -- gadget )
-    gadget get listener-gadget-output <interactor> ;
-
 : <pane-tile> ( model quot title -- gadget )
     >r <pane-control> <scroller> r> f <tile> ;
 
 : <stack-tile> ( model title -- gadget )
     [ stack. ] swap <pane-tile> ;
 
-: <stack-display> ( -- gadget )
+: <listener-input> ( listener -- gadget )
-    gadget get listener-gadget-stack "Stack" <stack-tile> ;
+    listener-gadget-input <scroller> "Input" f <tile> ;
+
+: <stack-display> ( listener -- gadget )
+    listener-gadget-stack "Stack" <stack-tile> ;
+
+: <listener-bar> ( listener -- gadget )
+    dup {
+        { [ <listener-input> ] f f 1/2 }
+        { [ <stack-display> ] f f 1/2 }
+    } { 1 0 } make-track ;
+
+: init-listener ( listener -- )
+    f <model> over set-listener-gadget-stack
+    <scrolling-pane> over set-listener-gadget-output
+    dup listener-gadget-output <interactor>
+    swap set-listener-gadget-input ;
 
 C: listener-gadget ( -- gadget )
-    f <model> over set-listener-gadget-stack {
+    dup init-listener {
-        { [ <scrolling-pane> ] set-listener-gadget-output [ <scroller> ] 4/6 }
+        { [ gadget get listener-gadget-output <scroller> ] f f 5/6 }
-        { [ <listener-input> ] set-listener-gadget-input [ <scroller> ] 1/6 }
+        { [ gadget get <listener-bar> ] f f 1/6 }
-        { [ <stack-display> ] f f 1/6 }
     } { 0 1 } make-track* dup start-listener ;
 
 M: listener-gadget pref-dim*