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

Working on tool help

darcs
slava 2006-09-19 06:30:21 +00:00
parent 075a988aad
commit 6c8bcc6307
16 changed files with 155 additions and 86 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
TODO.FACTOR.txt
View File

@ -25,12 +25,11 @@
- the editor should fill up the interior of the scroller completely
- doc sweep
- tool help
- perhaps commands window should sort by gesture
- merge keyboard help with help in some way
- keyboard help: hide commands whose gestures are shadowed
+ ui:
- reliably clonable gadgets
- figure out if we need both set-model and set-model*
- help tool: edit, reload buttons
- words:

2
doc/handbook/handbook.facts
View File

@ -43,6 +43,8 @@ ARTICLE: "handbook" "Factor documentation"
{ $subsection "help" }
{ $subsection "inference" }
{ $subsection "compiler" }
{ $heading "Graphical user interface" }
{ $subsection "ui-tools" }
{ $heading "Index" }
{ $subsection "article-index" }
{ $subsection "primitive-index" }

1
doc/handbook/load.factor
View File

@ -20,4 +20,5 @@ PROVIDE: doc/handbook {
"syntax.facts"
"tools.facts"
"words.facts"
"ui/tools.facts"
} ;

43
doc/handbook/ui/tools.facts Normal file
View File

@ -0,0 +1,43 @@
USING: gadgets gadgets-listener gadgets-browser gadgets-help
gadgets-walker gadgets-dataflow gadgets-workspace help
gadgets-panes gadgets-text listener ;
ARTICLE: "ui-listener" "UI listener"
"The graphical listener is based around the terminal listener (" { $link "listener" } ") and adds an input history and clickable output presentations (" { $link "styles" } ")."
$terpri
"Listeners are instances of " { $link listener-gadget } ". The listener consists of an output area (instance of " { $link pane } "), an input area (instance of " { $link interactor } "), and a stack display kept up to date using a " { $link listener-hook } "."
$terpri
"The word commands appearing in the below list operate on the token at the caret position in the input area. The quotation commands operate on the entire contents of the input area. The walker and dataflow tools are invoked using these commands."
{ $commands listener-gadget }
;
ARTICLE: "ui-browser" "UI definition browser"
"Definition browsers are instances of " { $link browser } "."
{ $commands browser }
;
ARTICLE: "ui-help" "UI documentation browser"
"Documentation browsers are instances of " { $link help-gadget } "."
{ $commands help-gadget }
;
ARTICLE: "ui-walker" "UI walker"
"Walkers are instances of " { $link walker-gadget } "."
{ $commands walker-gadget }
;
ARTICLE: "ui-dataflow" "UI dataflow tool"
"Dataflow viewers are instances of " { $link dataflow-gadget } "."
{ $commands dataflow-gadget }
;
ARTICLE: "ui-tools" "Development tools in the UI"
"UI development tools are integrated into a single-window " { $emphasis "workspace" } ". Multiple workspaces can be open at once, and keyboard commands are provided for switching between tools."
$terpri
"Workspaces are instances of " { $link workspace-window } "."
{ $commands workspace }
{ $subsection "ui-listener" }
{ $subsection "ui-browser" }
{ $subsection "ui-help" }
{ $subsection "ui-walker" }
{ $subsection "ui-dataflow" } ;

12
library/ui/commands.factor
View File

@ -54,16 +54,10 @@ M: object gesture>string drop f ;
: define-commands ( class specs -- )
[ <commands> ] map concat define-commands* ;
: commands ( gadget -- seq )
delegates [ class "commands" word-prop ] map concat ;
: commands ( class -- seq ) "commands" word-prop ;
: all-commands ( gadget -- assoc )
[
parents [
dup commands [ set ] each-with
] each
] make-hash
hash>alist [ [ first command-name ] 2apply <=> ] sort ;
: all-commands ( gadget -- seq )
delegates [ class commands ] map concat ;
: resend-button-down ( gesture world -- )
hand-loc get-global swap send-button-down ;

8
library/ui/text/commands.factor
View File

