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

Documentation for document class and words

slava 2006-12-17 04:17:12 +00:00
parent f587b91ccf
commit 6c6d131b0b
12 changed files with 148 additions and 46 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
TODO.txt
View File

@ -5,6 +5,7 @@
- ui docs
- test factor on linux/ppc
- auto-generate error-index
- C+up/down broken
+ 0.88:
@ -99,6 +100,8 @@
+ 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

1
core/ui/load.factor
View File

@ -74,6 +74,7 @@ PROVIDE: core/ui
"gadgets/sliders.facts"
"gadgets/tracks.facts"
"gadgets/viewports.facts"
"text/document.facts"
"text/editor.facts"
} }
{ +tests+ {

24
core/ui/test/document.factor
View File

@ -9,58 +9,58 @@ USING: gadgets-text namespaces test ;
[ { 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

6
core/ui/test/editor.factor
View File

@ -5,14 +5,14 @@ gadgets ;
<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*
@ -21,7 +21,7 @@ gadgets ;
[ "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*

38
core/ui/text/document.factor
View File

@ -4,15 +4,15 @@ IN: gadgets-text
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 ;
@ -27,9 +27,9 @@ C: document ( -- document )
: 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 )
@ -42,21 +42,21 @@ C: document ( -- document )
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)
@ -79,22 +79,22 @@ C: document ( -- document )
: 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 )
@ -103,7 +103,7 @@ C: document ( -- document )
: 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 ;
@ -116,14 +116,14 @@ C: document ( -- document )
: 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 ;

95
core/ui/text/document.facts Normal file
View File

@ -0,0 +1,95 @@
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" } ;

8
core/ui/text/editor.factor
View File

@ -217,11 +217,11 @@ M: editor gadget-selection
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 ;

4
core/ui/text/interactor.factor
View File

@ -33,7 +33,7 @@ M: interactor graft*
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
@ -41,7 +41,7 @@ M: interactor graft*
: interactor-eval ( interactor -- )
[
[ editor-text ] keep dup interactor-quot call
[ editor-string ] keep dup interactor-quot call
] in-thread drop ;
: interactor-eof ( interactor -- )

4
core/ui/tools/listener.factor
View File

@ -72,7 +72,7 @@ M: listener-gadget focusable-child*
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 ;
@ -97,7 +97,7 @@ M: listener-gadget tool-help
: 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 -- )

2
core/ui/tools/operations.factor
View File

@ -327,7 +327,7 @@ M: operation invoke-command
! 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

2
core/ui/tools/search.factor
View File

@ -64,7 +64,7 @@ C: live-search ( string seq producer presenter -- gadget )
@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 ;

7
core/ui/tools/workspace.factor
View File

@ -124,11 +124,14 @@ M: workspace focusable-child* workspace-book ;
: 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 ] }