- ui docs
- test factor on linux/ppc
- auto-generate error-index
+- C+up/down broken
+ 0.88:
+ misc:
+- if a word drops the stack pointer below the bottom, then an error
+ won't be thrown until the next word accesses the stack
- prettyprinter: clean it up
- prettyprinter: don't build entire tree to print first
- automatic help/effects for slot accessors
"gadgets/sliders.facts"
"gadgets/tracks.facts"
"gadgets/viewports.facts"
+ "text/document.facts"
"text/editor.facts"
} }
{ +tests+ {
[ { 2 0 } ] [
<document> "doc" set
"Hello world,\nhow are you?\nMore text"
- "doc" get set-doc-text
+ "doc" get set-doc-string
{ 10 0 } "doc" get validate-loc
] unit-test
[ { 1 12 } ] [
<document> "doc" set
"Hello world,\nhow are you?\nMore text"
- "doc" get set-doc-text
+ "doc" get set-doc-string
{ 1 20 } "doc" get validate-loc
] unit-test
[ " world,\nhow are you?\nMore" ] [
<document> "doc" set
"Hello world,\nhow are you?\nMore text"
- "doc" get set-doc-text
+ "doc" get set-doc-string
{ 0 5 } { 2 4 } "doc" get doc-range
] unit-test
[ "Hello world,\nhow you?\nMore text" ] [
<document> "doc" set
"Hello world,\nhow are you?\nMore text"
- "doc" get set-doc-text
+ "doc" get set-doc-string
{ 1 3 } { 1 7 } "doc" get remove-doc-range
- "doc" get doc-text
+ "doc" get doc-string
] unit-test
[ "Hello world,\nhow text" ] [
<document> "doc" set
"Hello world,\nhow are you?\nMore text"
- "doc" get set-doc-text
+ "doc" get set-doc-string
{ 1 3 } { 2 4 } "doc" get remove-doc-range
- "doc" get doc-text
+ "doc" get doc-string
] unit-test
[ "Hello world,\nhow you?\nMore text" ] [
<document> "doc" set
"Hello world,\nhow are you?\nMore text"
- "doc" get set-doc-text
+ "doc" get set-doc-string
"" { 1 3 } { 1 7 } "doc" get set-doc-range
- "doc" get doc-text
+ "doc" get doc-string
] unit-test
[ "Hello world,\nhow text" ] [
<document> "doc" set
"Hello world,\nhow are you?\nMore text"
- "doc" get set-doc-text
+ "doc" get set-doc-string
"" { 1 3 } { 2 4 } "doc" get set-doc-range
- "doc" get doc-text
+ "doc" get doc-string
] unit-test
<document> "doc" set
-"Hello world" "doc" get set-doc-text
+"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
<editor> "editor" set
"editor" get graft*
"editor" get <plain-writer> [ \ = see ] with-stream
- "editor" get editor-text [ \ = see ] string-out =
+ "editor" get editor-string [ \ = see ] string-out =
"editor" get ungraft*
] unit-test
[ "foo bar" ] [
<editor> "editor" set
"editor" get graft*
- "foo bar" "editor" get set-editor-text
+ "foo bar" "editor" get set-editor-string
"editor" get T{ one-line-elt } select-elt
"editor" get gadget-selection
"editor" get ungraft*
[ "baz quux" ] [
<editor> "editor" set
"editor" get graft*
- "foo bar\nbaz quux" "editor" get set-editor-text
+ "foo bar\nbaz quux" "editor" get set-editor-string
"editor" get T{ one-line-elt } select-elt
"editor" get gadget-selection
"editor" get ungraft*
USING: arrays generic io kernel math models namespaces sequences
strings test ;
-: +col ( loc n -- loc ) >r first2 r> + 2array ;
+: +col ( loc n -- newloc ) >r first2 r> + 2array ;
-: +line ( loc n -- loc ) >r first2 swap r> + swap 2array ;
+: +line ( loc n -- newloc ) >r first2 swap r> + swap 2array ;
-: =col ( n loc -- loc ) first swap 2array ;
+: =col ( n loc -- newloc ) first swap 2array ;
-: =line ( n loc -- loc ) second 2array ;
+: =line ( n loc -- newloc ) second 2array ;
-: lines-equal? ( loc loc -- n ) [ first ] 2apply number= ;
+: lines-equal? ( loc1 loc2 -- n ) [ first ] 2apply number= ;
TUPLE: document locs ;
: update-locs ( loc document -- )
document-locs [ set-model ] each-with ;
-: doc-line ( line# document -- str ) model-value nth ;
+: doc-line ( n document -- string ) model-value nth ;
-: doc-lines ( from# to# document -- slice )
+: doc-lines ( from to document -- slice )
>r 1+ r> model-value <slice> ;
: start-on-line ( document from line# -- n1 )
nip swap doc-line length
] if ;
-: each-line ( startloc endloc quot -- )
+: each-line ( from to quot -- )
pick pick = [
3drop
] [
>r [ first ] 2apply 1+ dup <slice> r> each
] if ; inline
-: start/end-on-line ( startloc endloc line# -- n1 n2 )
+: start/end-on-line ( from to line# -- n1 n2 )
tuck >r >r document get -rot start-on-line r> r>
document get -rot end-on-line ;
-: (doc-range) ( startloc endloc line# -- )
+: (doc-range) ( from to line# -- )
[ start/end-on-line ] keep document get doc-line <slice> , ;
-: doc-range ( startloc endloc document -- str )
+: doc-range ( from to document -- string )
[
document set 2dup [
>r 2dup r> (doc-range)
: loc-col/str ( loc document -- str col )
>r first2 swap r> nth swap ;
-: prepare-insert ( newinput startloc endloc lines -- newinput )
+: prepare-insert ( newinput from to 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 )
+: (set-doc-range) ( newlines from to lines -- newlines )
[ prepare-insert ] 3keep
>r [ first ] 2apply 1+ r>
replace-slice ;
-: set-doc-range ( str startloc endloc document -- )
+: set-doc-range ( string from to document -- )
[
>r >r >r string-lines r> [ text+loc ] 2keep r> r>
[ (set-doc-range) ] change-model
] keep update-locs ;
-: remove-doc-range ( startloc endloc document -- )
+: remove-doc-range ( from to document -- )
>r >r >r "" r> r> r> set-doc-range ;
: validate-line ( line document -- line )
: validate-col ( col line document -- col )
doc-line length min 0 max ;
-: validate-loc ( loc document -- loc )
+: validate-loc ( loc document -- newloc )
>r first2 swap r> [ validate-line ] keep
>r tuck r> validate-col 2array ;
: doc-end ( document -- loc )
model-value dup length 1- swap peek length 2array ;
-: doc-text ( document -- str )
+: doc-string ( document -- str )
model-value "\n" join ;
: set-doc-lines ( seq document -- )
[ set-model ] keep dup doc-end swap update-locs ;
-: set-doc-text ( string document -- )
+: set-doc-string ( string document -- )
>r string-lines r> set-doc-lines ;
: clear-doc ( document -- )
- "" swap set-doc-text ;
+ "" swap set-doc-string ;
--- /dev/null
+IN: gadgets-text
+USING: help math models strings sequences ;
+
+HELP: +col
+{ $values { "loc" "a pair of integers" } { "n" integer } { "newloc" "a pair of integers" } }
+{ $description "Adds an integer to the column number of a line/column pair." }
+{ $see-also +line =col =line } ;
+
+HELP: +line
+{ $values { "loc" "a pair of integers" } { "n" integer } { "newloc" "a pair of integers" } }
+{ $description "Adds an integer to the line number of a line/column pair." }
+{ $see-also +col =col =line } ;
+
+HELP: =col
+{ $values { "loc" "a pair of integers" } { "n" integer } { "newloc" "a pair of integers" } }
+{ $description "Sets the column number of a line/column pair." }
+{ $see-also +line +col =line } ;
+
+HELP: =line
+{ $values { "loc" "a pair of integers" } { "n" integer } { "newloc" "a pair of integers" } }
+{ $description "Sets the line number of a line/column pair." }
+{ $see-also +col +col =col } ;
+
+HELP: lines-equal?
+{ $values { "loc1" "a pair of integers" } { "loc2" "a pair of integers" } { "boolean" "a boolean" } }
+{ $description "Tests if both line/column pairs have the same line number." } ;
+
+HELP: document
+{ $class-description "A document is a " { $link model } " containing editable text, stored as an array of lines. Documents are created by calling " { $link <document> } ". Documents can be edited with " { $link editor } " gadgets." } ;
+
+HELP: doc-line
+{ $values { "n" "a non-negative integer" } { "document" document } { "string" string } }
+{ $description "Outputs the " { $snippet "n" } "th line of the document." }
+{ $errors "Throws an error if " { $snippet "n" } " is out of bounds." } ;
+
+HELP: doc-lines
+{ $values { "from" "a non-negative integer" } { "to" "a non-negative integer" } { "document" document } { "slice" slice } }
+{ $description "Outputs a range of lines from the document." }
+{ $notes "The range is created by calling " { $link <slice> } "." }
+{ $errors "Throws an error if " { $snippet "from" } " or " { $snippet "to" } " is out of bounds." } ;
+
+HELP: each-line
+{ $values { "from" "a non-negative integer" } { "to" "a non-negative integer" } { "quot" "a quotation with stack effect " { $snippet "( string -- )" } } }
+{ $description "Applies the quotation to each line in the range." }
+{ $notes "The range is created by calling " { $link <slice> } "." }
+{ $errors "Throws an error if " { $snippet "from" } " or " { $snippet "to" } " is out of bounds." } ;
+
+HELP: doc-range
+{ $values { "from" "a pair of integers" } { "to" "a pair of integers" } { "document" document } { "string" "a new " { $link string } } }
+{ $description "Outputs all text in between two line/column number pairs. Lines are separated by " { $snippet "\\n" } "." }
+{ $errors "Throws an error if " { $snippet "from" } " or " { $snippet "to" } " is out of bounds." } ;
+
+HELP: set-doc-range
+{ $values { "string" string } { "from" "a pair of integers" } { "to" "a pair of integers" } { "document" document } }
+{ $description "Replaces all text between two line/column number pairs with " { $snippet "string" } ". The string may use either " { $snippet "\\n" } ", " { $snippet "\\r\\n" } " or " { $snippet "\\r" } " line separators." }
+{ $errors "Throws an error if " { $snippet "from" } " or " { $snippet "to" } " is out of bounds." }
+{ $side-effects "document" } ;
+
+HELP: remove-doc-range
+{ $values { "from" "a pair of integers" } { "to" "a pair of integers" } { "document" document } }
+{ $description "Removes all text between two line/column number pairs." }
+{ $errors "Throws an error if " { $snippet "from" } " or " { $snippet "to" } " is out of bounds." }
+{ $side-effects "document" } ;
+
+HELP: validate-loc
+{ $values { "loc" "a pair of integers" } { "document" document } { "newloc" "a pair of integers" } }
+{ $description "Ensures that the line and column numbers in " { $snippet "loc" } " are valid, clamping them to the permitted range if they are not." } ;
+
+HELP: line-end
+{ $values { "line#" "a non-negative integer" } { "document" document } { "loc" "a pair of integers" } }
+{ $description "Outputs the location where " { $snippet "line#" } " ends." }
+{ $errors "Throws an error if " { $snippet "line#" } " is out of bounds." } ;
+
+HELP: doc-end
+{ $values { "document" document } { "loc" "a pair of integers" } }
+{ $description "Outputs the location of the end of the document." } ;
+
+HELP: doc-string
+{ $values { "document" document } { "string" "a new " { $link string } } }
+{ $description "Outputs the contents of the document as a string." } ;
+
+HELP: set-doc-lines
+{ $values { "array" "an array of strings" } { "document" document } }
+{ $description "Sets the contents of the document to an array of lines." }
+{ $side-effects "document" } ;
+
+HELP: set-doc-string
+{ $values { "array" "an array of strings" } { "document" document } }
+{ $description "Sets the contents of the document to a string, which may use either " { $snippet "\\n" } ", " { $snippet "\\r\\n" } " or " { $snippet "\\r" } " line separators." }
+{ $side-effects "document" } ;
+
+HELP: clear-doc
+{ $values { "document" document } }
+{ $description "Removes all text from the document." }
+{ $side-effects "document" } ;
M: editor user-input*
[ selection-start/end ] keep control-model set-doc-range t ;
-: editor-text ( editor -- str )
- control-model doc-text ;
+: editor-string ( editor -- str )
+ control-model doc-string ;
-: set-editor-text ( str editor -- )
- control-model set-doc-text ;
+: set-editor-string ( str editor -- )
+ control-model set-doc-string ;
! Editors support the stream output protocol
M: editor stream-write1 >r ch>string r> stream-write ;
over empty? [ 2drop ] [ interactor-history push-new ] if ;
: interactor-finish ( obj interactor -- )
- [ editor-text ] keep
+ [ editor-string ] keep
[ interactor-input. ] 2keep
[ add-interactor-history ] keep
dup control-model clear-doc
: interactor-eval ( interactor -- )
[
- [ editor-text ] keep dup interactor-quot call
+ [ editor-string ] keep dup interactor-quot call
] in-thread drop ;
: interactor-eof ( interactor -- )
listener-gadget-input ;
M: listener-gadget call-tool* ( input listener -- )
- >r input-string r> listener-gadget-input set-editor-text ;
+ >r input-string r> listener-gadget-input set-editor-string ;
M: listener-gadget tool-scroller
listener-gadget-output find-scroller ;
: eval-listener ( string -- )
get-listener
- listener-gadget-input [ set-editor-text ] keep
+ listener-gadget-input [ set-editor-string ] keep
interactor-commit ;
: listener-run-files ( seq -- )
! Interactor commands
: quot-action ( interactor -- quot )
- dup editor-text swap select-all ;
+ dup editor-string swap select-all ;
interactor "words"
{ word compound } [ class-operations ] map concat
@center
}
} make-frame*
- [ live-search-field set-editor-text ] keep
+ [ live-search-field set-editor-string ] keep
[ live-search-field editor-doc-end ] keep ;
M: live-search focusable-child* live-search-field ;
: tool-window ( class -- ) workspace-window show-tool 2drop ;
+M: workspace tool-scroller ( workspace -- scroller )
+ workspace-book current-page tool-scroller ;
+
: tool-scroll-up ( workspace -- )
- current-page tool-scroller [ scroll-up-page ] when* ;
+ tool-scroller [ scroll-up-page ] when* ;
: tool-scroll-down ( workspace -- )
- current-page tool-scroller [ scroll-down-page ] when* ;
+ tool-scroller [ scroll-down-page ] when* ;
workspace "scrolling" {
{ "Scroll up" T{ key-down f { C+ } "PAGE_UP" } [ tool-scroll-up ] }
projects / factor.git / commitdiff