More documentation: menus, panes, presentations
slava
parent
19b52b7eab
commit
b4dda1b0a5
5
TODO.txt
5
TODO.txt
|
|
@ -3,11 +3,12 @@
|
|||
- callback scheduling issue
|
||||
- error popup obscures input area
|
||||
- ui docs
|
||||
- calling 'see' with an nonexistent method should be an error
|
||||
- grid-lines are rendered incorrectly
|
||||
- vocab popup: sort
|
||||
|
||||
+ 0.88:
|
||||
|
||||
- calling 'see' with an nonexistent method should be an error
|
||||
- grid-lines are rendered incorrectly
|
||||
- interactor: show stack effect for word at caret in status bar
|
||||
- lisppaste gui
|
||||
- growable data heap
|
||||
|
|
|
|||
|
|
@ -157,7 +157,7 @@ ARTICLE: "threads" "Multitasking"
|
|||
{ $subsection run-queue }
|
||||
{ $subsection sleep-queue }
|
||||
{ $subsection schedule-thread }
|
||||
{ $subsection idle-thread } ;
|
||||
{ $subsection schedule-thread-with } ;
|
||||
|
||||
ARTICLE: "continuations-internals" "Continuation implementation details"
|
||||
"A continuation is simply a tuple holding the contents of the five stacks:"
|
||||
|
|
|
|||
|
|
@ -10,11 +10,6 @@ SYMBOL: listener-hook
|
|||
|
||||
GENERIC: parse-interactive ( stream -- quot/f )
|
||||
|
||||
TUPLE: interactive-stream ;
|
||||
|
||||
C: interactive-stream ( stream -- stream )
|
||||
[ set-delegate ] keep ;
|
||||
|
||||
: (parse-interactive) ( stream stack -- quot/f )
|
||||
over stream-readln dup [
|
||||
over push \ (parse) with-datastack
|
||||
|
|
@ -27,7 +22,7 @@ C: interactive-stream ( stream -- stream )
|
|||
3drop f
|
||||
] if ;
|
||||
|
||||
M: interactive-stream parse-interactive
|
||||
M: line-reader parse-interactive
|
||||
[
|
||||
[ V{ f } clone (parse-interactive) ] with-parser in get
|
||||
] with-scope in set ;
|
||||
|
|
@ -43,19 +38,16 @@ M: duplex-stream parse-interactive
|
|||
: listen ( -- )
|
||||
[ stdio get parse-interactive [ call ] [ bye ] if* ] try ;
|
||||
|
||||
: (listener) ( -- )
|
||||
: listener ( -- )
|
||||
quit-flag get
|
||||
[ quit-flag off ]
|
||||
[ prompt. listener-hook get call listen (listener) ] if ;
|
||||
[ prompt. listener-hook get call listen listener ] if ;
|
||||
|
||||
: print-banner ( -- )
|
||||
"Factor " write version write
|
||||
" on " write os write "/" write cpu print ;
|
||||
|
||||
: listener ( -- )
|
||||
print-banner use [ clone ] change (listener) ;
|
||||
|
||||
IN: shells
|
||||
|
||||
: tty ( -- )
|
||||
stdio get <interactive-stream> [ listener ] with-stream* ;
|
||||
print-banner use [ clone ] change listener ;
|
||||
|
|
|
|||
|
|
@ -46,6 +46,8 @@ namespaces queues sequences vectors ;
|
|||
stop
|
||||
] callcc0 drop ;
|
||||
|
||||
IN: kernel-internals
|
||||
|
||||
: (idle-thread) ( fast? -- )
|
||||
#! If fast, then we don't sleep, just select()
|
||||
sleep-queue* dup sleep-time dup zero?
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
USING: help threads kernel io ;
|
||||
USING: help threads kernel kernel-internals io ;
|
||||
|
||||
HELP: run-queue
|
||||
{ $values { "queue" "a queue" } }
|
||||
|
|
|
|||
|
|
@ -35,7 +35,7 @@ HELP: <roll-button>
|
|||
HELP: <bevel-button>
|
||||
{ $values { "label" object } { "quot" "a quotation with stack effect " { $snippet "( button -- )" } } }
|
||||
{ $description "Creates a new " { $link button } " with a shaded border which is always visible. The label is converted into a gadget by calling " { $link >label } ". The button appearance changes in response to mouse gestures using a " { $link button-paint } "." }
|
||||
{ $see-also <button> <roll-button> <command-button> <roll-button> <presentation> } ;
|
||||
{ $see-also <button> <roll-button> <command-button> <repeat-button> <presentation> } ;
|
||||
|
||||
HELP: <repeat-button>
|
||||
{ $values { "label" object } { "quot" "a quotation with stack effect " { $snippet "( button -- )" } } }
|
||||
|
|
|
|||
|
|
@ -0,0 +1,7 @@
|
|||
IN: gadgets
|
||||
USING: help gadgets-presentations ;
|
||||
|
||||
HELP: show-menu
|
||||
{ $values { "gadget" gadget } { "owner" gadget } }
|
||||
{ $description "Displays a popup menu in the " { $link world } " containing " { $snippet "owner" } " at the current mouse location." }
|
||||
{ $see-also <commands-menu> operations-menu } ;
|
||||
|
|
@ -1,9 +1,11 @@
|
|||
! Copyright (C) 2005, 2006 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
IN: gadgets-panes
|
||||
USING: gadgets gadgets-buttons gadgets-labels
|
||||
gadgets-scrolling gadgets-theme generic hashtables io kernel
|
||||
namespaces sequences ;
|
||||
USING: arrays gadgets gadgets-borders gadgets-buttons
|
||||
gadgets-labels gadgets-scrolling gadgets-paragraphs
|
||||
gadgets-theme gadgets-presentations gadgets-outliners
|
||||
generic hashtables io kernel namespaces sequences styles
|
||||
strings ;
|
||||
|
||||
TUPLE: pane output current prototype scrolls? ;
|
||||
|
||||
|
|
@ -25,15 +27,12 @@ C: pane ( -- pane )
|
|||
<pile> <incremental> over add-output
|
||||
dup prepare-line ;
|
||||
|
||||
! Panes are streams.
|
||||
|
||||
: scroll-pane ( pane -- )
|
||||
dup pane-scrolls? [ scroll>bottom ] [ drop ] if ;
|
||||
|
||||
TUPLE: pane-stream pane ;
|
||||
|
||||
: prepare-print ( current -- gadget )
|
||||
#! Optimization: if line has 1 child, add the child.
|
||||
dup gadget-children {
|
||||
{ [ dup empty? ] [ 2drop "" <label> ] }
|
||||
{ [ dup length 1 = ] [ nip first ] }
|
||||
|
|
@ -77,7 +76,6 @@ M: pane-stream with-stream-style (with-stream-style) ;
|
|||
GENERIC: write-gadget ( gadget stream -- )
|
||||
|
||||
M: pane-stream write-gadget
|
||||
#! Print a gadget to the given pane.
|
||||
pane-stream-pane pane-current add-gadget ;
|
||||
|
||||
M: duplex-stream write-gadget
|
||||
|
|
@ -87,22 +85,18 @@ M: duplex-stream write-gadget
|
|||
tuck write-gadget stream-terpri ;
|
||||
|
||||
: gadget. ( gadget -- )
|
||||
#! Print a gadget to the current pane.
|
||||
stdio get print-gadget ;
|
||||
|
||||
: ?terpri
|
||||
: ?terpri ( stream -- )
|
||||
dup pane-stream-pane pane-current gadget-children empty?
|
||||
[ dup stream-terpri ] unless drop ;
|
||||
|
||||
: with-pane ( pane quot -- )
|
||||
#! Clear the pane and run the quotation in a scope with
|
||||
#! stdio set to the pane.
|
||||
over scroll>top
|
||||
over pane-clear >r <pane-stream> r>
|
||||
over >r with-stream r> ?terpri ; inline
|
||||
|
||||
: make-pane ( quot -- pane )
|
||||
#! Execute the quotation with output to an output-only pane.
|
||||
<pane> [ swap with-pane ] keep ; inline
|
||||
|
||||
: <scrolling-pane> ( -- pane )
|
||||
|
|
@ -110,3 +104,143 @@ M: duplex-stream write-gadget
|
|||
|
||||
: <pane-control> ( model quot -- pane )
|
||||
[ with-pane ] curry <pane> swap <control> ;
|
||||
|
||||
! Character styles
|
||||
|
||||
: apply-style ( style gadget key quot -- style gadget )
|
||||
>r pick hash r> when* ; inline
|
||||
|
||||
: apply-foreground-style ( style gadget -- style gadget )
|
||||
foreground [ over set-label-color ] apply-style ;
|
||||
|
||||
: apply-background-style ( style gadget -- style gadget )
|
||||
background [ <solid> over set-gadget-interior ] apply-style ;
|
||||
|
||||
: specified-font ( style -- font )
|
||||
[ font swap hash [ "monospace" ] unless* ] keep
|
||||
[ font-style swap hash [ plain ] unless* ] keep
|
||||
font-size swap hash [ 12 ] unless* 3array ;
|
||||
|
||||
: apply-font-style ( style gadget -- style gadget )
|
||||
over specified-font over set-label-font ;
|
||||
|
||||
: apply-presentation-style ( style gadget -- style gadget )
|
||||
presented [ <presentation> ] apply-style ;
|
||||
|
||||
: <styled-label> ( style text -- gadget )
|
||||
<label>
|
||||
apply-foreground-style
|
||||
apply-background-style
|
||||
apply-font-style
|
||||
apply-presentation-style
|
||||
nip ;
|
||||
|
||||
! Paragraph styles
|
||||
|
||||
: apply-wrap-style ( style pane -- style pane )
|
||||
wrap-margin [
|
||||
2dup <paragraph> swap set-pane-prototype
|
||||
<paragraph> over set-pane-current
|
||||
] apply-style ;
|
||||
|
||||
: apply-border-width-style ( style gadget -- style gadget )
|
||||
border-width [ <border> ] apply-style ;
|
||||
|
||||
: apply-border-color-style ( style gadget -- style gadget )
|
||||
border-color [
|
||||
<solid> over set-gadget-boundary
|
||||
] apply-style ;
|
||||
|
||||
: apply-page-color-style ( style gadget -- style gadget )
|
||||
page-color [
|
||||
<solid> over set-gadget-interior
|
||||
] apply-style ;
|
||||
|
||||
: apply-outliner-style ( style gadget -- style gadget )
|
||||
outline [ [ make-pane ] curry <outliner> ] apply-style ;
|
||||
|
||||
: <styled-paragraph> ( style pane -- gadget )
|
||||
apply-wrap-style
|
||||
apply-border-width-style
|
||||
apply-border-color-style
|
||||
apply-page-color-style
|
||||
apply-presentation-style
|
||||
apply-outliner-style
|
||||
nip ;
|
||||
|
||||
: styled-pane ( quot style -- gadget )
|
||||
#! Create a pane, call the quotation to fill it out.
|
||||
>r <pane> dup r> swap <styled-paragraph>
|
||||
>r swap with-pane r> ; inline
|
||||
|
||||
: apply-table-gap-style ( style grid -- style grid )
|
||||
table-gap [ over set-grid-gap ] apply-style ;
|
||||
|
||||
: apply-table-border-style ( style grid -- style grid )
|
||||
table-border [ <grid-lines> over set-gadget-boundary ]
|
||||
apply-style ;
|
||||
|
||||
: styled-grid ( style grid -- grid )
|
||||
<grid>
|
||||
apply-table-gap-style
|
||||
apply-table-border-style
|
||||
nip ;
|
||||
|
||||
: <pane-grid> ( quot style grid -- gadget )
|
||||
[
|
||||
[ pick pick >r >r -rot styled-pane r> r> rot ] map
|
||||
] map styled-grid nip ;
|
||||
|
||||
M: pane-stream with-stream-table
|
||||
>r rot <pane-grid> r> print-gadget ;
|
||||
|
||||
M: pane-stream with-nested-stream
|
||||
>r styled-pane r> write-gadget ;
|
||||
|
||||
! Stream utilities
|
||||
M: pack stream-close drop ;
|
||||
|
||||
M: paragraph stream-close drop ;
|
||||
|
||||
: gadget-write ( string gadget -- )
|
||||
over empty? [
|
||||
2drop
|
||||
] [
|
||||
>r <label> dup text-theme r> add-gadget
|
||||
] if ;
|
||||
|
||||
M: pack stream-write gadget-write ;
|
||||
|
||||
: gadget-bl ( style stream -- )
|
||||
>r " " <styled-label> <word-break-gadget> r> add-gadget ;
|
||||
|
||||
M: paragraph stream-write
|
||||
swap " " split
|
||||
[ over gadget-write ] [ H{ } over gadget-bl ] interleave
|
||||
drop ;
|
||||
|
||||
: gadget-write1 ( char gadget -- )
|
||||
>r ch>string r> stream-write ;
|
||||
|
||||
M: pack stream-write1 gadget-write1 ;
|
||||
|
||||
M: paragraph stream-write1
|
||||
over CHAR: \s =
|
||||
[ H{ } swap gadget-bl drop ] [ gadget-write1 ] if ;
|
||||
|
||||
: gadget-format ( string style stream -- )
|
||||
pick empty?
|
||||
[ 3drop ] [ >r swap <styled-label> r> add-gadget ] if ;
|
||||
|
||||
M: pack stream-format
|
||||
gadget-format ;
|
||||
|
||||
M: paragraph stream-format
|
||||
presented pick hash [
|
||||
gadget-format
|
||||
] [
|
||||
rot " " split
|
||||
[ pick pick gadget-format ]
|
||||
[ 2dup gadget-bl ] interleave
|
||||
2drop
|
||||
] if ;
|
||||
|
|
|
|||
|
|
@ -0,0 +1,62 @@
|
|||
IN: gadgets-panes
|
||||
USING: gadgets models help io kernel ;
|
||||
|
||||
HELP: pane
|
||||
{ $class-description "A pane " { $link gadget } " displays formatted text which is written to a " { $link pane-stream } " targetting the pane. Panes are created by calling " { $link <pane> } ", " { $link <scrolling-pane> } " or " { $link <pane-control> } "." }
|
||||
{ $see-also with-pane make-pane write-gadget print-gadget } ;
|
||||
|
||||
HELP: <pane>
|
||||
{ $values { "pane" "a new " { $link pane } } }
|
||||
{ $description "Creates a new " { $link pane } " gadget." }
|
||||
{ $see-also <scrolling-pane> <pane-control> make-pane } ;
|
||||
|
||||
HELP: pane-stream
|
||||
{ $class-description "Pane streams implement the portion of the " { $link "stream-protocol" } " responsible for output of text, including full support for " { $link "styles" } ". Pane streams also support direct output of gadgets via " { $link write-gadget } " and " { $link print-gadget } ". Pane streams are created by calling " { $link <pane-stream> } "." }
|
||||
{ $see-also <pane> make-pane with-pane } ;
|
||||
|
||||
HELP: <pane-stream> ( pane -- stream )
|
||||
{ $values { "pane" pane } { "stream" "a new " { $link pane-stream } } }
|
||||
{ $description "Creates a new " { $link pane-stream } " for writing to " { $snippet "pane" } "." }
|
||||
{ $see-also <pane> make-pane with-pane } ;
|
||||
|
||||
HELP: write-gadget
|
||||
{ $values { "gadget" gadget } { "stream" "an output stream" } }
|
||||
{ $contract "Writes a gadget to the stream." }
|
||||
{ $notes "Not all streams support this operation." }
|
||||
{ $see-also pane-stream print-gadget gadget. } ;
|
||||
|
||||
HELP: print-gadget
|
||||
{ $values { "gadget" gadget } { "stream" "an output stream" } }
|
||||
{ $description "Writes a gadget to the stream, followed by a newline." }
|
||||
{ $notes "Not all streams support this operation." }
|
||||
{ $see-also pane-stream write-gadget gadget. } ;
|
||||
|
||||
HELP: gadget.
|
||||
{ $values { "gadget" gadget } { "stream" "an output stream" } }
|
||||
{ $description "Writes a gadget followed by a newline to the " { $link stdio } " stream." }
|
||||
{ $notes "Not all streams support this operation." }
|
||||
{ $see-also pane-stream write-gadget print-gadget } ;
|
||||
|
||||
HELP: ?terpri
|
||||
{ $values { "stream" pane-stream } }
|
||||
{ $description "Inserts a line break in the pane unless the current line is empty." } ;
|
||||
|
||||
HELP: with-pane
|
||||
{ $values { "pane" pane } { "quot" quotation } }
|
||||
{ $description "Clears the pane and calls the quotation in a new scope where " { $link stdio } " is rebound to a " { $link pane-stream } " writing to the pane." }
|
||||
{ $see-also make-pane } ;
|
||||
|
||||
HELP: make-pane
|
||||
{ $values { "quot" quotation } { "pane" "a new " { $link pane } } }
|
||||
{ $description "Calls the quotation in a new scope where " { $link stdio } " is rebound to a " { $link pane-stream } " writing to a new pane. The pane is output on the stack after the quotation returns." }
|
||||
{ $see-also with-pane } ;
|
||||
|
||||
HELP: <scrolling-pane>
|
||||
{ $values { "pane" "a new " { $link pane } } }
|
||||
{ $description "Creates a new " { $link pane } " gadget which scrolls any scroll pane containing it to the bottom on output. behaving much like a terminal or logger." }
|
||||
{ $see-also <pane> <pane-control> } ;
|
||||
|
||||
HELP: <pane-control>
|
||||
{ $values { "model" model } { "quot" "a quotation with stack effect " { $snippet "( value -- )" } } { "pane" "a new " { $link pane } } }
|
||||
{ $description "Creates a new " { $link control } " delegating to a " { $link pane } ". When the value of the model changes, the value is pushed on the stack and the quotation is called using " { $link with-pane } "." }
|
||||
{ $see-also <pane> <scrolling-pane> } ;
|
||||
|
|
@ -2,12 +2,10 @@
|
|||
! See http://factorcode.org/license.txt for BSD license.
|
||||
IN: gadgets-presentations
|
||||
USING: arrays definitions gadgets gadgets-borders
|
||||
gadgets-buttons gadgets-labels gadgets-outliners
|
||||
gadgets-panes gadgets-paragraphs gadgets-theme
|
||||
gadgets-buttons gadgets-labels gadgets-theme
|
||||
generic hashtables tools io kernel prettyprint sequences strings
|
||||
styles words help math models namespaces ;
|
||||
|
||||
! Clickable objects
|
||||
TUPLE: presentation object hook ;
|
||||
|
||||
: invoke-presentation ( presentation command -- )
|
||||
|
|
@ -32,7 +30,7 @@ TUPLE: presentation object hook ;
|
|||
M: presentation ungraft* ( presentation -- )
|
||||
dup hide-mouse-help delegate ungraft* ;
|
||||
|
||||
C: presentation ( gadget object -- button )
|
||||
C: presentation ( label object -- button )
|
||||
[ drop ] over set-presentation-hook
|
||||
[ set-presentation-object ] keep
|
||||
swap [ invoke-primary ] <roll-button>
|
||||
|
|
@ -77,143 +75,3 @@ presentation H{
|
|||
: <presentation-help> ( model -- gadget )
|
||||
[ [ summary ] [ "" ] if* ] <filter> <label-control>
|
||||
dup reverse-video-theme ;
|
||||
|
||||
! Character styles
|
||||
|
||||
: apply-style ( style gadget key quot -- style gadget )
|
||||
>r pick hash r> when* ; inline
|
||||
|
||||
: apply-foreground-style ( style gadget -- style gadget )
|
||||
foreground [ over set-label-color ] apply-style ;
|
||||
|
||||
: apply-background-style ( style gadget -- style gadget )
|
||||
background [ <solid> over set-gadget-interior ] apply-style ;
|
||||
|
||||
: specified-font ( style -- font )
|
||||
[ font swap hash [ "monospace" ] unless* ] keep
|
||||
[ font-style swap hash [ plain ] unless* ] keep
|
||||
font-size swap hash [ 12 ] unless* 3array ;
|
||||
|
||||
: apply-font-style ( style gadget -- style gadget )
|
||||
over specified-font over set-label-font ;
|
||||
|
||||
: apply-presentation-style ( style gadget -- style gadget )
|
||||
presented [ <presentation> ] apply-style ;
|
||||
|
||||
: <styled-label> ( style text -- gadget )
|
||||
<label>
|
||||
apply-foreground-style
|
||||
apply-background-style
|
||||
apply-font-style
|
||||
apply-presentation-style
|
||||
nip ;
|
||||
|
||||
! Paragraph styles
|
||||
|
||||
: apply-wrap-style ( style pane -- style pane )
|
||||
wrap-margin [
|
||||
2dup <paragraph> swap set-pane-prototype
|
||||
<paragraph> over set-pane-current
|
||||
] apply-style ;
|
||||
|
||||
: apply-border-width-style ( style gadget -- style gadget )
|
||||
border-width [ <border> ] apply-style ;
|
||||
|
||||
: apply-border-color-style ( style gadget -- style gadget )
|
||||
border-color [
|
||||
<solid> over set-gadget-boundary
|
||||
] apply-style ;
|
||||
|
||||
: apply-page-color-style ( style gadget -- style gadget )
|
||||
page-color [
|
||||
<solid> over set-gadget-interior
|
||||
] apply-style ;
|
||||
|
||||
: apply-outliner-style ( style gadget -- style gadget )
|
||||
outline [ [ make-pane ] curry <outliner> ] apply-style ;
|
||||
|
||||
: <styled-paragraph> ( style pane -- gadget )
|
||||
apply-wrap-style
|
||||
apply-border-width-style
|
||||
apply-border-color-style
|
||||
apply-page-color-style
|
||||
apply-presentation-style
|
||||
apply-outliner-style
|
||||
nip ;
|
||||
|
||||
: styled-pane ( quot style -- gadget )
|
||||
#! Create a pane, call the quotation to fill it out.
|
||||
>r <pane> dup r> swap <styled-paragraph>
|
||||
>r swap with-pane r> ; inline
|
||||
|
||||
: apply-table-gap-style ( style grid -- style grid )
|
||||
table-gap [ over set-grid-gap ] apply-style ;
|
||||
|
||||
: apply-table-border-style ( style grid -- style grid )
|
||||
table-border [ <grid-lines> over set-gadget-boundary ]
|
||||
apply-style ;
|
||||
|
||||
: styled-grid ( style grid -- grid )
|
||||
<grid>
|
||||
apply-table-gap-style
|
||||
apply-table-border-style
|
||||
nip ;
|
||||
|
||||
: <pane-grid> ( quot style grid -- gadget )
|
||||
[
|
||||
[ pick pick >r >r -rot styled-pane r> r> rot ] map
|
||||
] map styled-grid nip ;
|
||||
|
||||
M: pane-stream with-stream-table
|
||||
>r rot <pane-grid> r> print-gadget ;
|
||||
|
||||
M: pane-stream with-nested-stream
|
||||
>r styled-pane r> write-gadget ;
|
||||
|
||||
! Stream utilities
|
||||
M: pack stream-close drop ;
|
||||
|
||||
M: paragraph stream-close drop ;
|
||||
|
||||
: gadget-write ( string gadget -- )
|
||||
over empty? [
|
||||
2drop
|
||||
] [
|
||||
>r <label> dup text-theme r> add-gadget
|
||||
] if ;
|
||||
|
||||
M: pack stream-write gadget-write ;
|
||||
|
||||
: gadget-bl ( style stream -- )
|
||||
>r " " <styled-label> <word-break-gadget> r> add-gadget ;
|
||||
|
||||
M: paragraph stream-write
|
||||
swap " " split
|
||||
[ over gadget-write ] [ H{ } over gadget-bl ] interleave
|
||||
drop ;
|
||||
|
||||
: gadget-write1 ( char gadget -- )
|
||||
>r ch>string r> stream-write ;
|
||||
|
||||
M: pack stream-write1 gadget-write1 ;
|
||||
|
||||
M: paragraph stream-write1
|
||||
over CHAR: \s =
|
||||
[ H{ } swap gadget-bl drop ] [ gadget-write1 ] if ;
|
||||
|
||||
: gadget-format ( string style stream -- )
|
||||
pick empty?
|
||||
[ 3drop ] [ >r swap <styled-label> r> add-gadget ] if ;
|
||||
|
||||
M: pack stream-format
|
||||
gadget-format ;
|
||||
|
||||
M: paragraph stream-format
|
||||
presented pick hash [
|
||||
gadget-format
|
||||
] [
|
||||
rot " " split
|
||||
[ pick pick gadget-format ]
|
||||
[ 2dup gadget-bl ] interleave
|
||||
2drop
|
||||
] if ;
|
||||
|
|
|
|||
|
|
@ -0,0 +1,66 @@
|
|||
IN: gadgets-presentations
|
||||
USING: help gadgets gadgets-buttons gadgets-lists prettyprint
|
||||
generic models ;
|
||||
|
||||
HELP: presentation
|
||||
{ $class-description "A presentation is a " { $link button } " which represents an object. Left-clicking a presentation invokes the default " { $link operation } ", and right-clicking displays a menu of possible operations output by " { $link object-operations } "."
|
||||
$terpri
|
||||
"Presentations are created by calling " { $link <presentation> } "."
|
||||
$terpri
|
||||
"Presentations have two slots:"
|
||||
{ $list
|
||||
{ { $link presentation-object } " - the object being presented." }
|
||||
{ { $link presentation-hook } " - a quotation with stack effect " { $snippet "( presentation -- )" } ". The default value is " { $snippet "[ drop ]" } "." }
|
||||
} }
|
||||
{ $see-also "presentations" <command-button> } ;
|
||||
|
||||
HELP: invoke-presentation
|
||||
{ $values { "presentation" presentation } { "command" command } }
|
||||
{ $description "Calls the " { $link presentation-hook } " and then invokes the command on the " { $link presentation-object } "." }
|
||||
{ $see-also invoke-primary invoke-secondary } ;
|
||||
|
||||
HELP: invoke-primary
|
||||
{ $values { "presentation" presentation } }
|
||||
{ $description "Invokes the " { $link primary-operation } " associated to the " { $link presentation-object } ". This word is executed when the presentation is clicked with the left mouse button." }
|
||||
{ $see-also invoke-secondary } ;
|
||||
|
||||
HELP: invoke-secondary
|
||||
{ $values { "presentation" presentation } }
|
||||
{ $description "Invokes the " { $link secondary-operation } " associated to the " { $link presentation-object } ". This word is executed when a " { $link list } " receives a " { $snippet "RETURN" } " key press." }
|
||||
{ $see-also invoke-primary } ;
|
||||
|
||||
HELP: show-mouse-help
|
||||
{ $values { "presentation" presentation } }
|
||||
{ $description "Displays a " { $link summary } " of the " { $link presentation-object } "in the status bar of the " { $link world } " containing this presentation. This word is executed when the mouse enters the presentation." }
|
||||
{ $see-also hide-mouse-help } ;
|
||||
|
||||
HELP: hide-mouse-help
|
||||
{ $values { "presentation" presentation } }
|
||||
{ $description "Hides the status bar message from the status bar of the " { $link world } " containing this presentation. This word is executed when the mouse leaves the presentation." }
|
||||
{ $see-also show-mouse-help } ;
|
||||
|
||||
HELP: <presentation>
|
||||
{ $values { "label" "a label" } { "object" object } }
|
||||
{ $description "Creates a new " { $link presentation } " derived from " { $link <roll-button> } "." }
|
||||
{ $see-also "presentations" } ;
|
||||
|
||||
HELP: <command-button>
|
||||
{ $values { "target" object } { "command" command } { "button" "a new " button } }
|
||||
{ $description "Creates a " { $link <bevel-button> } " which invokes the command on " { $snippet "target" } " when clicked." }
|
||||
{ $see-also <button> <roll-button> <presentation> } ;
|
||||
|
||||
HELP: <toolbar>
|
||||
{ $values { "target" object } { "classes" "a sequence of class words" } }
|
||||
{ $description "Creates a row of " { $link <command-button> } " gadgets invoking commands on " { $snippet "target" } ". The commands are taken from the " { $snippet "\"toolbar\"" } " command group of each class in " { $snippet "classes" } "." }
|
||||
{ $see-also define-commands } ;
|
||||
|
||||
HELP: <commands-menu>
|
||||
{ $values { "hook" "a quotation with stack effect " { $snippet "( button -- )" } } { "target" object } { "commands" "a sequence of " { $link command } " instances" } { "gadget" "a new " { $link gadget } } }
|
||||
{ $description "Creates a popup menu of commands which are to be invoked on " { $snippet "target" } ". The " { $snippet "hook" } " quotation is run before a command is invoked." }
|
||||
{ $see-also <toolbar> operations-menu show-menu } ;
|
||||
|
||||
HELP: <presentation-help>
|
||||
{ $values { "model" model } }
|
||||
{ $description "Creates a new " { $link gadget } " displaying a " { $link summary } " of the model value." }
|
||||
{ $notes "If the " { $snippet "model" } " is " { $link world-status } ", this gadget will display " { $link presentation } " mouse over help." }
|
||||
{ $see-also show-mouse-help hide-mouse-help } ;
|
||||
|
|
@ -28,13 +28,13 @@ PROVIDE: core/ui
|
|||
"gadgets/tracks.factor"
|
||||
"gadgets/incremental.factor"
|
||||
"gadgets/paragraphs.factor"
|
||||
"gadgets/panes.factor"
|
||||
"gadgets/labelled-gadget.factor"
|
||||
"gadgets/books.factor"
|
||||
"gadgets/outliner.factor"
|
||||
"gadgets/menus.factor"
|
||||
"gadgets/presentations.factor"
|
||||
"gadgets/lists.factor"
|
||||
"gadgets/panes.factor"
|
||||
"gadgets/labelled-gadget.factor"
|
||||
"gadgets/books.factor"
|
||||
"text/document.factor"
|
||||
"text/elements.factor"
|
||||
"text/editor.factor"
|
||||
|
|
@ -66,7 +66,10 @@ PROVIDE: core/ui
|
|||
"gadgets/labelled-gadget.facts"
|
||||
"gadgets/labels.facts"
|
||||
"gadgets/lists.facts"
|
||||
"gadgets/menus.facts"
|
||||
"gadgets/outliner.facts"
|
||||
"gadgets/presentations.facts"
|
||||
"gadgets/panes.facts"
|
||||
"text/editor.facts"
|
||||
} }
|
||||
{ +tests+ {
|
||||
|
|
|
|||
|
|
@ -44,7 +44,7 @@ TUPLE: listener-gadget input output stack ;
|
|||
[ ui-error-hook ] curry error-hook set
|
||||
find-messages batch-errors set
|
||||
welcome.
|
||||
listener
|
||||
tty
|
||||
] with-stream* ;
|
||||
|
||||
: start-listener ( listener -- )
|
||||
|
|
|
|||
|
|
@ -16,7 +16,7 @@ html ; %>
|
|||
<% "word" get "vocab" get word-list %>
|
||||
</td>
|
||||
<td valign="top">
|
||||
<% "word" get "vocab" get lookup [ see-help ] when* %>
|
||||
<% "word" get "vocab" get lookup [ help ] when* %>
|
||||
</td>
|
||||
</tr>
|
||||
</table>
|
||||
|
|
|
|||
Loading…
Reference in New Issue