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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

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