Improved keyboard help window
parent
efb59f9be2
commit
72a6678623
|
|
@ -4,19 +4,18 @@
|
||||||
- signal 4 on datastack underflow on mac intel??
|
- signal 4 on datastack underflow on mac intel??
|
||||||
- help gadget should not re-render every time it is grafted
|
- help gadget should not re-render every time it is grafted
|
||||||
- alien-indirect
|
- alien-indirect
|
||||||
- command categorization in keyboard help window
|
|
||||||
|
|
||||||
========================================================================
|
========================================================================
|
||||||
|
|
||||||
+ ui:
|
+ ui:
|
||||||
|
|
||||||
|
- perhaps commands window should sort by gesture
|
||||||
- new section in cookbook: philosophy
|
- new section in cookbook: philosophy
|
||||||
- interactor commands: don't invoke if interactor is busy
|
- interactor commands: don't invoke if interactor is busy
|
||||||
- browser: show currently selected vocab & words
|
- browser: show currently selected vocab & words
|
||||||
- roundoff is still not quite right with tracks
|
- roundoff is still not quite right with tracks
|
||||||
- fix top level window positioning
|
- fix top level window positioning
|
||||||
- keyboard help persists after clicking on a link
|
- status help persists after clicking on a link
|
||||||
- grouping commands into categories
|
|
||||||
- tool help
|
- tool help
|
||||||
- merge keyboard help with help in some way
|
- merge keyboard help with help in some way
|
||||||
- keyboard help: hide commands whose gestures are shadowed
|
- keyboard help: hide commands whose gestures are shadowed
|
||||||
|
|
|
||||||
|
|
@ -48,11 +48,11 @@ M: object gesture>string drop f ;
|
||||||
command-gestures "gestures" set-word-prop ;
|
command-gestures "gestures" set-word-prop ;
|
||||||
|
|
||||||
: <commands> ( specs -- commands )
|
: <commands> ( specs -- commands )
|
||||||
#! Specs is an array of { group name gesture quot }
|
#! Specs is an array of { group { name gesture quot }* }
|
||||||
[ first4 <command> ] map ;
|
unclip swap [ first3 <command> ] map-with ;
|
||||||
|
|
||||||
: define-commands ( class specs -- )
|
: define-commands ( class specs -- )
|
||||||
<commands> define-commands* ;
|
[ <commands> ] map concat define-commands* ;
|
||||||
|
|
||||||
: commands ( gadget -- seq )
|
: commands ( gadget -- seq )
|
||||||
delegates [ class "commands" word-prop ] map concat ;
|
delegates [ class "commands" word-prop ] map concat ;
|
||||||
|
|
@ -89,17 +89,15 @@ SYMBOL: +quot+
|
||||||
SYMBOL: +listener+
|
SYMBOL: +listener+
|
||||||
SYMBOL: +gesture+
|
SYMBOL: +gesture+
|
||||||
|
|
||||||
TUPLE: operation predicate tags gesture listener? ;
|
TUPLE: operation predicate button gesture listener? ;
|
||||||
|
|
||||||
: (operation) ( -- command )
|
: (operation) ( -- command )
|
||||||
f +name+ get +gesture+ get +quot+ get <command> ;
|
+group+ get +name+ get +gesture+ get +quot+ get <command> ;
|
||||||
|
|
||||||
: (tags) ( -- seq ) +button+ get +group+ get 2array ;
|
|
||||||
|
|
||||||
C: operation ( predicate hash -- operation )
|
C: operation ( predicate hash -- operation )
|
||||||
swap [
|
swap [
|
||||||
(operation) over set-delegate
|
(operation) over set-delegate
|
||||||
(tags) over set-operation-tags
|
+button+ get over set-operation-button
|
||||||
+listener+ get over set-operation-listener?
|
+listener+ get over set-operation-listener?
|
||||||
] bind
|
] bind
|
||||||
[ set-operation-predicate ] keep ;
|
[ set-operation-predicate ] keep ;
|
||||||
|
|
@ -113,12 +111,10 @@ SYMBOL: operations
|
||||||
"predicate" word-prop
|
"predicate" word-prop
|
||||||
operations get [ operation-predicate = ] subset-with ;
|
operations get [ operation-predicate = ] subset-with ;
|
||||||
|
|
||||||
: tagged-operations ( obj tag -- commands )
|
|
||||||
swap object-operations
|
|
||||||
[ operation-tags member? ] subset-with ;
|
|
||||||
|
|
||||||
: mouse-operation ( obj button# -- command )
|
: mouse-operation ( obj button# -- command )
|
||||||
tagged-operations dup empty? [ drop f ] [ peek ] if ;
|
swap object-operations
|
||||||
|
[ operation-button = ] subset-with
|
||||||
|
dup empty? [ drop f ] [ peek ] if ;
|
||||||
|
|
||||||
: mouse-operations ( obj -- seq )
|
: mouse-operations ( obj -- seq )
|
||||||
3 [ 1+ mouse-operation ] map-with ;
|
3 [ 1+ mouse-operation ] map-with ;
|
||||||
|
|
|
||||||
|
|
@ -67,46 +67,61 @@ sequences ;
|
||||||
: editor-doc-end ( editor -- ) T{ doc-elt } editor-next ;
|
: editor-doc-end ( editor -- ) T{ doc-elt } editor-next ;
|
||||||
|
|
||||||
editor {
|
editor {
|
||||||
{ f "Insert newline" T{ key-down f f "RETURN" } [ "\n" swap user-input ] }
|
{
|
||||||
{ f "Insert newline" T{ key-down f { S+ } "RETURN" } [ "\n" swap user-input ] }
|
"Editing"
|
||||||
{ f "Position caret" T{ button-down } [ editor-mouse-down ] }
|
{ "Insert newline" T{ key-down f f "RETURN" } [ "\n" swap user-input ] }
|
||||||
{ f "Extend selection" T{ button-down f { S+ } } [ editor-extend-selection ] }
|
{ "Insert newline" T{ key-down f { S+ } "RETURN" } [ "\n" swap user-input ] }
|
||||||
{ f "Start selection" T{ drag } [ editor-mouse-drag ] }
|
{ "Delete next character" T{ key-down f f "DELETE" } [ T{ char-elt } editor-delete ] }
|
||||||
{ f "Focus editor" T{ gain-focus } [ focus-editor ] }
|
{ "Delete previous character" T{ key-down f f "BACKSPACE" } [ T{ char-elt } editor-backspace ] }
|
||||||
{ f "Unfocus editor" T{ lose-focus } [ unfocus-editor ] }
|
{ "Delete previous word" T{ key-down f { C+ } "DELETE" } [ T{ word-elt } editor-delete ] }
|
||||||
{ f "Paste" T{ paste-action } [ clipboard get paste-clipboard ] }
|
{ "Delete next word" T{ key-down f { C+ } "BACKSPACE" } [ T{ word-elt } editor-backspace ] }
|
||||||
{ f "Paste selection" T{ button-up f f 2 } [ selection get paste-clipboard ] }
|
{ "Delete to start of line" T{ key-down f { A+ } "DELETE" } [ T{ one-line-elt } editor-delete ] }
|
||||||
{ f "Copy" T{ copy-action } [ clipboard get editor-copy ] }
|
{ "Delete to end of line" T{ key-down f { A+ } "BACKSPACE" } [ T{ one-line-elt } editor-backspace ] }
|
||||||
{ f "Copy selection" T{ button-up } [ selection get editor-copy ] }
|
}
|
||||||
{ f "Cut" T{ cut-action } [ clipboard get editor-cut ] }
|
|
||||||
{ f "Clear" T{ delete-action } [ remove-editor-selection ] }
|
{
|
||||||
{ f "Select all" T{ select-all-action } [ T{ doc-elt } select-elt ] }
|
"Clipboard"
|
||||||
{ f "Select line" T{ key-down f { C+ } "l" } [ T{ one-line-elt } select-elt ] }
|
{ "Paste" T{ paste-action } [ clipboard get paste-clipboard ] }
|
||||||
{ f "Select word" T{ key-down f { C+ } "w" } [ T{ word-elt } select-elt ] }
|
{ "Paste selection" T{ button-up f f 2 } [ selection get paste-clipboard ] }
|
||||||
{ f "Previous character" T{ key-down f f "LEFT" } [ T{ char-elt } editor-prev ] }
|
{ "Copy" T{ copy-action } [ clipboard get editor-copy ] }
|
||||||
{ f "Next character" T{ key-down f f "RIGHT" } [ T{ char-elt } editor-next ] }
|
{ "Copy selection" T{ button-up } [ selection get editor-copy ] }
|
||||||
{ f "Previous line" T{ key-down f f "UP" } [ T{ line-elt } editor-prev ] }
|
{ "Cut" T{ cut-action } [ clipboard get editor-cut ] }
|
||||||
{ f "Next line" T{ key-down f f "DOWN" } [ T{ line-elt } editor-next ] }
|
}
|
||||||
{ f "Select previous character" T{ key-down f { S+ } "LEFT" } [ T{ char-elt } editor-select-prev ] }
|
|
||||||
{ f "Select next character" T{ key-down f { S+ } "RIGHT" } [ T{ char-elt } editor-select-next ] }
|
{
|
||||||
{ f "Select previous line" T{ key-down f { S+ } "UP" } [ T{ line-elt } editor-select-prev ] }
|
"Moving caret"
|
||||||
{ f "Select next line" T{ key-down f { S+ } "DOWN" } [ T{ line-elt } editor-select-next ] }
|
{ "Position caret" T{ button-down } [ editor-mouse-down ] }
|
||||||
{ f "Previous word" T{ key-down f { C+ } "LEFT" } [ T{ word-elt } editor-prev ] }
|
{ "Previous character" T{ key-down f f "LEFT" } [ T{ char-elt } editor-prev ] }
|
||||||
{ f "Next word" T{ key-down f { C+ } "RIGHT" } [ T{ word-elt } editor-next ] }
|
{ "Next character" T{ key-down f f "RIGHT" } [ T{ char-elt } editor-next ] }
|
||||||
{ f "Select previous line" T{ key-down f { S+ C+ } "LEFT" } [ T{ word-elt } editor-select-prev ] }
|
{ "Previous line" T{ key-down f f "UP" } [ T{ line-elt } editor-prev ] }
|
||||||
{ f "Select next line" T{ key-down f { S+ C+ } "RIGHT" } [ T{ word-elt } editor-select-next ] }
|
{ "Next line" T{ key-down f f "DOWN" } [ T{ line-elt } editor-next ] }
|
||||||
{ f "Start of line" T{ key-down f f "HOME" } [ T{ one-line-elt } editor-prev ] }
|
{ "Previous word" T{ key-down f { C+ } "LEFT" } [ T{ word-elt } editor-prev ] }
|
||||||
{ f "End of line" T{ key-down f f "END" } [ T{ one-line-elt } editor-next ] }
|
{ "Next word" T{ key-down f { C+ } "RIGHT" } [ T{ word-elt } editor-next ] }
|
||||||
{ f "Select to start of line" T{ key-down f { S+ } "HOME" } [ T{ one-line-elt } editor-select-prev ] }
|
{ "Start of line" T{ key-down f f "HOME" } [ T{ one-line-elt } editor-prev ] }
|
||||||
{ f "Select to end of line" T{ key-down f { S+ } "END" } [ T{ one-line-elt } editor-select-next ] }
|
{ "End of line" T{ key-down f f "END" } [ T{ one-line-elt } editor-next ] }
|
||||||
{ f "Start of document" T{ key-down f { C+ } "HOME" } [ editor-doc-start ] }
|
{ "Start of document" T{ key-down f { C+ } "HOME" } [ editor-doc-start ] }
|
||||||
{ f "End of document" T{ key-down f { C+ } "END" } [ editor-doc-end ] }
|
{ "End of document" T{ key-down f { C+ } "END" } [ editor-doc-end ] }
|
||||||
{ f "Select start of document" T{ key-down f { C+ S+ } "HOME" } [ T{ doc-elt } editor-select-prev ] }
|
}
|
||||||
{ f "Select end of document" T{ key-down f { C+ S+ } "END" } [ T{ doc-elt } editor-select-next ] }
|
|
||||||
{ f "Delete next character" T{ key-down f f "DELETE" } [ T{ char-elt } editor-delete ] }
|
{
|
||||||
{ f "Delete previous character" T{ key-down f f "BACKSPACE" } [ T{ char-elt } editor-backspace ] }
|
"Selecting text"
|
||||||
{ f "Delete previous word" T{ key-down f { C+ } "DELETE" } [ T{ word-elt } editor-delete ] }
|
{ "Extend selection" T{ button-down f { S+ } } [ editor-extend-selection ] }
|
||||||
{ f "Delete next word" T{ key-down f { C+ } "BACKSPACE" } [ T{ word-elt } editor-backspace ] }
|
{ "Start selection" T{ drag } [ editor-mouse-drag ] }
|
||||||
{ f "Delete to start of line" T{ key-down f { A+ } "DELETE" } [ T{ one-line-elt } editor-delete ] }
|
{ "Focus editor" T{ gain-focus } [ focus-editor ] }
|
||||||
{ f "Delete to end of line" T{ key-down f { A+ } "BACKSPACE" } [ T{ one-line-elt } editor-backspace ] }
|
{ "Unfocus editor" T{ lose-focus } [ unfocus-editor ] }
|
||||||
|
{ "Clear" T{ delete-action } [ remove-editor-selection ] }
|
||||||
|
{ "Select all" T{ select-all-action } [ T{ doc-elt } select-elt ] }
|
||||||
|
{ "Select line" T{ key-down f { C+ } "l" } [ T{ one-line-elt } select-elt ] }
|
||||||
|
{ "Select word" T{ key-down f { C+ } "w" } [ T{ word-elt } select-elt ] }
|
||||||
|
{ "Select previous character" T{ key-down f { S+ } "LEFT" } [ T{ char-elt } editor-select-prev ] }
|
||||||
|
{ "Select next character" T{ key-down f { S+ } "RIGHT" } [ T{ char-elt } editor-select-next ] }
|
||||||
|
{ "Select previous line" T{ key-down f { S+ } "UP" } [ T{ line-elt } editor-select-prev ] }
|
||||||
|
{ "Select next line" T{ key-down f { S+ } "DOWN" } [ T{ line-elt } editor-select-next ] }
|
||||||
|
{ "Select previous line" T{ key-down f { S+ C+ } "LEFT" } [ T{ word-elt } editor-select-prev ] }
|
||||||
|
{ "Select next line" T{ key-down f { S+ C+ } "RIGHT" } [ T{ word-elt } editor-select-next ] }
|
||||||
|
{ "Select to start of line" T{ key-down f { S+ } "HOME" } [ T{ one-line-elt } editor-select-prev ] }
|
||||||
|
{ "Select to end of line" T{ key-down f { S+ } "END" } [ T{ one-line-elt } editor-select-next ] }
|
||||||
|
{ "Select start of document" T{ key-down f { C+ S+ } "HOME" } [ T{ doc-elt } editor-select-prev ] }
|
||||||
|
{ "Select end of document" T{ key-down f { C+ S+ } "END" } [ T{ doc-elt } editor-select-next ] }
|
||||||
|
}
|
||||||
} define-commands
|
} define-commands
|
||||||
|
|
|
||||||
|
|
@ -17,6 +17,9 @@ C: field ( model -- field )
|
||||||
select-all ;
|
select-all ;
|
||||||
|
|
||||||
field {
|
field {
|
||||||
{ f "Clear input" T{ key-down f { C+ } "k" } [ control-model clear-doc ] }
|
{
|
||||||
{ f "Accept input" T{ key-down f f "RETURN" } [ field-commit drop ] }
|
"Editing"
|
||||||
|
{ "Clear input" T{ key-down f { C+ } "k" } [ control-model clear-doc ] }
|
||||||
|
{ "Accept input" T{ key-down f f "RETURN" } [ field-commit drop ] }
|
||||||
|
}
|
||||||
} define-commands
|
} define-commands
|
||||||
|
|
|
||||||
|
|
@ -99,5 +99,8 @@ M: browser focusable-child* browser-search ;
|
||||||
browser-definitions close-definitions ;
|
browser-definitions close-definitions ;
|
||||||
|
|
||||||
browser {
|
browser {
|
||||||
{ f "Clear" T{ key-down f f "CLEAR" } [ clear-browser ] }
|
{
|
||||||
|
"Browser"
|
||||||
|
{ "Clear" T{ key-down f f "CLEAR" } [ clear-browser ] }
|
||||||
|
}
|
||||||
} define-commands
|
} define-commands
|
||||||
|
|
|
||||||
|
|
@ -14,9 +14,12 @@ TUPLE: help-gadget history search ;
|
||||||
: go-home ( help -- ) "handbook" swap show-help ;
|
: go-home ( help -- ) "handbook" swap show-help ;
|
||||||
|
|
||||||
help-gadget {
|
help-gadget {
|
||||||
{ f "Back" T{ key-down f { C+ } "b" } [ help-gadget-history go-back ] }
|
{
|
||||||
{ f "Forward" T{ key-down f { C+ } "f" } [ help-gadget-history go-forward ] }
|
"Help"
|
||||||
{ f "Home" T{ key-down f { C+ } "h" } [ go-home ] }
|
{ "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
|
} define-commands
|
||||||
|
|
||||||
: <help-pane> ( history -- gadget )
|
: <help-pane> ( history -- gadget )
|
||||||
|
|
|
||||||
|
|
@ -56,11 +56,14 @@ TUPLE: walker-gadget model quot ns ;
|
||||||
: walker-step-all dup [ step-all ] walker-command reset-walker ;
|
: walker-step-all dup [ step-all ] walker-command reset-walker ;
|
||||||
|
|
||||||
walker-gadget {
|
walker-gadget {
|
||||||
{ f "Step" T{ key-down f f "s" } [ walker-step ] }
|
{
|
||||||
{ f "Step in" T{ key-down f f "i" } [ walker-step-in ] }
|
"Walker"
|
||||||
{ f "Step out" T{ key-down f f "o" } [ walker-step-out ] }
|
{ "Step" T{ key-down f f "s" } [ walker-step ] }
|
||||||
{ f "Step back" T{ key-down f f "b" } [ walker-step-back ] }
|
{ "Step in" T{ key-down f f "i" } [ walker-step-in ] }
|
||||||
{ f "Continue" T{ key-down f f "c" } [ walker-step-all ] }
|
{ "Step out" T{ key-down f f "o" } [ walker-step-out ] }
|
||||||
|
{ "Step back" T{ key-down f f "b" } [ walker-step-back ] }
|
||||||
|
{ "Continue" T{ key-down f f "c" } [ walker-step-all ] }
|
||||||
|
}
|
||||||
} define-commands
|
} define-commands
|
||||||
|
|
||||||
: init-walker-models ( walker -- model quot )
|
: init-walker-models ( walker -- model quot )
|
||||||
|
|
|
||||||
|
|
@ -76,15 +76,21 @@ M: workspace pref-dim* delegate pref-dim* { 550 650 } vmax ;
|
||||||
: tool-window ( class -- ) workspace-window show-tool drop ;
|
: tool-window ( class -- ) workspace-window show-tool drop ;
|
||||||
|
|
||||||
workspace {
|
workspace {
|
||||||
{ f "Keyboard help" T{ key-down f f "F1" } [ commands-window ] }
|
{
|
||||||
{ f "Listener" T{ key-down f f "F2" } [ listener-gadget select-tool ] }
|
"Tools"
|
||||||
{ f "Definitions" T{ key-down f f "F3" } [ browser select-tool ] }
|
{ "Keyboard help" T{ key-down f f "F1" } [ commands-window ] }
|
||||||
{ f "Documentation" T{ key-down f f "F4" } [ help-gadget select-tool ] }
|
{ "Listener" T{ key-down f f "F2" } [ listener-gadget select-tool ] }
|
||||||
{ f "Walker" T{ key-down f f "F5" } [ walker-gadget select-tool ] }
|
{ "Definitions" T{ key-down f f "F3" } [ browser select-tool ] }
|
||||||
|
{ "Documentation" T{ key-down f f "F4" } [ help-gadget select-tool ] }
|
||||||
|
{ "Walker" T{ key-down f f "F5" } [ walker-gadget select-tool ] }
|
||||||
|
}
|
||||||
|
|
||||||
{ f "New listener" T{ key-down f { S+ } "F2" } [ listener-gadget tool-window drop ] }
|
{
|
||||||
{ f "New definitions" T{ key-down f { S+ } "F3" } [ browser tool-window drop ] }
|
"Tools in new window"
|
||||||
{ f "New documentation" T{ key-down f { S+ } "F4" } [ help-gadget tool-window drop ] }
|
{ "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 ] }
|
||||||
|
}
|
||||||
} define-commands
|
} define-commands
|
||||||
|
|
||||||
! Walker tool
|
! Walker tool
|
||||||
|
|
@ -172,6 +178,7 @@ M: operation invoke-command ( target operation -- )
|
||||||
! Words
|
! Words
|
||||||
[ word? ] H{
|
[ word? ] H{
|
||||||
{ +button+ 1 }
|
{ +button+ 1 }
|
||||||
|
{ +group+ "Words" }
|
||||||
{ +name+ "Browse" }
|
{ +name+ "Browse" }
|
||||||
{ +gesture+ T{ key-down f { A+ } "b" } }
|
{ +gesture+ T{ key-down f { A+ } "b" } }
|
||||||
{ +quot+ [ browser call-tool ] }
|
{ +quot+ [ browser call-tool ] }
|
||||||
|
|
@ -179,6 +186,7 @@ M: operation invoke-command ( target operation -- )
|
||||||
|
|
||||||
[ word? ] H{
|
[ word? ] H{
|
||||||
{ +button+ 2 }
|
{ +button+ 2 }
|
||||||
|
{ +group+ "Words" }
|
||||||
{ +name+ "Edit" }
|
{ +name+ "Edit" }
|
||||||
{ +gesture+ T{ key-down f { A+ } "e" } }
|
{ +gesture+ T{ key-down f { A+ } "e" } }
|
||||||
{ +quot+ [ edit ] }
|
{ +quot+ [ edit ] }
|
||||||
|
|
@ -186,12 +194,14 @@ M: operation invoke-command ( target operation -- )
|
||||||
|
|
||||||
[ word? ] H{
|
[ word? ] H{
|
||||||
{ +button+ 3 }
|
{ +button+ 3 }
|
||||||
|
{ +group+ "Words" }
|
||||||
{ +name+ "Documentation" }
|
{ +name+ "Documentation" }
|
||||||
{ +gesture+ T{ key-down f { A+ } "h" } }
|
{ +gesture+ T{ key-down f { A+ } "h" } }
|
||||||
{ +quot+ [ help-gadget call-tool ] }
|
{ +quot+ [ help-gadget call-tool ] }
|
||||||
} define-operation
|
} define-operation
|
||||||
|
|
||||||
[ word? ] H{
|
[ word? ] H{
|
||||||
|
{ +group+ "Words" }
|
||||||
{ +name+ "Usage" }
|
{ +name+ "Usage" }
|
||||||
{ +gesture+ T{ key-down f { A+ } "u" } }
|
{ +gesture+ T{ key-down f { A+ } "u" } }
|
||||||
{ +quot+ [ usage. ] }
|
{ +quot+ [ usage. ] }
|
||||||
|
|
@ -199,6 +209,7 @@ M: operation invoke-command ( target operation -- )
|
||||||
} define-operation
|
} define-operation
|
||||||
|
|
||||||
[ word? ] H{
|
[ word? ] H{
|
||||||
|
{ +group+ "Words" }
|
||||||
{ +name+ "Reload" }
|
{ +name+ "Reload" }
|
||||||
{ +gesture+ T{ key-down f { A+ } "r" } }
|
{ +gesture+ T{ key-down f { A+ } "r" } }
|
||||||
{ +quot+ [ reload ] }
|
{ +quot+ [ reload ] }
|
||||||
|
|
@ -206,6 +217,7 @@ M: operation invoke-command ( target operation -- )
|
||||||
} define-operation
|
} define-operation
|
||||||
|
|
||||||
[ word? ] H{
|
[ word? ] H{
|
||||||
|
{ +group+ "Words" }
|
||||||
{ +name+ "Watch" }
|
{ +name+ "Watch" }
|
||||||
{ +quot+ [ watch ] }
|
{ +quot+ [ watch ] }
|
||||||
{ +listener+ t }
|
{ +listener+ t }
|
||||||
|
|
@ -239,6 +251,7 @@ M: operation invoke-command ( target operation -- )
|
||||||
|
|
||||||
! Strings
|
! Strings
|
||||||
[ string? ] H{
|
[ string? ] H{
|
||||||
|
{ +group+ "Words" }
|
||||||
{ +name+ "Apropos (all)" }
|
{ +name+ "Apropos (all)" }
|
||||||
{ +gesture+ T{ key-down f { A+ } "a" } }
|
{ +gesture+ T{ key-down f { A+ } "a" } }
|
||||||
{ +quot+ [ apropos ] }
|
{ +quot+ [ apropos ] }
|
||||||
|
|
@ -251,6 +264,7 @@ M: operation invoke-command ( target operation -- )
|
||||||
] make-hash hash-values natural-sort ;
|
] make-hash hash-values natural-sort ;
|
||||||
|
|
||||||
[ string? ] H{
|
[ string? ] H{
|
||||||
|
{ +group+ "Words" }
|
||||||
{ +name+ "Apropos (used)" }
|
{ +name+ "Apropos (used)" }
|
||||||
{ +gesture+ T{ key-down f f "TAB" } }
|
{ +gesture+ T{ key-down f f "TAB" } }
|
||||||
{ +quot+ [ usable-words (apropos) ] }
|
{ +quot+ [ usable-words (apropos) ] }
|
||||||
|
|
@ -259,6 +273,7 @@ M: operation invoke-command ( target operation -- )
|
||||||
|
|
||||||
! Quotations
|
! Quotations
|
||||||
[ quotation? ] H{
|
[ quotation? ] H{
|
||||||
|
{ +group+ "Quotations" }
|
||||||
{ +name+ "Infer" }
|
{ +name+ "Infer" }
|
||||||
{ +gesture+ T{ key-down f { C+ A+ } "i" } }
|
{ +gesture+ T{ key-down f { C+ A+ } "i" } }
|
||||||
{ +quot+ [ infer . ] }
|
{ +quot+ [ infer . ] }
|
||||||
|
|
@ -266,6 +281,7 @@ M: operation invoke-command ( target operation -- )
|
||||||
} define-operation
|
} define-operation
|
||||||
|
|
||||||
[ quotation? ] H{
|
[ quotation? ] H{
|
||||||
|
{ +group+ "Quotations" }
|
||||||
{ +name+ "Walk" }
|
{ +name+ "Walk" }
|
||||||
{ +gesture+ T{ key-down f { C+ A+ } "w" } }
|
{ +gesture+ T{ key-down f { C+ A+ } "w" } }
|
||||||
{ +quot+ [ walk ] }
|
{ +quot+ [ walk ] }
|
||||||
|
|
@ -273,6 +289,7 @@ M: operation invoke-command ( target operation -- )
|
||||||
} define-operation
|
} define-operation
|
||||||
|
|
||||||
[ quotation? ] H{
|
[ quotation? ] H{
|
||||||
|
{ +group+ "Quotations" }
|
||||||
{ +name+ "Time" }
|
{ +name+ "Time" }
|
||||||
{ +gesture+ T{ key-down f { C+ A+ } "t" } }
|
{ +gesture+ T{ key-down f { C+ A+ } "t" } }
|
||||||
{ +quot+ [ time ] }
|
{ +quot+ [ time ] }
|
||||||
|
|
@ -302,8 +319,9 @@ define-commands*
|
||||||
|
|
||||||
interactor [
|
interactor [
|
||||||
{
|
{
|
||||||
{ f "Evaluate" T{ key-down f f "RETURN" } [ interactor-commit ] }
|
"Listener"
|
||||||
{ f "Send EOF" T{ key-down f { C+ } "d" } [ f swap interactor-eval ] }
|
{ "Evaluate" T{ key-down f f "RETURN" } [ interactor-commit ] }
|
||||||
|
{ "Send EOF" T{ key-down f { C+ } "d" } [ f swap interactor-eval ] }
|
||||||
} <commands> %
|
} <commands> %
|
||||||
|
|
||||||
[ word-action ] \ word class-operations modify-listener-operations %
|
[ word-action ] \ word class-operations modify-listener-operations %
|
||||||
|
|
@ -311,8 +329,9 @@ interactor [
|
||||||
[ quot-action ] quotation class-operations modify-listener-operations %
|
[ quot-action ] quotation class-operations modify-listener-operations %
|
||||||
|
|
||||||
{
|
{
|
||||||
{ f "History" T{ key-down f { C+ } "h" } [ [ interactor-history. ] swap interactor-call ] }
|
"Listener"
|
||||||
{ f "Clear output" T{ key-down f f "CLEAR" } [ [ clear-output ] swap interactor-call ] }
|
{ "History" T{ key-down f { C+ } "h" } [ [ interactor-history. ] swap interactor-call ] }
|
||||||
{ f "Clear stack" T{ key-down f { C+ } "CLEAR" } [ [ clear ] 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> %
|
} <commands> %
|
||||||
] { } make define-commands*
|
] { } make define-commands*
|
||||||
|
|
|
||||||
|
|
@ -133,13 +133,24 @@ C: titled-gadget ( gadget title -- )
|
||||||
"Gadget: " write
|
"Gadget: " write
|
||||||
[ class word-name ] keep write-object terpri ;
|
[ class word-name ] keep write-object terpri ;
|
||||||
|
|
||||||
: commands. ( gadget -- )
|
: command-table. ( commands group -- )
|
||||||
dup gadget-info
|
$heading
|
||||||
all-commands
|
|
||||||
[ first command-gesture key-down? ] subset
|
|
||||||
[ first2 swap command-description ] map
|
[ first2 swap command-description ] map
|
||||||
{ "Command" "Gesture" } add* $table ;
|
{ "Command" "Gesture" } add* $table ;
|
||||||
|
|
||||||
|
: push-hash ( elt key hash -- )
|
||||||
|
[ hash ?push ] 2keep set-hash ;
|
||||||
|
|
||||||
|
: group-commands ( commands -- seq )
|
||||||
|
H{ } clone swap
|
||||||
|
[ dup first 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
|
||||||
|
group-commands [ first2 swap command-table. ] each ;
|
||||||
|
|
||||||
: pane-window ( quot title -- )
|
: pane-window ( quot title -- )
|
||||||
>r make-pane <scroller> r> open-titled-window ;
|
>r make-pane <scroller> r> open-titled-window ;
|
||||||
|
|
||||||
|
|
|
||||||
Loading…
Reference in New Issue