factor/core/ui/hierarchy.facts

129 lines
8.1 KiB
Plaintext
Raw Normal View History

USING: help gadgets-text gadgets-tracks quotations generic
kernel ;
IN: gadgets
HELP: graft*
{ $values { "gadget" gadget } }
{ $contract "Called to notify the gadget it has become visible on the screen. This should set up timers and threads, and acquire any resources used by the gadget." } ;
{ graft graft* ungraft ungraft* } related-words
HELP: ungraft*
{ $values { "gadget" gadget } }
{ $contract "Called to notify the gadget it is no longer visible on the screen. This should stop timers and threads, and release any resources used by the gadget." } ;
HELP: graft
{ $values { "gadget" gadget } }
{ $description "Calls " { $link graft* } " on the gadget and all children." }
{ $notes "This word should never be called directly." } ;
HELP: ungraft
{ $values { "gadget" gadget } }
{ $description "If the gadget is grafted, calls " { $link ungraft* } " on the gadget and all children." }
{ $notes "This word should never be called directly." } ;
HELP: unparent
{ $values { "gadget" gadget } }
{ $description "Removes the gadget from its parent. This will relayout the parent." }
{ $notes "This may result in " { $link ungraft* } " being called on the gadget and its children, if the gadget's parent is visible on the screen." }
{ $warning "Some gadget classes have their own words for removing children, for example " { $link grid-remove } ". Read the documentation for the class of the gadget's parent before using this word." } ;
HELP: clear-gadget
{ $values { "gadget" gadget } }
{ $description "Removes all children from the gadget. This will relayout the gadget." }
{ $notes "This may result in " { $link ungraft* } " being called on the children, if the gadget is visible on the screen." }
{ $warning "Some gadget classes have their own words for adding children, for example " { $link grid-remove } ". Read the documentation for the gadget class before using this word." }
{ $side-effects "gadget" } ;
HELP: add-gadget
{ $values { "gadget" gadget } { "parent" gadget } }
{ $description "Adds a child gadget to a parent. If the gadget is contained in another gadget, " { $link unparent } " is called on the gadget first. The parent will be relayout." }
{ $notes "Adding a gadget to a parent may result in " { $link graft* } " being called on the children, if the parent is visible on the screen." }
{ $warning "Some gadget classes have their own words for adding children, for example " { $link grid-add } " and " { $link add-incremental } ". Read the documentation for the gadget class before using this word." }
{ $side-effects "parent" } ;
HELP: add-gadgets
{ $values { "seq" "a sequence of gadgets" } { "parent" gadget } }
{ $description "Adds a sequence of gadgets to a parent. The parent will be relayout." }
{ $notes "This may result in " { $link graft* } " being called on the children, if the parent is visible on the screen." }
{ $warning "Some gadget classes have their own words for adding children, for example " { $link grid-add } " and " { $link add-incremental } ". Read the documentation for the gadget class before using this word." }
{ $side-effects "parent" } ;
HELP: parents
{ $values { "gadget" gadget } }
{ $description "Outputs a sequence of all parents of the gadget, with the first element being the gadget itself." } ;
HELP: each-parent
{ $values { "gadget" gadget } { "quot" "a quotation with stack effect " { $snippet "( gadget -- ? )" } } { "?" "a boolean" } }
{ $description "Applies the quotation to every parent of the gadget, starting from the gadget itself, stopping if the quotation yields " { $link f } ". Outputs " { $link t } " if the iteration completed, and outputs " { $link f } " if it was stopped prematurely." } ;
HELP: find-parent
{ $values { "gadget" gadget } { "quot" "a quotation with stack effect " { $snippet "( gadget -- ? )" } } { "parent" gadget } }
{ $description "Outputs the first parent of the gadget, starting from the gadget itself, for which the quotation outputs a true value, or " { $link f } " if the quotation outputs " { $link f } " for every parent." } ;
HELP: screen-loc
{ $values { "gadget" gadget } { "loc" "a pair of integers" } }
{ $description "Outputs the location of the gadget relative to the top-left corner of the world containing the gadget. This word does not output a useful value if the gadget is not grafted." } ;
HELP: child?
{ $values { "parent" gadget } { "child" gadget } { "?" "a boolean" } }
{ $description "Tests if " { $snippet "child" } " is contained inside " { $snippet "parent" } "." } ;
HELP: focusable-child*
{ $values { "gadget" gadget } { "child/t" "a " { $link gadget } " or " { $link t } } }
{ $description "Outputs the child of the gadget which would prefer to receive keyboard focus, or " { $link t } " if the gadget itself should receive focus." }
{ $examples "For example, if your gadget consists of an " { $link editor } " together with an output area whose contents react to changes in editor contents, then the " { $link focusable-child* } " method for your gadget class should return the editor, so that when the gadget is displayed in a window or passed to " { $link request-focus } ", the editor receives keyboard focus automatically." } ;
HELP: focusable-child
{ $values { "gadget" gadget } { "child" gadget } }
{ $description "Outputs the child of the gadget which would prefer to receive keyboard focus." } ;
HELP: gadget,
{ $values { "gadget" gadget } }
{ $description "Adds a new child to the gadget being constructed. This word can only be used from a quotation passed to " { $link make-gadget } " or " { $link build-gadget } "." } ;
HELP: make-gadget
{ $values { "quot" quotation } { "gadget" gadget } }
{ $description "Calls the quotation in a new scope with the gadget stored in the " { $link make-gadget } " variable." }
{ $notes "This word is used to implement " { $link make-pile } ", " { $link make-shelf } ", " { $link make-track } " and " { $link make-frame } "." } ;
HELP: build-gadget
{ $values { "tuple" tuple } { "quot" quotation } { "gadget" gadget } }
{ $description "Delegates the tuple to the gadget, and calls the quotation in a new scope with the tuple stored in the " { $link make-gadget } " and " { $link gadget } " variables." }
{ $notes "This word is used to implement " { $link build-track } " and " { $link build-frame } "." } ;
HELP: make-pile
{ $values { "quot" quotation } { "pack" "a new " { $link pack } } }
{ $description "Creates a new " { $link pack } " which lays out a sequence of gadgets vertically. The quotation can add children by calling the " { $link gadget, } " word." } ;
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 " { $link 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 " { $link gadget, } " word." } ;
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" } ". The quotation can call " { $link g } " and " { $link g-> } " to access the gadget." } ;
HELP: g
{ $values { "gadget" gadget } }
{ $description "Outputs the gadget being built. Can only be used inside a quotation passed to " { $link build-gadget } "." } ;
HELP: g->
{ $values { "x" object } { "gadget" gadget } }
{ $description "Duplicates the top of the stack and outputs the gadget being built. Can only be used inside a quotation passed to " { $link build-gadget } "." }
{ $examples
"The following constructor creates two label gadgets, stores them in tuple slots, and adds them to a " { $link track } " which the tuple will delegate to:"
{ $code
"TUPLE: greeter hello bye ;"
"C: greeter ( -- gadget )"
"["
" \"Hello\" <label> g-> set-greeter-hello 1/4 track,"
" \"Goodbye\" <label> g-> set-greeter-bye 3/4 track,"
"] { 0 1 } build-track ;"
}
} ;