@ -68,7 +68,7 @@ sequences ;
editor {
{
"Editing"
"Editing commands"
{ "Insert newline" T{ key-down f f "RETURN" } [ "\n" swap user-input ] }
{ "Insert newline" T{ key-down f { S+ } "RETURN" } [ "\n" swap user-input ] }
{ "Insert newline" T{ key-down f f "ENTER" } [ "\n" swap user-input ] }
@ -81,7 +81,7 @@ editor {
}
{
"Clipboard"
"Clipboard commands"
{ "Paste" T{ paste-action } [ clipboard get paste-clipboard ] }
{ "Paste selection" T{ button-up f f 2 } [ selection get paste-clipboard ] }
{ "Copy" T{ copy-action } [ clipboard get editor-copy ] }
@ -90,7 +90,7 @@ editor {
}
{
"Moving caret"
"Caret motion commands"
{ "Position caret" T{ button-down } [ editor-mouse-down ] }
{ "Previous character" T{ key-down f f "LEFT" } [ T{ char-elt } editor-prev ] }
{ "Next character" T{ key-down f f "RIGHT" } [ T{ char-elt } editor-next ] }
@ -105,7 +105,7 @@ editor {
}
{
"Selecting text"
"Text selection commands"
{ "Extend selection" T{ button-down f { S+ } } [ editor-extend-selection ] }
{ "Start selection" T{ drag } [ editor-mouse-drag ] }
{ "Focus editor" T{ gain-focus } [ focus-editor ] }

2
library/ui/text/field.factor
View File

@ -18,7 +18,7 @@ C: field ( model -- field )
field {
{
"Editing"
"Editing commands"
{ "Clear input" T{ key-down f { C+ } "k" } [ control-model clear-doc ] }
{ "Accept input" T{ key-down f f "RETURN" } [ field-commit drop ] }
}

13
library/ui/text/interactor.factor
View File

@ -52,14 +52,15 @@ SYMBOL: structured-input
[ field-commit ] keep interactor-eval
] if ;
: interactor-history. ( -- )
stdio get dup duplex-stream-out [
duplex-stream-in interactor-history
[ dup print-input ] each
] with-stream* ;
M: interactor stream-readln
dup interactor-queue empty? [
f over set-interactor-busy?
[ over set-interactor-continuation stop ] callcc0
] when interactor-queue pop ;
interactor {
{
"Editing commands"
{ "Evaluate" T{ key-down f f "RETURN" } [ interactor-commit ] }
}
} define-commands

2
library/ui/tools/browser.factor
View File

@ -101,7 +101,7 @@ M: browser focusable-child* browser-search ;
browser {
{
"Browser"
"Browser commands"
{ "Clear" T{ key-down f f "CLEAR" } [ clear-browser ] }
}
} define-commands

2
library/ui/tools/dataflow.factor
View File

@ -190,7 +190,7 @@ TUPLE: dataflow-gadget history search ;
dataflow-gadget {
{
"Dataflow"
"Dataflow commands"
{ "Back" T{ key-down f { C+ } "b" } [ dataflow-gadget-history go-back ] }
{ "Forward" T{ key-down f { C+ } "f" } [ dataflow-gadget-history go-forward ] }
}

9
library/ui/tools/help.factor
View File

@ -13,15 +13,6 @@ TUPLE: help-gadget history search ;
: go-home ( help -- ) "handbook" swap show-help ;
help-gadget {
{
"Help"
{ "Back" T{ key-down f { C+ } "b" } [ help-gadget-history go-back ] }
{ "Forward" T{ key-down f { C+ } "f" } [ help-gadget-history go-forward ] }
{ "Home" T{ key-down f { C+ } "h" } [ go-home ] }
}
} define-commands
: <help-pane> ( history -- gadget )
gadget get help-gadget-history [ help ] <pane-control> ;

23
library/ui/tools/listener.factor
View File

@ -61,9 +61,6 @@ M: listener-gadget focusable-child*
drop f
] if ;
: clear-output ( -- )
stdio get duplex-stream-out pane-clear ;
G: call-listener ( quot/string listener -- )
1 standard-combination ;
@ -85,3 +82,23 @@ M: listener-gadget call-tool* ( quot/string listener -- )
] [
[ [ run-file ] each ] curry listener-gadget call-tool
] if ;
: listener-eof ( listener -- )
listener-gadget-input f swap interactor-eval ;
: (listener-history) ( listener -- )
dup listener-gadget-output [
listener-gadget-input interactor-history
[ dup print-input ] each
] with-stream* ;
: listener-history ( listener -- )
[ [ (listener-history) ] curry ] keep
call-listener ;
: clear-listener-output ( listener -- )
[ listener-gadget-output [ pane-clear ] curry ] keep
call-listener ;
: clear-listener-stack ( listener -- )
[ clear ] swap call-listener ;

69
library/ui/tools/operations.factor
View File

@ -5,7 +5,7 @@ USING: definitions gadgets gadgets-browser gadgets-dataflow
gadgets-help gadgets-listener gadgets-text gadgets-workspace
hashtables help inference kernel namespaces parser prettyprint
scratchpad sequences strings styles syntax test tools words
generic ;
generic models ;
V{ } clone operations set-global
@ -49,7 +49,7 @@ M: operation invoke-command ( target operation -- )
! Words
[ word? ] H{
{ +button+ 1 }
{ +group+ "Words" }
{ +group+ "Word commands" }
{ +name+ "Browse" }
{ +gesture+ T{ key-down f { A+ } "b" } }
{ +quot+ [ browser call-tool ] }
@ -57,7 +57,7 @@ M: operation invoke-command ( target operation -- )
[ word? ] H{
{ +button+ 2 }
{ +group+ "Words" }
{ +group+ "Word commands" }
{ +name+ "Edit" }
{ +gesture+ T{ key-down f { A+ } "e" } }
{ +quot+ [ edit ] }
@ -65,14 +65,14 @@ M: operation invoke-command ( target operation -- )
[ word? ] H{
{ +button+ 3 }
{ +group+ "Words" }
{ +group+ "Word commands" }
{ +name+ "Documentation" }
{ +gesture+ T{ key-down f { A+ } "h" } }
{ +quot+ [ help-gadget call-tool ] }
} define-operation
[ word? ] H{
{ +group+ "Words" }
{ +group+ "Word commands" }
{ +name+ "Usage" }
{ +gesture+ T{ key-down f { A+ } "u" } }
{ +quot+ [ usage. ] }
@ -80,7 +80,7 @@ M: operation invoke-command ( target operation -- )
} define-operation
[ word? ] H{
{ +group+ "Words" }
{ +group+ "Word commands" }
{ +name+ "Reload" }
{ +gesture+ T{ key-down f { A+ } "r" } }
{ +quot+ [ reload ] }
@ -88,7 +88,7 @@ M: operation invoke-command ( target operation -- )
} define-operation
[ word? ] H{
{ +group+ "Words" }
{ +group+ "Word commands" }
{ +name+ "Watch" }
{ +quot+ [ watch ] }
{ +listener+ t }
@ -122,7 +122,7 @@ M: operation invoke-command ( target operation -- )
! Strings
[ string? ] H{
{ +group+ "Words" }
{ +group+ "Word commands" }
{ +name+ "Apropos (all)" }
{ +gesture+ T{ key-down f { A+ } "a" } }
{ +quot+ [ apropos ] }
@ -135,7 +135,7 @@ M: operation invoke-command ( target operation -- )
] make-hash hash-values natural-sort ;
[ string? ] H{
{ +group+ "Words" }
{ +group+ "Word commands" }
{ +name+ "Apropos (used)" }
{ +gesture+ T{ key-down f f "TAB" } }
{ +quot+ [ usable-words (apropos) ] }
@ -144,7 +144,7 @@ M: operation invoke-command ( target operation -- )
! Quotations
[ quotation? ] H{
{ +group+ "Quotations" }
{ +group+ "Quotation commands" }
{ +name+ "Infer" }
{ +gesture+ T{ key-down f { C+ A+ } "i" } }
{ +quot+ [ infer . ] }
@ -152,7 +152,7 @@ M: operation invoke-command ( target operation -- )
} define-operation
[ quotation? ] H{
{ +group+ "Quotations" }
{ +group+ "Quotation commands" }
{ +name+ "Dataflow" }
{ +gesture+ T{ key-down f { C+ A+ } "d" } }
{ +quot+ [ show-dataflow ] }
@ -160,7 +160,7 @@ M: operation invoke-command ( target operation -- )
} define-operation
[ quotation? ] H{
{ +group+ "Quotations" }
{ +group+ "Quotation commands" }
{ +name+ "Walk" }
{ +gesture+ T{ key-down f { C+ A+ } "w" } }
{ +quot+ [ walk ] }
@ -168,7 +168,7 @@ M: operation invoke-command ( target operation -- )
} define-operation
[ quotation? ] H{
{ +group+ "Quotations" }
{ +group+ "Quotation commands" }
{ +name+ "Time" }
{ +gesture+ T{ key-down f { C+ A+ } "t" } }
{ +quot+ [ time ] }
@ -177,7 +177,7 @@ M: operation invoke-command ( target operation -- )
! Dataflow nodes
[ word? ] H{
{ +group+ "Words" }
{ +group+ "Word commands" }
{ +name+ "Word dataflow" }
{ +gesture+ T{ key-down f { A+ } "d" } }
{ +quot+ [ word-def show-dataflow ] }
@ -185,7 +185,6 @@ M: operation invoke-command ( target operation -- )
[ [ node? ] is? ] H{
{ +button+ 1 }
{ +group+ "Nodes" }
{ +name+ "Quotation dataflow" }
{ +quot+ [ dataflow-gadget call-tool ] }
} define-operation
@ -200,32 +199,44 @@ T{ command f f "Close" f [ close-tile ] } add*
define-commands*
! Interactor commands
! Listener commands
: selected-word ( editor -- string )
dup gadget-selection?
[ dup T{ word-elt } select-elt ] unless
gadget-selection ;
: listener-selected-word ( listener -- string )
listener-gadget-input selected-word ;
: word-action ( target -- quot )
selected-word search ;
listener-selected-word search ;
: quot-action ( quot -- quot )
field-commit parse ;
listener-gadget-input field-commit parse ;
interactor [
listener-gadget [
{
"Listener"
{ "Evaluate" T{ key-down f f "RETURN" } [ interactor-commit ] }
{ "Send EOF" T{ key-down f { C+ } "d" } [ f swap interactor-eval ] }
"Listener commands"
{ "Send EOF" T{ key-down f { C+ } "d" } [ listener-eof ] }
{ "History" T{ key-down f { C+ } "h" } [ listener-history ] }
{ "Clear output" T{ key-down f f "CLEAR" } [ clear-listener-output ] }
{ "Clear stack" T{ key-down f { C+ } "CLEAR" } [ clear-listener-stack ] }
} <commands> %
[ word-action ] \ word class-operations modify-listener-operations %
[ selected-word ] string class-operations modify-listener-operations %
[ listener-selected-word ] string class-operations modify-listener-operations %
[ quot-action ] quotation class-operations modify-listener-operations %
{
"Listener"
{ "History" T{ key-down f { C+ } "h" } [ [ interactor-history. ] swap interactor-call ] }
{ "Clear output" T{ key-down f f "CLEAR" } [ [ clear-output ] swap interactor-call ] }
{ "Clear stack" T{ key-down f { C+ } "CLEAR" } [ [ clear ] swap interactor-call ] }
} <commands> %
] { } make define-commands*
help-gadget [
{
"Help commands"
{ "Back" T{ key-down f { C+ } "b" } [ help-gadget-history go-back ] }
{ "Forward" T{ key-down f { C+ } "f" } [ help-gadget-history go-forward ] }
{ "Home" T{ key-down f { C+ } "h" } [ go-home ] }
}
[ help-gadget-history model-value ] link class-operations modify-listener-operations
[ command-name "Follow" = not ] subset %
] { } make define-commands*

2
library/ui/tools/walker.factor
View File

@ -77,7 +77,7 @@ M: walker-gadget call-tool* ( continuation walker -- )
walker-gadget {
{
"Walker"
"Walker commands"
{ "Step" T{ key-down f f "s" } [ walker-step ] }
{ "Step in" T{ key-down f f "i" } [ walker-step-in ] }
{ "Step out" T{ key-down f f "o" } [ walker-step-out ] }

23
library/ui/tools/workspace.factor
View File

@ -5,7 +5,7 @@ USING: arrays compiler gadgets gadgets-books gadgets-browser
gadgets-buttons gadgets-controls gadgets-dataflow gadgets-frames
gadgets-grids gadgets-help gadgets-listener
gadgets-presentations gadgets-walker gadgets-workspace generic
kernel math modules scratchpad sequences syntax words ;
kernel math modules scratchpad sequences syntax words io ;
C: tool ( gadget -- tool )
{
@ -49,15 +49,28 @@ M: workspace pref-dim* delegate pref-dim* { 550 650 } vmax ;
[ init-tabs ] keep
open-window ;
: gadget-info. ( gadget -- )
"Gadget: " write
[ class word-name ] keep write-object terpri ;
: keyboard-help ( gadget -- )
parents [
dup all-commands dup empty? [
2drop
] [
swap gadget-info. commands.
] if
] each ;
: commands-window ( workspace -- )
dup find-world world-focus [ ] [ gadget-child ] ?if
[ commands. ] "Commands" pane-window ;
[ keyboard-help ] "Commands" pane-window ;
: tool-window ( class -- ) workspace-window show-tool drop ;
workspace {
{
"Tools"
"Tool switching commands"
{ "Keyboard help" T{ key-down f f "F1" } [ commands-window ] }
{ "Listener" T{ key-down f f "F2" } [ listener-gadget select-tool ] }
{ "Definitions" T{ key-down f f "F3" } [ browser select-tool ] }
@ -67,14 +80,14 @@ workspace {
}
{
"Tools in new window"
"Tool window commands"
{ "New listener" T{ key-down f { S+ } "F2" } [ listener-gadget tool-window drop ] }
{ "New definitions" T{ key-down f { S+ } "F3" } [ browser tool-window drop ] }
{ "New documentation" T{ key-down f { S+ } "F4" } [ help-gadget tool-window drop ] }
}
{
"Workflow"
"Workflow commands"
{ "Reload changed sources" T{ key-down f f "F7" } [ drop [ reload-modules ] listener-gadget call-tool ] }
{ "Recompile changed words" T{ key-down f f "F8" } [ drop [ recompile ] listener-gadget call-tool ] }
}

27
library/ui/ui.factor
View File

@ -120,22 +120,17 @@ C: titled-gadget ( gadget title -- )
windows get [ empty? not ] [ f ] if* ;
: <toolbar> ( gadget -- toolbar )
dup commands [ <command-presentation> ] map-with
dup all-commands
[ <command-presentation> ] map-with
make-shelf ;
: $gadget ( element -- ) first gadget. ;
: command-description ( target command -- element )
[ <command-presentation> \ $gadget swap 2array ] keep
command-gesture gesture>string 2array ;
: gadget-info ( gadget -- )
"Gadget: " write
[ class word-name ] keep write-object terpri ;
: command-description ( command -- element )
dup command-name swap command-gesture gesture>string
2array ;
: command-table. ( commands group -- )
$heading
[ first2 swap command-description ] map
[ command-description ] map
{ "Command" "Gesture" } add* $table ;
: push-hash ( elt key hash -- )
@ -143,14 +138,16 @@ C: titled-gadget ( gadget title -- )
: group-commands ( commands -- seq )
H{ } clone swap
[ dup first command-group pick push-hash ] each
[ dup command-group pick push-hash ] each
hash>alist [ [ first ] 2apply <=> ] sort ;
: commands. ( gadget -- )
dup gadget-info terpri
all-commands [ first command-gesture key-down? ] subset
: commands. ( seq -- )
[ command-gesture key-down? ] subset
group-commands [ first2 swap command-table. ] each ;
: $commands ( elt -- )
dup array? [ first ] when commands commands. ;
: pane-window ( quot title -- )
>r make-pane <scroller> r> open-titled-window ;