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

Merge branch 'master' of git://factorcode.org/git/factor

db4
William Schlieper 2008-07-15 02:49:04 -04:00
parent c02397d3a4 1f3f062bf6
commit 416f002220
17 changed files with 58 additions and 120 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

38
extra/peg/parsers/parsers-docs.factor
View File

@ -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,a,a\" \"a\" token \",\" token list-of parse parse-result-ast ." "V{ \"a\" \"a\" \"a\" \"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 ." "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" }
{ $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\" }" }
{ $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 ." "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" }
{ $example "USING: peg peg.parsers prettyprint ;" "\"aaaa\" \"a\" token 4 exactly-n parse parse-result-ast ." "V{ \"a\" \"a\" \"a\" \"a\" }" }
{ $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 ." "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" }
{ $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 ;" "\"aaaaa\" \"a\" token 4 at-least-n parse parse-result-ast ." "V{ \"a\" \"a\" \"a\" \"a\" \"a\" }" }
{ $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 ." "V{ \"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 ;" "\"aaaaa\" \"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 ." "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 ;" "\"aaaa\" \"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 parse-result-ast ." "V{ \"a\" \"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 ." "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 ;\n\"0\" \"^0-9\" range-pattern parse ." "f" }
{ $example "USING: peg peg.parsers prettyprint strings ;" "\"a\" \"_a-zA-Z\" range-pattern parse 1string ." "\"a\"" }
{ $code "USING: peg peg.parsers prettyprint ;\n\"0\" \"^0-9\" range-pattern parse => exception"}
}
} ;

11
extra/peg/peg-docs.factor
View File

@ -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 "
"the parse was successful, otherwise it is f." }
"Given the input string, parse it using the given parser. The result is the abstract "
"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 parse-result-ast ." "67" }
{ $example "USING: kernel math peg prettyprint ;" "\"C\" [ drop t ] satisfy [ 66 > ] semantic parse ." "67" }
} ;
HELP: ensure

9
extra/ui/gadgets/frames/frames-docs.factor
View File

@ -8,7 +8,6 @@ ARTICLE: "ui-frame-layout" "Frame layouts"
"Creating empty frames:"
{ $subsection <frame> }
"Creating new frames using a combinator:"
{ $subsection make-frame }
{ $subsection frame, }
"A set of mnemonic words for the positions on a frame's 3x3 grid; these words push values which may be passed to " { $link grid-add } " or " { $link frame, } ":"
{ $subsection @center }
@ -44,15 +43,9 @@ HELP: <frame>
{ $values { "frame" frame } }
{ $description "Creates a new " { $link frame } " for laying out gadgets in a 3x3 grid." } ;
{ <frame> make-frame } related-words
HELP: make-frame
{ $values { "quot" quotation } { "frame" frame } }
{ $description "Creates a new frame. The quotation can add children by calling the " { $link frame, } " word." } ;
HELP: frame,
{ $values { "gadget" gadget } { "i" "non-negative integer" } { "j" "non-negative integer" } }
{ $description "Adds a child gadget at the specified location. This word can only be called inside the quotation passed to " { $link make-frame } "." } ;
{ $description "Adds a child gadget at the specified location. This word can only be called inside the quotation passed to make-frame." } ;
{ grid frame } related-words

3
extra/ui/gadgets/frames/frames.factor
View File

@ -39,8 +39,5 @@ M: frame layout*
[ rot rect-dim fill-center ] 3keep
grid-layout ;
: make-frame ( quot -- frame )
<frame> swap make-gadget ; inline
: frame, ( gadget i j -- )
gadget get -rot grid-add ;

8
extra/ui/gadgets/gadgets-docs.factor
View File

@ -180,14 +180,6 @@ HELP: focusable-child
{ $values { "gadget" gadget } { "child" gadget } }
{ $description "Outputs the child of the gadget which would prefer to receive keyboard focus." } ;
HELP: make-gadget
{ $values { "gadget" gadget } { "quot" quotation } }
{ $description "Calls the quotation in a new scope with the gadget stored in the " { $link gadget } " variable." } ;
HELP: with-gadget
{ $values { "gadget" gadget } { "quot" quotation } }
{ $description "Calls the quotation in a new scope with the " { $link gadget } " and " { $link make-gadget } " variables set to " { $snippet "gadget" } } ;
{ control-value set-control-value gadget-model } related-words
HELP: control-value

6
extra/ui/gadgets/gadgets.factor
View File

