Use singleton classes instead of tuples for document elements

db4
Slava Pestov 2008-12-24 22:38:02 -06:00
parent c7ea91acda
commit 1f11b0d78b
5 changed files with 53 additions and 53 deletions

View File

@ -90,17 +90,17 @@ USING: documents namespaces tools.test make arrays kernel fry ;
<document> "doc" set
"Hello world" "doc" get set-doc-string
[ { 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
[ { 0 0 } ] [ { 0 0 } "doc" get one-word-elt prev-elt ] unit-test
[ { 0 0 } ] [ { 0 2 } "doc" get one-word-elt prev-elt ] unit-test
[ { 0 0 } ] [ { 0 5 } "doc" get one-word-elt prev-elt ] unit-test
[ { 0 5 } ] [ { 0 2 } "doc" get one-word-elt next-elt ] unit-test
[ { 0 5 } ] [ { 0 5 } "doc" get one-word-elt next-elt ] unit-test
<document> "doc" set
"Hello\nworld, how are\nyou?" "doc" get set-doc-string
[ { 2 4 } ] [ "doc" get doc-end ] unit-test
[ { 0 0 } ] [ { 0 3 } "doc" get T{ line-elt } prev-elt ] unit-test
[ { 0 3 } ] [ { 1 3 } "doc" get T{ line-elt } prev-elt ] unit-test
[ { 2 4 } ] [ { 2 1 } "doc" get T{ line-elt } next-elt ] unit-test
[ { 0 0 } ] [ { 0 3 } "doc" get line-elt prev-elt ] unit-test
[ { 0 3 } ] [ { 1 3 } "doc" get line-elt prev-elt ] unit-test
[ { 2 4 } ] [ { 2 1 } "doc" get line-elt next-elt ] unit-test

View File

@ -2,7 +2,7 @@
! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays io kernel math models namespaces make
sequences strings splitting combinators unicode.categories
math.order math.ranges ;
math.order math.ranges fry ;
IN: documents
: +col ( loc n -- newloc ) [ first2 ] dip + 2array ;
@ -150,7 +150,7 @@ GENERIC: next-elt ( loc document elt -- newloc )
: elt-string ( loc document elt -- string )
[ prev/next-elt ] [ drop ] 2bi doc-range ;
TUPLE: char-elt ;
SINGLETON: char-elt
: (prev-char) ( loc document quot -- loc )
{
@ -172,7 +172,7 @@ M: char-elt prev-elt
M: char-elt next-elt
drop [ drop 1 +col ] (next-char) ;
TUPLE: one-char-elt ;
SINGLETON: one-char-elt
M: one-char-elt prev-elt 2drop ;
@ -186,7 +186,7 @@ M: one-char-elt next-elt 2drop ;
: ((word-elt)) ( n seq -- ? n seq ) [ ?nth blank? ] 2keep ;
: break-detector ( ? -- quot )
[ [ blank? ] dip xor ] curry ; inline
'[ blank? _ xor ] ; inline
: (prev-word) ( ? col str -- col )
rot break-detector find-last-from drop ?1+ ;
@ -195,7 +195,7 @@ M: one-char-elt next-elt 2drop ;
[ rot break-detector find-from drop ] keep
over not [ nip length ] [ drop ] if ;
TUPLE: one-word-elt ;
SINGLETON: one-word-elt
M: one-word-elt prev-elt
drop
@ -205,7 +205,7 @@ M: one-word-elt next-elt
drop
[ [ f ] 2dip (next-word) ] (word-elt) ;
TUPLE: word-elt ;
SINGLETON: word-elt
M: word-elt prev-elt
drop
@ -217,7 +217,7 @@ M: word-elt next-elt
[ [ ((word-elt)) (next-word) ] (word-elt) ]
(next-char) ;
TUPLE: one-line-elt ;
SINGLETON: one-line-elt
M: one-line-elt prev-elt
2drop first 0 2array ;
@ -225,7 +225,7 @@ M: one-line-elt prev-elt
M: one-line-elt next-elt
drop [ first dup ] dip doc-line length 2array ;
TUPLE: line-elt ;
SINGLETON: line-elt
M: line-elt prev-elt
2drop dup first zero? [ drop { 0 0 } ] [ -1 +line ] if ;
@ -234,7 +234,7 @@ M: line-elt next-elt
drop over first over last-line# number=
[ nip doc-end ] [ drop 1 +line ] if ;
TUPLE: doc-elt ;
SINGLETON: doc-elt
M: doc-elt prev-elt 3drop { 0 0 } ;

View File

@ -8,7 +8,7 @@ IN: ui.gadgets.editors.tests
<editor> "editor" set
"editor" get [
"foo bar" "editor" get set-editor-string
"editor" get T{ one-line-elt } select-elt
"editor" get one-line-elt select-elt
"editor" get gadget-selection
] with-grafted-gadget
] unit-test
@ -17,7 +17,7 @@ IN: ui.gadgets.editors.tests
<editor> "editor" set
"editor" get [
"foo bar\nbaz quux" "editor" get set-editor-string
"editor" get T{ one-line-elt } select-elt
"editor" get one-line-elt select-elt
"editor" get gadget-selection
] with-grafted-gadget
] unit-test

View File

@ -291,9 +291,9 @@ M: editor gadget-text* editor-string % ;
: mouse-elt ( -- element )
hand-click# get {
{ 1 T{ one-char-elt } }
{ 2 T{ one-word-elt } }
} at T{ one-line-elt } or ;
{ 1 one-char-elt }
{ 2 one-word-elt }
} at one-line-elt or ;
: drag-direction? ( loc editor -- ? )
editor-mark* before? ;
@ -356,34 +356,34 @@ M: editor gadget-text* editor-string % ;
[ [ [ editor-caret* ] [ model>> ] bi ] dip prev/next-elt ] [ drop ] 2bi
editor-select ;
: start-of-document ( editor -- ) T{ doc-elt } editor-prev ;
: start-of-document ( editor -- ) doc-elt editor-prev ;
: end-of-document ( editor -- ) T{ doc-elt } editor-next ;
: end-of-document ( editor -- ) doc-elt editor-next ;
: position-caret ( editor -- )
mouse-elt dup T{ one-char-elt } =
mouse-elt dup one-char-elt =
[ drop dup extend-selection dup mark>> click-loc ]
[ select-elt ] if ;
: insert-newline ( editor -- ) "\n" swap user-input* drop ;
: delete-next-character ( editor -- )
T{ char-elt } editor-delete ;
char-elt editor-delete ;
: delete-previous-character ( editor -- )
T{ char-elt } editor-backspace ;
char-elt editor-backspace ;
: delete-previous-word ( editor -- )
T{ word-elt } editor-delete ;
word-elt editor-delete ;
: delete-next-word ( editor -- )
T{ word-elt } editor-backspace ;
word-elt editor-backspace ;
: delete-to-start-of-line ( editor -- )
T{ one-line-elt } editor-delete ;
one-line-elt editor-delete ;
: delete-to-end-of-line ( editor -- )
T{ one-line-elt } editor-backspace ;
one-line-elt editor-backspace ;
editor "general" f {
{ T{ key-down f f "DELETE" } delete-next-character }
@ -415,7 +415,7 @@ editor "clipboard" f {
dup selection-start/end drop
over set-caret mark>caret
] [
T{ char-elt } editor-prev
char-elt editor-prev
] if ;
: next-character ( editor -- )
@ -423,20 +423,20 @@ editor "clipboard" f {
dup selection-start/end nip
over set-caret mark>caret
] [
T{ char-elt } editor-next
char-elt editor-next
] if ;
: previous-line ( editor -- ) T{ line-elt } editor-prev ;
: previous-line ( editor -- ) line-elt editor-prev ;
: next-line ( editor -- ) T{ line-elt } editor-next ;
: next-line ( editor -- ) line-elt editor-next ;
: previous-word ( editor -- ) T{ word-elt } editor-prev ;
: previous-word ( editor -- ) word-elt editor-prev ;
: next-word ( editor -- ) T{ word-elt } editor-next ;
: next-word ( editor -- ) word-elt editor-next ;
: start-of-line ( editor -- ) T{ one-line-elt } editor-prev ;
: start-of-line ( editor -- ) one-line-elt editor-prev ;
: end-of-line ( editor -- ) T{ one-line-elt } editor-next ;
: end-of-line ( editor -- ) one-line-elt editor-next ;
editor "caret-motion" f {
{ T{ button-down } position-caret }
@ -456,11 +456,11 @@ editor "caret-motion" f {
#! The with-datastack is a kludge to make it infer. Stupid.
model>> 1array [ clear-doc ] with-datastack drop ;
: select-all ( editor -- ) T{ doc-elt } select-elt ;
: select-all ( editor -- ) doc-elt select-elt ;
: select-line ( editor -- ) T{ one-line-elt } select-elt ;
: select-line ( editor -- ) one-line-elt select-elt ;
: select-word ( editor -- ) T{ one-word-elt } select-elt ;
: select-word ( editor -- ) one-word-elt select-elt ;
: selected-word ( editor -- string )
dup gadget-selection?
@ -468,34 +468,34 @@ editor "caret-motion" f {
gadget-selection ;
: select-previous-character ( editor -- )
T{ char-elt } editor-select-prev ;
char-elt editor-select-prev ;
: select-next-character ( editor -- )
T{ char-elt } editor-select-next ;
char-elt editor-select-next ;
: select-previous-line ( editor -- )
T{ line-elt } editor-select-prev ;
line-elt editor-select-prev ;
: select-next-line ( editor -- )
T{ line-elt } editor-select-next ;
line-elt editor-select-next ;
: select-previous-word ( editor -- )
T{ word-elt } editor-select-prev ;
word-elt editor-select-prev ;
: select-next-word ( editor -- )
T{ word-elt } editor-select-next ;
word-elt editor-select-next ;
: select-start-of-line ( editor -- )
T{ one-line-elt } editor-select-prev ;
one-line-elt editor-select-prev ;
: select-end-of-line ( editor -- )
T{ one-line-elt } editor-select-next ;
one-line-elt editor-select-next ;
: select-start-of-document ( editor -- )
T{ doc-elt } editor-select-prev ;
doc-elt editor-select-prev ;
: select-end-of-document ( editor -- )
T{ doc-elt } editor-select-next ;
doc-elt editor-select-next ;
editor "selection" f {
{ T{ button-down f { S+ } 1 } extend-selection }

View File

@ -53,7 +53,7 @@ M: interactor ungraft*
: word-at-loc ( loc interactor -- word )
over [
[ model>> T{ one-word-elt } elt-string ] keep
[ model>> one-word-elt elt-string ] keep
interactor-use assoc-stack
] [
2drop f