Various UI changes

TODO.FACTOR.txt

@@ -7,12 +7,10 @@
   - scroll to caret
   - only redraw visible lines
   - clicking input doesn't resize editor gadget
-  - word-at-a-time commands
-  - deleting words, lines
   - better listener multi-line expression handling
-  - stack display: trim at 32 columns
 - shift modifier not delivered
 - x11 copy to clipboard
+- one-column table doesn't need borders...?
 
 - httpd search tools
 - remaining HTML issues need fixing

library/kernel.factor

@@ -25,6 +25,7 @@ M: object clone ;
 : >boolean t f ? ; inline
 : and ( a b -- a&b ) f ? ; inline
 : or ( a b -- a|b ) t swap ? ; inline
+: xor ( a b -- a^b ) [ not ] when ; inline
 
 : cpu ( -- arch ) 7 getenv ; foldable
 : os ( -- os ) 11 getenv ; foldable

library/ui/gadgets/controls.factor

@@ -24,4 +24,4 @@ M: control model-changed ( gadget -- )
     control-self relayout ;
 
 : delegate>control ( gadget model -- )
-    <gadget> [ drop ] <control> swap set-gadget-delegate ;
+    <gadget> [ 2drop ] <control> swap set-gadget-delegate ;

library/ui/gadgets/panes.factor

@@ -41,10 +41,15 @@ C: pane ( -- pane )
     [ pick pick pane-current stream-format ]
     [ dup stream-terpri ] interleave 2drop ;
 
-: write-gadget ( gadget pane -- )
+GENERIC: write-gadget ( gadget stream -- )
+
+M: pane write-gadget ( gadget pane -- )
     #! Print a gadget to the given pane.
     pane-current add-gadget ;
 
+M: duplex-stream write-gadget ( gadget stream -- )
+    duplex-stream-out write-gadget ;
+
 : print-gadget ( gadget pane -- )
     tuck write-gadget stream-terpri ;
 

library/ui/text/commands.factor

@@ -23,23 +23,19 @@ sequences ;
 : editor-cut ( editor clipboard -- )
     dupd editor-copy remove-editor-selection ;
 
-: remove-at-caret ( editor quot -- | quot: caret editor -- from to )
+: delete/backspace ( elt editor quot -- | quot: caret editor -- from to )
-    over >r >r dup editor-caret* swap control-model
+    over editor-selection? [
-    r> call r> control-model remove-doc-range ; inline
+        drop nip remove-editor-selection
-
-: editor-delete ( editor -- )
-    dup editor-selection? [
-        remove-editor-selection
     ] [
-        [ dupd T{ char-elt } next-elt ] remove-at-caret
+        over >r >r dup editor-caret* swap control-model
-    ] if ;
+        r> call r> control-model remove-doc-range
+    ] if ; inline
 
-: editor-backspace ( editor -- )
+: editor-delete ( editor elt -- )
-    dup editor-selection? [
+    swap [ over >r rot next-elt r> swap ] delete/backspace ;
-        remove-editor-selection
+
-    ] [
+: editor-backspace ( editor elt -- )
-        [ dupd T{ char-elt } prev-elt swap ] remove-at-caret
+    swap [ over >r rot prev-elt r> ] delete/backspace ;
-    ] if ;
 
 : editor-select-prev ( editor elt -- )
     swap [ rot prev-elt ] change-caret ;
@@ -53,33 +49,14 @@ sequences ;
 : editor-next ( editor elt -- )
     dupd editor-select-next mark>caret ;
 
-: editor-select-home ( editor -- )
+: editor-select ( from to editor -- )
-    [ drop 0 swap =col ] change-caret ;
+    tuck editor-caret set-model editor-mark set-model ;
 
