Merge branch 'master' of git://double.co.nz/git/factor

extra/peg/parsers/parsers-docs.factor

@@ -11,7 +11,7 @@ HELP: 1token
 } { $description
     "Calls 1string on a character and returns a parser that matches that character."
 } { $examples
-    { $example "USING: peg peg.parsers prettyprint ;" "\"a\" CHAR: a 1token parse parse-result-ast ." "\"a\"" }
+    { $example "USING: peg peg.parsers prettyprint ;" "\"a\" CHAR: a 1token parse ." "\"a\"" }
 } { $see-also 'string' } ;
 
 HELP: (list-of)
@@ -33,8 +33,8 @@ HELP: list-of
     "Returns a parser that returns a list of items separated by the separator parser.  Hides the separators and matches a list of one or more items."
 } { $notes "Use " { $link list-of-many } " to ensure a list contains two or more items." }
 { $examples
-    { $example "USING: peg peg.parsers prettyprint ;" "\"a\" \"a\" token \",\" token list-of parse parse-result-ast ." "V{ \"a\" }" }
+    { $example "USING: peg peg.parsers prettyprint ;" "\"a\" \"a\" token \",\" token list-of parse  ." "V{ \"a\" }" }
-    { $example "USING: peg peg.parsers prettyprint ;" "\"a,a,a,a\" \"a\" token \",\" token list-of parse parse-result-ast ." "V{ \"a\" \"a\" \"a\" \"a\" }" }
+    { $example "USING: peg peg.parsers prettyprint ;" "\"a,a,a,a\" \"a\" token \",\" token list-of parse ." "V{ \"a\" \"a\" \"a\" \"a\" }" }
 } { $see-also list-of-many } ;
     
 HELP: list-of-many
@@ -46,8 +46,8 @@ HELP: list-of-many
     "Returns a parser that returns a list of items separated by the separator parser.  Hides the separators and matches a list of two or more items."
 } { $notes "Use " { $link list-of } " to return a list of only one item."
 } { $examples
-    { $example "USING: peg peg.parsers prettyprint ;" "\"a\" \"a\" token \",\" token list-of-many parse ." "f" }
+    { $code "USING: peg peg.parsers prettyprint ;" "\"a\" \"a\" token \",\" token list-of-many parse => exception" }
-    { $example "USING: peg peg.parsers prettyprint ;" "\"a,a,a,a\" \"a\" token \",\" token list-of-many parse parse-result-ast ." "V{ \"a\" \"a\" \"a\" \"a\" }" }
+    { $example "USING: peg peg.parsers prettyprint ;" "\"a,a,a,a\" \"a\" token \",\" token list-of-many parse ." "V{ \"a\" \"a\" \"a\" \"a\" }" }
 } { $see-also list-of } ;
 
 HELP: epsilon
@@ -72,8 +72,8 @@ HELP: exactly-n
 } { $description
     "Returns a parser that matches an exact repetition of the input parser."
 } { $examples
-    { $example "USING: peg peg.parsers prettyprint ;" "\"aaa\" \"a\" token 4 exactly-n parse ." "f" }
+    { $code "USING: peg peg.parsers prettyprint ;" "\"aaa\" \"a\" token 4 exactly-n parse => exception" }
-    { $example "USING: peg peg.parsers prettyprint ;" "\"aaaa\" \"a\" token 4 exactly-n parse parse-result-ast ." "V{ \"a\" \"a\" \"a\" \"a\" }" }
+    { $example "USING: peg peg.parsers prettyprint ;" "\"aaaa\" \"a\" token 4 exactly-n parse ." "V{ \"a\" \"a\" \"a\" \"a\" }" }
 } { $see-also at-least-n at-most-n from-m-to-n } ;
 
 HELP: at-least-n
@@ -84,9 +84,9 @@ HELP: at-least-n
 } { $description
     "Returns a parser that matches n or more repetitions of the input parser."
 } { $examples
-    { $example "USING: peg peg.parsers prettyprint ;" "\"aaa\" \"a\" token 4 at-least-n parse ." "f" }
+    { $code "USING: peg peg.parsers prettyprint ;" "\"aaa\" \"a\" token 4 at-least-n parse => exception"}
-    { $example "USING: peg peg.parsers prettyprint ;" "\"aaaa\" \"a\" token 4 at-least-n parse parse-result-ast ." "V{ \"a\" \"a\" \"a\" \"a\" }" }
+    { $example "USING: peg peg.parsers prettyprint ;" "\"aaaa\" \"a\" token 4 at-least-n parse ." "V{ \"a\" \"a\" \"a\" \"a\" }" }
-    { $example "USING: peg peg.parsers prettyprint ;" "\"aaaaa\" \"a\" token 4 at-least-n parse parse-result-ast ." "V{ \"a\" \"a\" \"a\" \"a\" \"a\" }" }
+    { $example "USING: peg peg.parsers prettyprint ;" "\"aaaaa\" \"a\" token 4 at-least-n parse ." "V{ \"a\" \"a\" \"a\" \"a\" \"a\" }" }
 } { $see-also exactly-n at-most-n from-m-to-n } ;
 
 HELP: at-most-n
