diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt index e964b2a788..76498b6ab3 100644 --- a/TODO.FACTOR.txt +++ b/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 diff --git a/library/ui/test/document.factor b/library/ui/test/document.factor index 3755b73f41..3d00758e23 100644 --- a/library/ui/test/document.factor +++ b/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 + + "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 diff --git a/library/ui/text/commands.factor b/library/ui/text/commands.factor index 9d9f083dd7..e1112b33af 100644 --- a/library/ui/text/commands.factor +++ b/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 ] } diff --git a/library/ui/text/elements.factor b/library/ui/text/elements.factor index bac411fdbb..ad07dc68e6 100644 --- a/library/ui/text/elements.factor +++ b/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 ;