editor gadget now supports multi-line inserts
parent
fc4532ee7c
commit
8b05f22a50
|
@ -3,14 +3,11 @@
|
|||
- windows port from erg
|
||||
- why aren't some cocoa words compiled?
|
||||
- editor:
|
||||
- multi-line inserts
|
||||
- scroll to caret
|
||||
- only redraw visible lines
|
||||
- clicking input doesn't resize editor gadget
|
||||
- better listener multi-line expression handling
|
||||
- shift modifier not delivered
|
||||
- x11 copy to clipboard
|
||||
- one-column table doesn't need borders...?
|
||||
|
||||
- httpd search tools
|
||||
- remaining HTML issues need fixing
|
||||
|
@ -26,6 +23,7 @@
|
|||
|
||||
+ ui:
|
||||
|
||||
- one-column table doesn't need borders...?
|
||||
[2:45pm] tathi: Factor's text display is a bit odd sometimes, until you mouse over (or click, if there's no "live" text)
|
||||
[2:48pm] tathi: it appears to be using the font metrics from the sprite tuple, but re-using the texture from the previous letter
|
||||
[2:59pm] tathi: hmm...and it looks like it's only be happening the first time you use a given character (from a given font face)
|
||||
|
@ -36,6 +34,8 @@
|
|||
- autoscroll
|
||||
- page up/down
|
||||
- search and replace
|
||||
- only redraw visible lines
|
||||
- more efficient multi-line inserts
|
||||
- finish gui stepper
|
||||
- windows are not updated while resizing
|
||||
- graphical module manager tool
|
||||
|
|
|
@ -199,6 +199,7 @@ sequences vectors words ;
|
|||
"/library/ui/gadgets/books.factor"
|
||||
"/library/ui/gadgets/outliner.factor"
|
||||
"/library/ui/text/document.factor"
|
||||
"/library/ui/text/elements.factor"
|
||||
"/library/ui/text/editor.factor"
|
||||
"/library/ui/text/commands.factor"
|
||||
"/library/ui/text/field.factor"
|
||||
|
|
|
@ -63,31 +63,6 @@ C: document ( -- document )
|
|||
] each-line 2drop
|
||||
] { } make "\n" join ;
|
||||
|
||||
: replace-columns ( str start# end# line# document -- )
|
||||
[
|
||||
[ swap [ replace-slice ] change-nth ] keep
|
||||
] change-model ;
|
||||
|
||||
: set-on-1 ( lines startloc endloc document -- )
|
||||
>r >r >r first r> second r> first2 swap r> replace-columns ;
|
||||
|
||||
: loc-col/str ( loc lines -- col str )
|
||||
>r first2 swap r> nth ;
|
||||
|
||||
: merge-lines ( lines startloc endloc lines -- str )
|
||||
#! Start line from 0 to start col + end line from end col
|
||||
#! to length
|
||||
tuck loc-col/str tail-slice
|
||||
>r loc-col/str head-slice
|
||||
swap first r> append3 ;
|
||||
|
||||
: set-on>1pre ( str startloc endloc lines -- )
|
||||
[ merge-lines 1array ] 3keep
|
||||
>r [ first ] 2apply 1+ r> replace-slice ;
|
||||
|
||||
: set-on>1 ( str startloc endloc document -- )
|
||||
[ set-on>1pre ] change-model ;
|
||||
|
||||
: text+loc ( lines loc -- loc )
|
||||
over >r over length 1 = [
|
||||
nip first2
|
||||
|
@ -95,10 +70,25 @@ C: document ( -- document )
|
|||
first swap length 1- + 0
|
||||
] if r> peek length + 2array ;
|
||||
|
||||
: prepend-first ( str seq -- seq )
|
||||
0 [ append ] change-nth ;
|
||||
|
||||
: append-last ( str seq -- seq )
|
||||
dup length 1- [ swap append ] change-nth ;
|
||||
|
||||
: prepare-insert ( newinput startloc endloc lines -- newinput )
|
||||
tuck loc-col/str tail-slice >r loc-col/str head-slice r>
|
||||
pick append-last over prepend-first ;
|
||||
|
||||
: (set-doc-range) ( newlines startloc endloc lines -- newlines )
|
||||
[ prepare-insert ] 3keep
|
||||
>r [ first ] 2apply 1+ r>
|
||||
replace-slice ;
|
||||
|
||||
: set-doc-range ( str startloc endloc document -- )
|
||||
[
|
||||
>r >r >r "\n" split r> [ text+loc ] 2keep r> r>
|
||||
pick pick lines-equal? [ set-on-1 ] [ set-on>1 ] if
|
||||
[ (set-doc-range) ] change-model
|
||||
] keep update-locs ;
|
||||
|
||||
: remove-doc-range ( startloc endloc document -- )
|
||||
|
@ -123,72 +113,6 @@ C: document ( -- document )
|
|||
: doc-end ( document -- loc )
|
||||
model-value dup length 1- swap peek length 2array ;
|
||||
|
||||
GENERIC: prev-elt ( loc document elt -- loc )
|
||||
GENERIC: next-elt ( loc document elt -- loc )
|
||||
|
||||
TUPLE: char-elt ;
|
||||
|
||||
: (prev-char) ( loc document quot -- loc )
|
||||
-rot {
|
||||
{ [ over { 0 0 } = ] [ drop ] }
|
||||
{ [ over second zero? ] [ >r first 1- r> line-end ] }
|
||||
{ [ t ] [ pick call ] }
|
||||
} cond nip ; inline
|
||||
|
||||
: (next-char) ( loc document quot -- loc )
|
||||
-rot {
|
||||
{ [ 2dup doc-end = ] [ drop ] }
|
||||
{ [ 2dup line-end? ] [ drop first 1+ 0 2array ] }
|
||||
{ [ t ] [ pick call ] }
|
||||
} cond nip ; inline
|
||||
|
||||
M: char-elt prev-elt
|
||||
drop [ drop -1 +col ] (prev-char) ;
|
||||
|
||||
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
|
||||
r> =col ; inline
|
||||
|
||||
: ((word-elt)) [ ?nth blank? ] 2keep ;
|
||||
|
||||
: (prev-word) ( col str -- col )
|
||||
>r 1- r> ((word-elt))
|
||||
[ 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))
|
||||
[ [ blank? xor ] find-with* drop ] keep
|
||||
over -1 = [ nip length ] [ drop ] if ;
|
||||
|
||||
M: word-elt next-elt
|
||||
drop [ [ (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 ;
|
||||
|
||||
: doc-text ( document -- str )
|
||||
model-value "\n" join ;
|
||||
|
||||
|
|
|
@ -0,0 +1,68 @@
|
|||
IN: gadgets-text
|
||||
USING: arrays kernel math sequences strings ;
|
||||
|
||||
GENERIC: prev-elt ( loc document elt -- loc )
|
||||
GENERIC: next-elt ( loc document elt -- loc )
|
||||
|
||||
TUPLE: char-elt ;
|
||||
|
||||
: (prev-char) ( loc document quot -- loc )
|
||||
-rot {
|
||||
{ [ over { 0 0 } = ] [ drop ] }
|
||||
{ [ over second zero? ] [ >r first 1- r> line-end ] }
|
||||
{ [ t ] [ pick call ] }
|
||||
} cond nip ; inline
|
||||
|
||||
: (next-char) ( loc document quot -- loc )
|
||||
-rot {
|
||||
{ [ 2dup doc-end = ] [ drop ] }
|
||||
{ [ 2dup line-end? ] [ drop first 1+ 0 2array ] }
|
||||
{ [ t ] [ pick call ] }
|
||||
} cond nip ; inline
|
||||
|
||||
M: char-elt prev-elt
|
||||
drop [ drop -1 +col ] (prev-char) ;
|
||||
|
||||
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
|
||||
r> =col ; inline
|
||||
|
||||
: ((word-elt)) [ ?nth blank? ] 2keep ;
|
||||
|
||||
: (prev-word) ( col str -- col )
|
||||
>r 1- r> ((word-elt))
|
||||
[ 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))
|
||||
[ [ blank? xor ] find-with* drop ] keep
|
||||
over -1 = [ nip length ] [ drop ] if ;
|
||||
|
||||
M: word-elt next-elt
|
||||
drop [ [ (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 ;
|
Loading…
Reference in New Issue