From 6c6d131b0b211a03da804562e664d0eaed1a3198 Mon Sep 17 00:00:00 2001 From: slava Date: Sun, 17 Dec 2006 04:17:12 +0000 Subject: [PATCH] Documentation for document class and words --- TODO.txt | 3 ++ core/ui/load.factor | 1 + core/ui/test/document.factor | 24 ++++----- core/ui/test/editor.factor | 6 +-- core/ui/text/document.factor | 38 ++++++------- core/ui/text/document.facts | 95 +++++++++++++++++++++++++++++++++ core/ui/text/editor.factor | 8 +-- core/ui/text/interactor.factor | 4 +- core/ui/tools/listener.factor | 4 +- core/ui/tools/operations.factor | 2 +- core/ui/tools/search.factor | 2 +- core/ui/tools/workspace.factor | 7 ++- 12 files changed, 148 insertions(+), 46 deletions(-) create mode 100644 core/ui/text/document.facts diff --git a/TODO.txt b/TODO.txt index 78b1e0d41c..c3db05911e 100644 --- a/TODO.txt +++ b/TODO.txt @@ -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 diff --git a/core/ui/load.factor b/core/ui/load.factor index 1ef42c09ef..bd8e9513fa 100644 --- a/core/ui/load.factor +++ b/core/ui/load.factor @@ -74,6 +74,7 @@ PROVIDE: core/ui "gadgets/sliders.facts" "gadgets/tracks.facts" "gadgets/viewports.facts" + "text/document.facts" "text/editor.facts" } } { +tests+ { diff --git a/core/ui/test/document.factor b/core/ui/test/document.factor index 3d00758e23..c6b49d7534 100644 --- a/core/ui/test/document.factor +++ b/core/ui/test/document.factor @@ -9,58 +9,58 @@ USING: gadgets-text namespaces test ; [ { 2 0 } ] [ "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 } ] [ "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" ] [ "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" ] [ "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" ] [ "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" ] [ "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" ] [ "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 "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 diff --git a/core/ui/test/editor.factor b/core/ui/test/editor.factor index 6f0a264f6e..60b6103f70 100644 --- a/core/ui/test/editor.factor +++ b/core/ui/test/editor.factor @@ -5,14 +5,14 @@ gadgets ; "editor" set "editor" get graft* "editor" get [ \ = 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" 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" 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* diff --git a/core/ui/text/document.factor b/core/ui/text/document.factor index 4da376fd1d..61f27ced7c 100644 --- a/core/ui/text/document.factor +++ b/core/ui/text/document.factor @@ -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 ; : 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 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 , ; -: 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 ; diff --git a/core/ui/text/document.facts b/core/ui/text/document.facts new file mode 100644 index 0000000000..ef4baa06b1 --- /dev/null +++ b/core/ui/text/document.facts @@ -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 } ". 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 } "." } +{ $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 } "." } +{ $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" } ; diff --git a/core/ui/text/editor.factor b/core/ui/text/editor.factor index e073a95886..f1d29b7967 100644 --- a/core/ui/text/editor.factor +++ b/core/ui/text/editor.factor @@ -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 ; diff --git a/core/ui/text/interactor.factor b/core/ui/text/interactor.factor index 22902c11df..27b537adcb 100644 --- a/core/ui/text/interactor.factor +++ b/core/ui/text/interactor.factor @@ -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 -- ) diff --git a/core/ui/tools/listener.factor b/core/ui/tools/listener.factor index fba28ca9ab..ab32aaafe7 100644 --- a/core/ui/tools/listener.factor +++ b/core/ui/tools/listener.factor @@ -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 -- ) diff --git a/core/ui/tools/operations.factor b/core/ui/tools/operations.factor index 3220ab7224..632f7af45c 100644 --- a/core/ui/tools/operations.factor +++ b/core/ui/tools/operations.factor @@ -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 diff --git a/core/ui/tools/search.factor b/core/ui/tools/search.factor index d84f7bef2f..3d42e5a9a9 100644 --- a/core/ui/tools/search.factor +++ b/core/ui/tools/search.factor @@ -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 ; diff --git a/core/ui/tools/workspace.factor b/core/ui/tools/workspace.factor index 4cb571d448..497569a014 100644 --- a/core/ui/tools/workspace.factor +++ b/core/ui/tools/workspace.factor @@ -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 ] }