@@ -97,8 +97,8 @@ HELP: at-most-n
 } { $description
     "Returns a parser that matches n or fewer repetitions of the input parser."
 } { $examples
-    { $example "USING: peg peg.parsers prettyprint ;" "\"aaaa\" \"a\" token 4 at-most-n parse parse-result-ast ." "V{ \"a\" \"a\" \"a\" \"a\" }" }
+    { $example "USING: peg peg.parsers prettyprint ;" "\"aaaa\" \"a\" token 4 at-most-n parse ." "V{ \"a\" \"a\" \"a\" \"a\" }" }
-    { $example "USING: peg peg.parsers prettyprint ;" "\"aaaaa\" \"a\" token 4 at-most-n parse parse-result-ast ." "V{ \"a\" \"a\" \"a\" \"a\" }" }
+    { $example "USING: peg peg.parsers prettyprint ;" "\"aaaaa\" \"a\" token 4 at-most-n parse ." "V{ \"a\" \"a\" \"a\" \"a\" }" }
 } { $see-also exactly-n at-least-n from-m-to-n } ;
 
 HELP: from-m-to-n
@@ -110,9 +110,9 @@ HELP: from-m-to-n
 } { $description
     "Returns a parser that matches between and including m to n repetitions of the input parser."
 } { $examples
-    { $example "USING: peg peg.parsers prettyprint ;" "\"aaa\" \"a\" token 3 4 from-m-to-n parse parse-result-ast ." "V{ \"a\" \"a\" \"a\" }" }
+    { $example "USING: peg peg.parsers prettyprint ;" "\"aaa\" \"a\" token 3 4 from-m-to-n parse ." "V{ \"a\" \"a\" \"a\" }" }
-    { $example "USING: peg peg.parsers prettyprint ;" "\"aaaa\" \"a\" token 3 4 from-m-to-n parse parse-result-ast ." "V{ \"a\" \"a\" \"a\" \"a\" }" }
+    { $example "USING: peg peg.parsers prettyprint ;" "\"aaaa\" \"a\" token 3 4 from-m-to-n parse ." "V{ \"a\" \"a\" \"a\" \"a\" }" }
-    { $example "USING: peg peg.parsers prettyprint ;" "\"aaaaa\" \"a\" token 3 4 from-m-to-n parse parse-result-ast ." "V{ \"a\" \"a\" \"a\" \"a\" }" }
+    { $example "USING: peg peg.parsers prettyprint ;" "\"aaaaa\" \"a\" token 3 4 from-m-to-n parse ." "V{ \"a\" \"a\" \"a\" \"a\" }" }
 } { $see-also exactly-n at-most-n at-least-n } ;
 
 HELP: pack
@@ -124,7 +124,7 @@ HELP: pack
 } { $description
     "Returns a parser that parses the begin, body, and end parsers in order.  The begin and end parsers are hidden."
 } { $examples
-    { $example "USING: peg peg.parsers prettyprint ;" "\"hi123bye\" \"hi\" token 'integer' \"bye\" token pack parse parse-result-ast ." "123" }
+    { $example "USING: peg peg.parsers prettyprint ;" "\"hi123bye\" \"hi\" token 'integer' \"bye\" token pack parse ." "123" }
 } { $see-also surrounded-by } ;
 
 HELP: surrounded-by
@@ -136,7 +136,7 @@ HELP: surrounded-by
 } { $description
     "Calls token on begin and end to make them into string parsers.  Returns a parser that parses the begin, body, and end parsers in order.  The begin and end parsers are hidden."
 } { $examples
-    { $example "USING: peg peg.parsers prettyprint ;" "\"hi123bye\" 'integer' \"hi\" \"bye\" surrounded-by parse parse-result-ast ." "123" }
+    { $example "USING: peg peg.parsers prettyprint ;" "\"hi123bye\" 'integer' \"hi\" \"bye\" surrounded-by parse ." "123" }
 } { $see-also pack } ;
 
 HELP: 'digit'