-: editor-home ( editor -- )
+: select-elt ( editor elt -- )
-    dup editor-select-home mark>caret ;
+    over >r
-
+    >r dup editor-caret* swap control-model r>
-: editor-select-doc-home ( editor -- )
+    3dup next-elt >r prev-elt r>
-    { 0 0 } swap editor-caret set-model ;
+    r> editor-select ;
-
-: editor-doc-home ( editor -- )
-    editor-select-doc-home mark>caret ;
-
-: editor-select-end ( editor -- )
-    [ >r first r> line-end ] change-caret ;
-
-: editor-end ( editor -- )
-    dup editor-select-end mark>caret ;
-
-: editor-select-doc-end ( editor -- )
-    dup control-model doc-end swap editor-caret set-model ;
-
-: editor-doc-end ( editor -- )
-    editor-select-doc-end mark>caret ;
-
-: editor-select-all ( editor -- )
-    { 0 0 } over editor-caret set-model
-    dup control-model doc-end swap editor-mark set-model ;
 
 editor H{
     { T{ button-down } [ editor-mouse-down ] }
@@ -92,7 +69,9 @@ editor H{
     { T{ button-up } [ selection get editor-copy ] }
     { T{ cut-action } [ clipboard get editor-cut ] }
     { T{ delete-action } [ remove-editor-selection ] }
-    { T{ select-all-action } [ editor-select-all ] }
+    { T{ select-all-action } [ T{ doc-elt } select-elt ] }
+    { T{ key-down f { C+ } "l" } [ T{ one-line-elt } select-elt ] }
+    { T{ key-down f { C+ } "w" } [ T{ word-elt } select-elt ] }
     { T{ key-down f f "LEFT" } [ T{ char-elt } editor-prev ] }
     { T{ key-down f f "RIGHT" } [ T{ char-elt } editor-next ] }
     { T{ key-down f f "UP" } [ T{ line-elt } editor-prev ] }
@@ -101,16 +80,22 @@ editor H{
     { T{ key-down f { S+ } "RIGHT" } [ T{ char-elt } editor-select-next ] }
     { T{ key-down f { S+ } "UP" } [ T{ line-elt } editor-select-prev ] }
     { T{ key-down f { S+ } "DOWN" } [ T{ line-elt } editor-select-next ] }
-    { T{ key-down f f "HOME" } [ editor-home ] }
+    { T{ key-down f { C+ } "LEFT" } [ T{ word-elt } editor-prev ] }
-    { T{ key-down f f "END" } [ editor-end ] }
+    { T{ key-down f { C+ } "RIGHT" } [ T{ word-elt } editor-next ] }
-    { T{ key-down f { S+ } "HOME" } [ editor-select-home ] }
+    { T{ key-down f { S+ C+ } "LEFT" } [ T{ word-elt } editor-select-prev ] }
-    { T{ key-down f { S+ } "END" } [ editor-select-end ] }
+    { T{ key-down f { S+ C+ } "RIGHT" } [ T{ word-elt } editor-select-next ] }
-    { T{ key-down f { S+ } "HOME" } [ editor-select-home ] }
+    { T{ key-down f f "HOME" } [ T{ one-line-elt } editor-prev ] }
-    { T{ key-down f { S+ } "END" } [ editor-select-end ] }
+    { T{ key-down f f "END" } [ T{ one-line-elt } editor-next ] }
-    { T{ key-down f { C+ } "HOME" } [ editor-doc-home ] }
+    { T{ key-down f { S+ } "HOME" } [ T{ one-line-elt } editor-select-prev ] }
-    { T{ key-down f { C+ } "END" } [ editor-doc-end ] }
+    { T{ key-down f { S+ } "END" } [ T{ one-line-elt } editor-select-next ] }
-    { T{ key-down f { C+ S+ } "HOME" } [ editor-select-doc-home ] }
+    { T{ key-down f { C+ } "HOME" } [ T{ doc-elt } editor-prev ] }
-    { T{ key-down f { C+ S+ } "END" } [ editor-select-doc-end ] }
+    { T{ key-down f { C+ } "END" } [ T{ doc-elt } editor-next ] }
-    { T{ key-down f f "DELETE" } [ editor-delete ] }
+    { T{ key-down f { C+ S+ } "HOME" } [ T{ doc-elt } editor-select-prev ] }
-    { T{ key-down f f "BACKSPACE" } [ editor-backspace ] }
+    { T{ key-down f { C+ S+ } "END" } [ T{ doc-elt } editor-select-next ] }
+    { T{ key-down f f "DELETE" } [ T{ char-elt } editor-delete ] }
+    { T{ key-down f f "BACKSPACE" } [ T{ char-elt } editor-backspace ] }
+    { T{ key-down f { C+ } "DELETE" } [ T{ word-elt } editor-delete ] }
+    { T{ key-down f { C+ } "BACKSPACE" } [ T{ word-elt } editor-backspace ] }
+    { T{ key-down f { A+ } "DELETE" } [ T{ one-line-elt } editor-delete ] }
+    { T{ key-down f { A+ } "BACKSPACE" } [ T{ one-line-elt } editor-backspace ] }
 } set-gestures

library/ui/text/document.factor

@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 IN: gadgets-text
 USING: arrays generic io kernel math models namespaces sequences
-test ;
+strings test ;
 
 : +col ( loc n -- loc ) >r first2 r> + 2array ;
 
@@ -128,31 +128,75 @@ GENERIC: next-elt ( loc document elt -- loc )
 
 TUPLE: char-elt ;
 
-M: char-elt prev-elt
+: (prev-char) ( loc document quot -- loc )
-    drop {
+    -rot {
         { [ over { 0 0 } = ] [ drop ] }
         { [ over second zero? ] [ >r first 1- r> line-end ] }
-        { [ t ] [ drop -1 +col ] }
+        { [ t ] [ pick call ] }
-    } cond ;
+    } cond nip ; inline
 
-M: char-elt next-elt
+: (next-char) ( loc document quot -- loc )
-    drop {
+    -rot {
         { [ 2dup doc-end = ] [ drop ] }
         { [ 2dup line-end? ] [ drop first 1+ 0 2array ] }
-        { [ t ] [ drop 1 +col ] }
+        { [ t ] [ pick call ] }
-    } cond ;
+    } cond nip ; inline
+
+M: char-elt prev-elt
+    drop [ drop -1 +col ] (prev-char) ;
+
+M: char-elt next-elt
+    drop [ drop 1 +col ] (next-char) ;
+
+TUPLE: word-elt ;
+
+: (word-elt) ( loc document quot -- loc )
+    pick >r
+    >r >r first2 swap r> doc-line r> call
+    r> =col ; inline
+
+: ((word-elt)) [ ?nth blank? ] 2keep ;
+
+: (prev-word) ( col str -- col )
+    >r 1- r> ((word-elt))
+    [ blank? xor ] find-last-with* drop 1+ ;
+
+M: word-elt prev-elt
+    drop [ [ (prev-word) ] (word-elt) ] (prev-char) ;
+
+: (next-word) ( col str -- col )
+    ((word-elt))
+    [ [ blank? xor ] find-with* drop ] keep
+    over -1 = [ nip length ] [ drop ] if ;
+
+M: word-elt next-elt
+    drop [ [ (next-word) ] (word-elt) ] (next-char) ;
+
+TUPLE: one-line-elt ;
+
+M: one-line-elt prev-elt
+    2drop first 0 2array ;
+M: one-line-elt next-elt
+    drop >r first dup r> doc-line length 2array ;
 
 TUPLE: line-elt ;
 
 M: line-elt prev-elt 2drop -1 +line ;
 M: line-elt next-elt 2drop 1 +line ;
 
+TUPLE: doc-elt ;
+
+M: doc-elt prev-elt 3drop { 0 0 } ;
+M: doc-elt next-elt drop nip doc-end ;
+
 : doc-text ( document -- str )
     model-value "\n" join ;
 
+: set-doc-lines ( seq document -- )
+    [ set-model ] keep dup doc-end swap update-locs ;
+
 : set-doc-text ( string document -- )
-    [ >r "\n" split r> set-model ] keep
+    >r "\n" split r> set-doc-lines ;
-    dup doc-end swap update-locs ;
 
 : clear-doc ( document -- )
     "" swap set-doc-text ;

library/ui/text/editor.factor

@@ -11,18 +11,13 @@ font color caret-color selection-color
 caret mark
 focused? ;
 
-TUPLE: action-relayout-1 editor ;
-
-M: action-relayout-1 model-changed
-    #! Caret changed
-    action-relayout-1-editor control-self relayout-1 ;
-
 : init-editor-models ( editor -- )
-    dup <action-relayout-1> over editor-caret add-connection
+    dup control-self over editor-caret add-connection
-    dup <action-relayout-1> swap editor-mark add-connection ;
+    dup control-self swap editor-mark add-connection ;
 
 C: editor ( document -- editor )
     dup <document> delegate>control
+    dup dup set-control-self
     { 0 0 } <model> over set-editor-caret
     { 0 0 } <model> over set-editor-mark
     dup init-editor-models

library/ui/text/interactor.factor

@@ -39,7 +39,7 @@ SYMBOL: structured-input
 
 interactor H{
     { T{ key-down f f "RETURN" } [ interactor-commit ] }
-    { T{ key-down f { C+ } "l" } [ interactor-output pane-clear ] }
+    { T{ key-down f { C+ } "b" } [ interactor-output pane-clear ] }
     { T{ key-down f { C+ } "d" } [ f swap interactor-eval ] }
 } set-gestures
 

library/ui/tools/launchpad.factor

@@ -29,9 +29,7 @@ prettyprint sequences words ;
     {
         { "Listener" [ listener-window ] }
         { "Browser" [ browser-window ] }
-        { "Apropos" [ apropos-window ] }
         { "Documentation" [ handbook-window ] }
-        { "Search help" [ search-help-window ] }
         { "Globals" [ globals-window ] }
         { "Memory" [ memory-window ] }
         { "Save image" [ save ] }

library/ui/tools/listener.factor

@@ -31,7 +31,7 @@ TUPLE: listener-gadget input output stack ;
     >r <pane-control> <scroller> r> f <tile> ;
 
 : <stack-tile> ( model title -- gadget )
-    [ stack. ] swap <pane-tile> ;
+    [ [ 32 margin set stack. ] with-scope ] swap <pane-tile> ;
 
 : <listener-input> ( listener -- gadget )
     listener-gadget-input <scroller> "Input" f <tile> ;
@@ -41,8 +41,8 @@ TUPLE: listener-gadget input output stack ;
 
 : <listener-bar> ( listener -- gadget )
     dup {
-        { [ <listener-input> ] f f 1/2 }
+        { [ <listener-input> ] f f 2/3 }
-        { [ <stack-display> ] f f 1/2 }
+        { [ <stack-display> ] f f 1/3 }
     } { 1 0 } make-track ;
 
 : init-listener ( listener -- )
@@ -58,7 +58,7 @@ C: listener-gadget ( -- gadget )
     } { 0 1 } make-track* dup start-listener ;
 
 M: listener-gadget pref-dim*
-    delegate pref-dim* { 600 600 } vmax ;
+    delegate pref-dim* { 700 500 } vmax ;
 
 M: listener-gadget focusable-child* ( listener -- gadget )
     listener-gadget-input ;