Documentation for document class and words

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

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+ {

core/ui/test/document.factor

@@ -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

core/ui/test/editor.factor

@@ -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*

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 <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 ;

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 <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" } ;

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 )
+: editor-string ( editor -- str )
-    control-model doc-text ;
+    control-model doc-string ;
 
-: set-editor-text ( str editor -- )
+: set-editor-string ( str editor -- )
-    control-model set-doc-text ;
+    control-model set-doc-string ;
 
 ! Editors support the stream output protocol
 M: editor stream-write1 >r ch>string r> stream-write ;

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 -- )

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 -- )

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

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 ;

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 ] }