@@ -173,7 +173,7 @@ HELP: range-pattern
 "of characters separated with a dash (-) represents the "
 "range of characters from the first to the second, inclusive."
 { $examples
-    { $example "USING: peg peg.parsers prettyprint strings ;" "\"a\" \"_a-zA-Z\" range-pattern parse parse-result-ast 1string ." "\"a\"" } 
+    { $example "USING: peg peg.parsers prettyprint strings ;" "\"a\" \"_a-zA-Z\" range-pattern parse 1string ." "\"a\"" } 
-    { $example "USING: peg peg.parsers prettyprint ;\n\"0\" \"^0-9\" range-pattern parse ." "f" } 
+    { $code "USING: peg peg.parsers prettyprint ;\n\"0\" \"^0-9\" range-pattern parse => exception"} 
 }
 }  ;

extra/peg/peg-docs.factor

@@ -7,11 +7,11 @@ HELP: parse
 { $values 
   { "input" "a string" } 
   { "parser" "a parser" } 
-  { "result" "a parse-result or f" } 
+  { "ast" "an object" } 
 }
 { $description 
-    "Given the input string, parse it using the given parser. The result is a <parse-result> object if "
+    "Given the input string, parse it using the given parser. The result is the abstract "
-    "the parse was successful, otherwise it is f." } 
+    "syntax tree returned by the parser." } 
 { $see-also compile } ;
 
 HELP: compile
@@ -20,7 +20,7 @@ HELP: compile
   { "word" "a word" } 
 }
 { $description 
-    "Compile the parser to a word. The word will have stack effect ( -- result )."
+    "Compile the parser to a word. The word will have stack effect ( -- ast )."
 } 
 { $see-also parse } ;
 
@@ -104,8 +104,7 @@ HELP: semantic
     "Returns a parser that succeeds if the 'p1' parser succeeds and the quotation called with "
     "the AST produced by 'p1' on the stack returns true." }
 { $examples 
-  { $example "USING: kernel math peg prettyprint ;" "\"A\" [ drop t ] satisfy [ 66 > ] semantic parse ." "f" } 
+  { $example "USING: kernel math peg prettyprint ;" "\"C\" [ drop t ] satisfy [ 66 > ] semantic parse ." "67" } 
-  { $example "USING: kernel math peg prettyprint ;" "\"C\" [ drop t ] satisfy [ 66 > ] semantic parse parse-result-ast ." "67" } 
 } ;
 
 HELP: ensure

extra/ui/gadgets/labels/labels.factor

@@ -64,7 +64,11 @@ M: object >label ;
 M: f >label drop <gadget> ;
 
 : label-on-left ( gadget label -- button )
-    [ >label f track, 1 track, ] { 1 0 } make-track ;
+  { 1 0 } <track>
+    swap >label f track-add*
+    swap        1 track-add* ;
     
 : label-on-right ( label gadget -- button )
-    [ f track, >label 1 track, ] { 1 0 } make-track ;
+  { 1 0 } <track>
+    swap        f track-add*
+    swap >label 1 track-add* ;

extra/ui/gadgets/packs/packs-docs.factor

@@ -9,9 +9,6 @@ ARTICLE: "ui-pack-layout" "Pack layouts"
 { $subsection <pack> }
 { $subsection <pile> }
 { $subsection <shelf> }
-"Creating packs using a combinator:"
-{ $subsection make-filled-pile }
-{ $subsection make-shelf }
 
 "For more control, custom layouts can reuse portions of pack layout logic:"
 { $subsection pack-pref-dim }
@@ -23,8 +20,6 @@ HELP: pack
     { $link <pack> }
     { $link <pile> }
     { $link <shelf> }
-    { $link make-filled-pile }
-    { $link make-shelf }
 }
 "Packs have the following slots:"
 { $list
@@ -62,12 +57,4 @@ HELP: pack-pref-dim
     "This word is useful if you are writing your own layout gadget which inherits from " { $link pack } ". This allows you to reuse layout logic while computing gadget sizes using a custom procedure."
 } ;
 
-HELP: make-filled-pile
-{ $values { "quot" quotation } { "pack" "a new " { $link pack } } }
-{ $description "Creates a new " { $link pack } " which lays out a sequence of gadgets vertically, such that all gadgets have the same width. The quotation can add children by calling the gadget, word." } ;
-
-HELP: make-shelf
-{ $values { "quot" quotation } { "pack" "a new " { $link pack } } }
-{ $description "Creates a new " { $link pack } " which lays out a sequence of gadgets horizontally. The quotation can add children by calling the gadget, word." } ;
-
 ABOUT: "ui-pack-layout"

extra/ui/gadgets/packs/packs.factor

@@ -60,9 +60,3 @@ M: pack layout*
 M: pack children-on ( rect gadget -- seq )
     dup gadget-orientation swap gadget-children
     [ fast-children-on ] keep <slice> ;
-
-: make-filled-pile ( quot -- pack )
-    <filled-pile> swap make-gadget ; inline
-
-: make-shelf ( quot -- pack )
-    <shelf> swap make-gadget ; inline

extra/ui/gadgets/tabs/tabs.factor

