steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Some cleanup in documents.elements

db4
Daniel Ehrenberg 2009-03-29 22:58:04 -05:00
parent 176983e1a3
commit f657c60c4f
1 changed files with 12 additions and 12 deletions
basis/documents/elements

24
basis/documents/elements/elements.factor
View File

@ -1,7 +1,7 @@
! Copyright (C) 2006, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: arrays combinators documents fry kernel math sequences
unicode.categories accessors ;
accessors unicode.categories combinators.short-circuit ;
IN: documents.elements
GENERIC: prev-elt ( loc document elt -- newloc )
@ -20,14 +20,14 @@ SINGLETON: char-elt
<PRIVATE
: (prev-char) ( loc document quot -- loc )
: prev ( loc document quot: ( loc document -- loc ) -- loc )
{
{ [ pick { 0 0 } = ] [ 2drop ] }
{ [ pick second zero? ] [ drop [ first 1- ] dip line-end ] }
[ call ]
} cond ; inline
: (next-char) ( loc document quot -- loc )
: next ( loc document quot: ( loc document -- loc )
{
{ [ 2over doc-end = ] [ 2drop ] }
{ [ 2over line-end? ] [ 2drop first 1+ 0 2array ] }
@ -37,10 +37,10 @@ SINGLETON: char-elt
PRIVATE>
M: char-elt prev-elt
drop [ drop -1 +col ] (prev-char) ;
drop [ drop -1 +col ] prev ;
M: char-elt next-elt
drop [ drop 1 +col ] (next-char) ;
drop [ drop 1 +col ] next ;
SINGLETON: one-char-elt
@ -55,7 +55,7 @@ M: one-char-elt next-elt 2drop ;
[ [ first2 swap ] dip doc-line ] dip call
] dip =col ; inline
: ((word-elt)) ( n seq -- n seq ? )
: blank-at? ( n seq -- n seq ? )
2dup ?nth blank? ;
: break-detector ( ? -- quot )
@ -65,7 +65,7 @@ M: one-char-elt next-elt 2drop ;
break-detector find-last-from drop ?1+ ;
: (next-word) ( col str ? -- col )
[ break-detector find-from drop ] [ drop length ] 2bi or ;
{ [ break-detector find-from drop ] [ drop length ] } 2|| ;
PRIVATE>
@ -83,13 +83,13 @@ SINGLETON: word-elt
M: word-elt prev-elt
drop
[ [ [ 1- ] dip ((word-elt)) (prev-word) ] (word-elt) ]
(prev-char) ;
[ [ [ 1- ] dip blank-at? (prev-word) ] (word-elt) ]
prev ;
M: word-elt next-elt
drop
[ [ ((word-elt)) (next-word) ] (word-elt) ]
(next-char) ;
[ [ blank-at? (next-word) ] (word-elt) ]
next ;
SINGLETON: one-line-elt
@ -118,4 +118,4 @@ SINGLETON: doc-elt
M: doc-elt prev-elt 3drop { 0 0 } ;
M: doc-elt next-elt drop nip doc-end ;
M: doc-elt next-elt drop nip doc-end ;