Add new one-word-elt element

TODO.FACTOR.txt

@@ -12,8 +12,6 @@
   - float boxing and overflow checks need a gc check too
 - [ [ dup call ] dup call ] infer hangs
 - growable data heap
-- documentation:
-  - update module system docs
 
 + ui:
 
@@ -34,8 +32,6 @@
   - autoscroll
   - transpose char/word/line
   - more efficient multi-line inserts
-  - write "foo| " and put caret at | then select word element: selects
-    space
 - see if its possible to only repaint dirty regions
 - structure editor
 

library/ui/test/document.factor

@@ -58,3 +58,11 @@ USING: gadgets-text namespaces test ;
     "" { 1 3 } { 2 4 } "doc" get set-doc-range
     "doc" get doc-text
 ] unit-test
+
+<document> "doc" set
+"Hello world" "doc" get set-doc-text
+[ { 0 0 } ] [ { 0 0 } "doc" get T{ one-word-elt } prev-elt ] unit-test
+[ { 0 0 } ] [ { 0 2 } "doc" get T{ one-word-elt } prev-elt ] unit-test
+[ { 0 0 } ] [ { 0 5 } "doc" get T{ one-word-elt } prev-elt ] unit-test
+[ { 0 5 } ] [ { 0 2 } "doc" get T{ one-word-elt } next-elt ] unit-test
+[ { 0 5 } ] [ { 0 5 } "doc" get T{ one-word-elt } next-elt ] unit-test

library/ui/text/commands.factor

@@ -63,7 +63,7 @@ USING: gadgets kernel models namespaces sequences arrays ;
 
 : selected-word ( editor -- string )
     dup gadget-selection?
-    [ dup T{ word-elt } select-elt ] unless
+    [ dup T{ one-word-elt } select-elt ] unless
     gadget-selection ;
 
 : position-caret ( editor -- )
@@ -74,7 +74,7 @@ USING: gadgets kernel models namespaces sequences arrays ;
     hand-click# get {
         [ ]
         [ dup position-caret ]
-        [ dup T{ word-elt } select-elt ]
+        [ dup T{ one-word-elt } select-elt ]
         [ dup T{ one-line-elt } select-elt ]
     } ?nth call drop ;
 
@@ -122,7 +122,7 @@ editor "selection" {
     { "Clear" T{ delete-action } [ remove-editor-selection ] }
     { "Select all" T{ select-all-action } [ T{ doc-elt } select-elt ] }
     { "Select line" T{ key-down f { C+ } "l" } [ T{ one-line-elt } select-elt ] }
-    { "Select word" T{ key-down f { C+ } "w" } [ T{ word-elt } select-elt ] }
+    { "Select word" T{ key-down f { C+ } "w" } [ T{ one-word-elt } select-elt ] }
     { "Select previous character" T{ key-down f { S+ } "LEFT" } [ T{ char-elt } editor-select-prev ] }
     { "Select next character" T{ key-down f { S+ } "RIGHT" } [ T{ char-elt } editor-select-next ] }
     { "Select previous line" T{ key-down f { S+ } "UP" } [ T{ line-elt } editor-select-prev ] }

library/ui/text/elements.factor

@@ -26,8 +26,6 @@ M: char-elt prev-elt
 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
@@ -35,34 +33,51 @@ TUPLE: word-elt ;
 
 : ((word-elt)) [ ?nth blank? ] 2keep ;
 
-: (prev-word) ( col str -- col )
-    >r 1- r> ((word-elt))
+: (prev-word) ( ? col str -- col )
     [ 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))
+: (next-word) ( ? col str -- col )
     [ [ blank? xor ] find-with* drop ] keep
     over -1 = [ nip length ] [ drop ] if ;
 
+TUPLE: one-word-elt ;
+
+M: one-word-elt prev-elt
+    drop
+    [ [ f -rot >r 1- r> (prev-word) ] (word-elt) ] (prev-char) ;
+
+M: one-word-elt next-elt
+    drop
+    [ [ f -rot (next-word) ] (word-elt) ] (next-char) ;
+
+TUPLE: word-elt ;
+
+M: word-elt prev-elt
+    drop
+    [ [ >r 1- r> ((word-elt)) (prev-word) ] (word-elt) ]
+    (prev-char) ;
+
 M: word-elt next-elt
-    drop [ [ (next-word) ] (word-elt) ] (next-char) ;
+    drop
+    [ [ ((word-elt)) (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 ;