@@ -4,7 +4,7 @@
 USING: accessors kernel fry math math.vectors sequences arrays vectors assocs
        hashtables models models.range models.compose combinators
        ui ui.gadgets ui.gadgets.buttons ui.gadgets.frames ui.gadgets.packs
-       ui.gadgets.grids ui.gadgets.viewports ui.gadgets.books ;
+       ui.gadgets.grids ui.gadgets.viewports ui.gadgets.books locals ;
 
 IN: ui.gadgets.tabs
 
@@ -12,11 +12,12 @@ TUPLE: tabbed < frame names toggler content ;
 
 DEFER: (del-page)
 
-: add-toggle ( model n name toggler -- )
+:: add-toggle ( model n name toggler -- )
-    [ [ gadget-parent '[ , , , (del-page) ] "X" swap
+  <frame>
-       <bevel-button> @right frame, ] 3keep 
+    n name toggler parent>> '[ , , , (del-page) ] "X" swap <bevel-button>
-      [ swapd <toggle-button> @center frame, ] dip ] make-frame
+      @right grid-add*
-    add-gadget drop ;
+    n model name <toggle-button> @center grid-add*
+  toggler swap add-gadget drop ;
 
 : redo-toggler ( tabbed -- )
      [ names>> ] [ model>> ] [ toggler>> ] tri

extra/ui/gadgets/tracks/tracks-docs.factor

@@ -10,7 +10,6 @@ ARTICLE: "ui-track-layout" "Track layouts"
 "Adding children:"
 { $subsection track-add }
 "Creating new tracks using a combinator:"
-{ $subsection make-track }
 { $subsection track, } ;
 
 HELP: track
@@ -20,18 +19,12 @@ HELP: <track>
 { $values { "orientation" "an orientation specifier" } { "track" "a new " { $link track } } }
 { $description "Creates a new track which lays out children along the given axis. Children are laid out vertically if the orientation is " { $snippet "{ 0 1 }" } " and horizontally if the orientation is " { $snippet "{ 1 0 }" } "." } ; 
 
-{ <track> make-track } related-words
-
 HELP: track-add
 { $values { "gadget" gadget } { "track" track } { "constraint" "a number between 0 and 1, or " { $link f } } }
 { $description "Adds a new child to a track. If the constraint is " { $link f } ", the child always occupies its preferred size. Otherwise, the constrant is a fraction of the total size which is allocated for the child." } ;
 
 HELP: track,
 { $values { "gadget" gadget } { "constraint" "a number between 0 and 1, or " { $link f } } }
-{ $description "Adds a new child to a track. If the constraint is " { $link f } ", the child always occupies its preferred size. Otherwise, the constrant is a fraction of the total size which is allocated for the child. This word can only be called inside the quotation passed to " { $link make-track } "." } ;
+{ $description "Adds a new child to a track. If the constraint is " { $link f } ", the child always occupies its preferred size. Otherwise, the constrant is a fraction of the total size which is allocated for the child." } ;
-
-HELP: make-track
-{ $values { "quot" quotation } { "orientation" "an orientation specifier" } { "track" track } }
-{ $description "Creates a new track. The quotation can add children by calling the " { $link track, } " word." } ;
 
 ABOUT: "ui-track-layout"

extra/ui/gadgets/tracks/tracks-tests.factor

@@ -1,15 +1,16 @@
-USING: kernel ui.gadgets ui.gadgets.tracks tools.test math.geometry.rect ;
+USING: kernel ui.gadgets ui.gadgets.tracks tools.test
+       math.geometry.rect accessors ;
 IN: ui.gadgets.tracks.tests
 
 [ { 100 100 } ] [
-    [
+  { 0 1 } <track>
-        <gadget> { 100 100 } over set-rect-dim 1 track,
+    <gadget> { 100 100 } >>dim 1 track-add*
-    ] { 0 1 } make-track pref-dim
+  pref-dim
 ] unit-test
 
 [ { 100 110 } ] [
-    [
+  { 0 1 } <track>
-        <gadget> { 10 10 } over set-rect-dim f track,
+    <gadget> { 10 10 }   >>dim f track-add*
-        <gadget> { 100 100 } over set-rect-dim 1 track,
+    <gadget> { 100 100 } >>dim 1 track-add*
-    ] { 0 1 } make-track pref-dim
+  pref-dim
 ] unit-test

extra/ui/gadgets/tracks/tracks.factor

@@ -56,9 +56,6 @@ M: track pref-dim*
 : track, ( gadget constraint -- )
     gadget get swap track-add ;
 
-: make-track ( quot orientation -- track )
-    <track> swap make-gadget ; inline
-
 : track-remove ( gadget track -- )
     over [
         [ gadget-children index ] 2keep