@ -357,12 +357,6 @@ M: f request-focus-on 2drop ;
: focus-path ( world -- seq )
[ focus>> ] follow ;
: with-gadget ( gadget quot -- )
gadget swap with-variable ; inline
: make-gadget ( gadget quot -- gadget )
[ with-gadget ] [ drop ] 2bi ; inline
! Deprecated
: set-gadget-delegate ( gadget tuple -- )
over [

7
extra/ui/gadgets/labelled/labelled.factor
View File

@ -38,10 +38,9 @@ M: labelled-gadget focusable-child* labelled-gadget-content ;
: <title-label> ( text -- label ) <label> dup title-theme ;
: <title-bar> ( title quot -- gadget )
[
[ <close-box> @left frame, ] when*
<title-label> @center frame,
] make-frame ;
<frame>
swap dup [ <close-box> @left grid-add* ] [ drop ] if
swap <title-label> @center grid-add* ;
TUPLE: closable-gadget < frame content ;

10
extra/ui/gadgets/labels/labels.factor
View File

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

13
extra/ui/gadgets/packs/packs-docs.factor
View File

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

6
extra/ui/gadgets/packs/packs.factor
View File

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

6
extra/ui/gadgets/slots/slots.factor
View File

@ -96,8 +96,10 @@ TUPLE: editable-slot < track printer ref ;
<roll-button> ;
: display-slot ( gadget editable-slot -- )
dup clear-track
[ 1 track, <edit-button> f track, ] with-gadget ;
dup clear-track
swap 1 track-add*
<edit-button> f track-add*
drop ;
: update-slot ( editable-slot -- )
[ [ ref>> get-ref ] [ printer>> ] bi call ] keep

13
extra/ui/gadgets/tabs/tabs.factor
View File

@ -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 -- )
[ [ gadget-parent '[ , , , (del-page) ] "X" swap
<bevel-button> @right frame, ] 3keep
[ swapd <toggle-button> @center frame, ] dip ] make-frame
add-gadget drop ;
:: add-toggle ( model n name toggler -- )
<frame>
n name toggler parent>> '[ , , , (del-page) ] "X" swap <bevel-button>
@right grid-add*
n model name <toggle-button> @center grid-add*
toggler swap add-gadget drop ;
: redo-toggler ( tabbed -- )
[ names>> ] [ model>> ] [ toggler>> ] tri

15
extra/ui/gadgets/tracks/tracks-docs.factor
View File

@ -8,10 +8,7 @@ ARTICLE: "ui-track-layout" "Track layouts"
"Creating empty tracks:"
{ $subsection <track> }
"Adding children:"
{ $subsection track-add }
"Creating new tracks using a combinator:"
{ $subsection make-track }
{ $subsection track, } ;
{ $subsection track-add } ;
HELP: track
{ $class-description "A track is like a " { $link pack } " except each child is resized to a fixed multiple of the track's dimension in the direction of " { $link gadget-orientation } ". Tracks are created by calling " { $link <track> } "." } ;
@ -20,18 +17,8 @@ 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 } "." } ;
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"

17
extra/ui/gadgets/tracks/tracks-tests.factor
View File

@ -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 } ] [
[
<gadget> { 100 100 } over set-rect-dim 1 track,
] { 0 1 } make-track pref-dim
{ 0 1 } <track>
<gadget> { 100 100 } >>dim 1 track-add*
pref-dim
] unit-test
[ { 100 110 } ] [
[
<gadget> { 10 10 } over set-rect-dim f track,
<gadget> { 100 100 } over set-rect-dim 1 track,
] { 0 1 } make-track pref-dim
{ 0 1 } <track>
<gadget> { 10 10 } >>dim f track-add*
<gadget> { 100 100 } >>dim 1 track-add*
pref-dim
] unit-test

6
extra/ui/gadgets/tracks/tracks.factor
View File

@ -53,12 +53,6 @@ M: track pref-dim*
pick sizes>> push
add-gadget ;
: 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

2
extra/ui/tools/listener/listener.factor
View File

@ -31,7 +31,7 @@ TUPLE: listener-gadget < track input output stack ;
: welcome. ( -- )
"If this is your first time with Factor, please read the " print
"cookbook" ($link) "." print nl ;
"handbook" ($link) "." print nl ;
M: listener-gadget focusable-child*
input>> ;

8
extra/ui/ui-docs.factor
View File

@ -232,13 +232,7 @@ ARTICLE: "ui-layout-combinators" "Creating layouts using combinators"
"The " { $link make } " combinator provides a convenient way of constructing sequences by keeping the intermediate sequence off the stack until construction is done. The " { $link , } " and " { $link % } " words operate on this implicit sequence, reducing stack noise."
$nl
"Similar tools exist for constructing complex gadget hierarchies. Different words are used for different types of gadgets; see " { $link "ui-pack-layout" } ", " { $link "ui-track-layout" } " and " { $link "ui-frame-layout" } " for specifics. This section documents their common factors."
$nl
"Gadget construction combinators whose names are prefixed with " { $snippet "make-" } " construct new gadgets and push them on the stack. The primitive combinator used to define all combinators of this form:"
{ $subsection make-gadget }
"Words such as " { $link track, } " access the gadget through the " { $link gadget } " variable."
$nl
"A combinator which stores a gadget in the " { $link gadget } " variable:"
{ $subsection with-gadget } ;
;
ARTICLE: "ui-null-layout" "Manual layouts"
"When automatic layout is not appropriate, gadgets can be added to a parent with no layout policy, and then positioned and sized manually:"