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

Improved keyboard help window

release
slava 2006-09-01 07:58:47 +00:00
parent efb59f9be2
commit 72a6678623
9 changed files with 138 additions and 86 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
TODO.FACTOR.txt
View File

@ -4,19 +4,18 @@
- signal 4 on datastack underflow on mac intel??
- help gadget should not re-render every time it is grafted
- alien-indirect
- command categorization in keyboard help window
========================================================================
+ ui:
- perhaps commands window should sort by gesture
- new section in cookbook: philosophy
- interactor commands: don't invoke if interactor is busy
- browser: show currently selected vocab & words
- roundoff is still not quite right with tracks
- fix top level window positioning
- keyboard help persists after clicking on a link
- grouping commands into categories
- status help persists after clicking on a link
- tool help
- merge keyboard help with help in some way
- keyboard help: hide commands whose gestures are shadowed

22
library/ui/commands.factor
View File

@ -48,11 +48,11 @@ M: object gesture>string drop f ;
command-gestures "gestures" set-word-prop ;
: <commands> ( specs -- commands )
#! Specs is an array of { group name gesture quot }
[ first4 <command> ] map ;
#! Specs is an array of { group { name gesture quot }* }
unclip swap [ first3 <command> ] map-with ;
: define-commands ( class specs -- )
<commands> define-commands* ;
[ <commands> ] map concat define-commands* ;
: commands ( gadget -- seq )
delegates [ class "commands" word-prop ] map concat ;
@ -89,17 +89,15 @@ SYMBOL: +quot+
SYMBOL: +listener+
SYMBOL: +gesture+
TUPLE: operation predicate tags gesture listener? ;
TUPLE: operation predicate button gesture listener? ;
: (operation) ( -- command )
f +name+ get +gesture+ get +quot+ get <command> ;
: (tags) ( -- seq ) +button+ get +group+ get 2array ;
+group+ get +name+ get +gesture+ get +quot+ get <command> ;
C: operation ( predicate hash -- operation )
swap [
(operation) over set-delegate
(tags) over set-operation-tags
+button+ get over set-operation-button
+listener+ get over set-operation-listener?
] bind
[ set-operation-predicate ] keep ;
@ -113,12 +111,10 @@ SYMBOL: operations
"predicate" word-prop
operations get [ operation-predicate = ] subset-with ;
: tagged-operations ( obj tag -- commands )
swap object-operations
[ operation-tags member? ] subset-with ;
: 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 )
3 [ 1+ mouse-operation ] map-with ;

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

@ -67,46 +67,61 @@ sequences ;
: editor-doc-end ( editor -- ) T{ doc-elt } editor-next ;
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 ] }
{ f "Position caret" T{ button-down } [ editor-mouse-down ] }
{ f "Extend selection" T{ button-down f { S+ } } [ editor-extend-selection ] }
{ f "Start selection" T{ drag } [ editor-mouse-drag ] }
{ f "Focus editor" T{ gain-focus } [ focus-editor ] }
{ f "Unfocus editor" T{ lose-focus } [ unfocus-editor ] }
{ f "Paste" T{ paste-action } [ clipboard get paste-clipboard ] }
{ f "Paste selection" T{ button-up f f 2 } [ selection get paste-clipboard ] }
{ f "Copy" T{ copy-action } [ clipboard get editor-copy ] }
{ 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 ] }
{ f "Select line" T{ key-down f { C+ } "l" } [ T{ one-line-elt } select-elt ] }
{ f "Select word" T{ key-down f { C+ } "w" } [ T{ word-elt } select-elt ] }
{ f "Previous character" T{ key-down f f "LEFT" } [ T{ char-elt } editor-prev ] }
{ f "Next character" T{ key-down f f "RIGHT" } [ T{ char-elt } editor-next ] }
{ f "Previous line" T{ key-down f f "UP" } [ T{ line-elt } editor-prev ] }
{ 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 ] }
{ f "Select next line" T{ key-down f { S+ } "DOWN" } [ T{ line-elt } editor-select-next ] }
{ f "Previous word" T{ key-down f { C+ } "LEFT" } [ T{ word-elt } editor-prev ] }
{ f "Next word" T{ key-down f { C+ } "RIGHT" } [ T{ word-elt } editor-next ] }
{ f "Select previous line" T{ key-down f { S+ C+ } "LEFT" } [ T{ word-elt } editor-select-prev ] }
{ f "Select next line" T{ key-down f { S+ C+ } "RIGHT" } [ T{ word-elt } editor-select-next ] }
{ f "Start of line" T{ key-down f f "HOME" } [ T{ one-line-elt } editor-prev ] }
{ f "End of line" T{ key-down f f "END" } [ T{ one-line-elt } editor-next ] }
{ f "Select to start of line" T{ key-down f { S+ } "HOME" } [ T{ one-line-elt } editor-select-prev ] }
{ f "Select to end of line" T{ key-down f { S+ } "END" } [ T{ one-line-elt } editor-select-next ] }
{ f "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 ] }
{ 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 ] }
{ f "Delete previous word" T{ key-down f { C+ } "DELETE" } [ T{ word-elt } editor-delete ] }
{ f "Delete next word" T{ key-down f { C+ } "BACKSPACE" } [ T{ word-elt } editor-backspace ] }
{ f "Delete to start of line" T{ key-down f { A+ } "DELETE" } [ T{ one-line-elt } editor-delete ] }
{ f "Delete to end of line" T{ key-down f { A+ } "BACKSPACE" } [ T{ one-line-elt } editor-backspace ] }
{
"Editing"
{ "Insert newline" T{ key-down f f "RETURN" } [ "\n" swap user-input ] }
{ "Insert newline" T{ key-down f { S+ } "RETURN" } [ "\n" swap user-input ] }
{ "Delete next character" T{ key-down f f "DELETE" } [ T{ char-elt } editor-delete ] }
{ "Delete previous character" T{ key-down f f "BACKSPACE" } [ T{ char-elt } editor-backspace ] }
{ "Delete previous word" T{ key-down f { C+ } "DELETE" } [ T{ word-elt } editor-delete ] }
{ "Delete next word" T{ key-down f { C+ } "BACKSPACE" } [ T{ word-elt } editor-backspace ] }
{ "Delete to start of line" T{ key-down f { A+ } "DELETE" } [ T{ one-line-elt } editor-delete ] }
{ "Delete to end of line" T{ key-down f { A+ } "BACKSPACE" } [ T{ one-line-elt } editor-backspace ] }
}
{
"Clipboard"
{ "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 ] }
{ "Copy selection" T{ button-up } [ selection get editor-copy ] }
{ "Cut" T{ cut-action } [ clipboard get editor-cut ] }
}
{
"Moving caret"
{ "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 ] }
{ "Previous line" T{ key-down f f "UP" } [ T{ line-elt } editor-prev ] }
{ "Next line" T{ key-down f f "DOWN" } [ T{ line-elt } editor-next ] }
{ "Previous word" T{ key-down f { C+ } "LEFT" } [ T{ word-elt } editor-prev ] }
{ "Next word" T{ key-down f { C+ } "RIGHT" } [ T{ word-elt } editor-next ] }
{ "Start of line" T{ key-down f f "HOME" } [ T{ one-line-elt } editor-prev ] }
{ "End of line" T{ key-down f f "END" } [ T{ one-line-elt } editor-next ] }
{ "Start of document" T{ key-down f { C+ } "HOME" } [ editor-doc-start ] }
{ "End of document" T{ key-down f { C+ } "END" } [ editor-doc-end ] }
}
{
"Selecting text"
{ "Extend selection" T{ button-down f { S+ } } [ editor-extend-selection ] }
{ "Start selection" T{ drag } [ editor-mouse-drag ] }
{ "Focus editor" T{ gain-focus } [ focus-editor ] }
{ "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

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

@ -17,6 +17,9 @@ C: field ( model -- field )
select-all ;
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

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

@ -99,5 +99,8 @@ M: browser focusable-child* browser-search ;
browser-definitions close-definitions ;
browser {
{ f "Clear" T{ key-down f f "CLEAR" } [ clear-browser ] }
{
"Browser"
{ "Clear" T{ key-down f f "CLEAR" } [ clear-browser ] }
}
} define-commands

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

@ -14,9 +14,12 @@ TUPLE: help-gadget history search ;
: go-home ( help -- ) "handbook" swap show-help ;
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 ] }
{ f "Home" T{ key-down f { C+ } "h" } [ go-home ] }
{
"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 )

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

@ -56,11 +56,14 @@ TUPLE: walker-gadget model quot ns ;
: walker-step-all dup [ step-all ] walker-command reset-walker ;
walker-gadget {
{ f "Step" T{ key-down f f "s" } [ walker-step ] }
{ f "Step in" T{ key-down f f "i" } [ walker-step-in ] }
{ f "Step out" T{ key-down f f "o" } [ walker-step-out ] }
{ f "Step back" T{ key-down f f "b" } [ walker-step-back ] }
{ f "Continue" T{ key-down f f "c" } [ walker-step-all ] }
{
"Walker"
{ "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 ] }
{ "Step back" T{ key-down f f "b" } [ walker-step-back ] }
{ "Continue" T{ key-down f f "c" } [ walker-step-all ] }
}
} define-commands
: init-walker-models ( walker -- model quot )

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

@ -76,15 +76,21 @@ M: workspace pref-dim* delegate pref-dim* { 550 650 } vmax ;
: tool-window ( class -- ) workspace-window show-tool drop ;
workspace {
{ f "Keyboard help" T{ key-down f f "F1" } [ commands-window ] }
{ f "Listener" T{ key-down f f "F2" } [ listener-gadget select-tool ] }
{ f "Definitions" T{ key-down f f "F3" } [ browser select-tool ] }
{ f "Documentation" T{ key-down f f "F4" } [ help-gadget select-tool ] }
{ f "Walker" T{ key-down f f "F5" } [ walker-gadget select-tool ] }
{
"Tools"
{ "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 ] }
{ "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 ] }
{ f "New documentation" T{ key-down f { S+ } "F4" } [ help-gadget tool-window drop ] }
{
"Tools in new window"
{ "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
! Walker tool
@ -172,6 +178,7 @@ M: operation invoke-command ( target operation -- )
! Words
[ word? ] H{
{ +button+ 1 }
{ +group+ "Words" }
{ +name+ "Browse" }
{ +gesture+ T{ key-down f { A+ } "b" } }
{ +quot+ [ browser call-tool ] }
@ -179,6 +186,7 @@ M: operation invoke-command ( target operation -- )
[ word? ] H{
{ +button+ 2 }
{ +group+ "Words" }
{ +name+ "Edit" }
{ +gesture+ T{ key-down f { A+ } "e" } }
{ +quot+ [ edit ] }
@ -186,12 +194,14 @@ M: operation invoke-command ( target operation -- )
[ word? ] H{
{ +button+ 3 }
{ +group+ "Words" }
{ +name+ "Documentation" }
{ +gesture+ T{ key-down f { A+ } "h" } }
{ +quot+ [ help-gadget call-tool ] }
} define-operation
[ word? ] H{
{ +group+ "Words" }
{ +name+ "Usage" }
{ +gesture+ T{ key-down f { A+ } "u" } }
{ +quot+ [ usage. ] }
@ -199,6 +209,7 @@ M: operation invoke-command ( target operation -- )
} define-operation
[ word? ] H{
{ +group+ "Words" }
{ +name+ "Reload" }
{ +gesture+ T{ key-down f { A+ } "r" } }
{ +quot+ [ reload ] }
@ -206,6 +217,7 @@ M: operation invoke-command ( target operation -- )
} define-operation
[ word? ] H{
{ +group+ "Words" }
{ +name+ "Watch" }
{ +quot+ [ watch ] }
{ +listener+ t }
@ -239,6 +251,7 @@ M: operation invoke-command ( target operation -- )
! Strings
[ string? ] H{
{ +group+ "Words" }
{ +name+ "Apropos (all)" }
{ +gesture+ T{ key-down f { A+ } "a" } }
{ +quot+ [ apropos ] }
@ -251,6 +264,7 @@ M: operation invoke-command ( target operation -- )
] make-hash hash-values natural-sort ;
[ string? ] H{
{ +group+ "Words" }
{ +name+ "Apropos (used)" }
{ +gesture+ T{ key-down f f "TAB" } }
{ +quot+ [ usable-words (apropos) ] }
@ -259,6 +273,7 @@ M: operation invoke-command ( target operation -- )
! Quotations
[ quotation? ] H{
{ +group+ "Quotations" }
{ +name+ "Infer" }
{ +gesture+ T{ key-down f { C+ A+ } "i" } }
{ +quot+ [ infer . ] }
@ -266,6 +281,7 @@ M: operation invoke-command ( target operation -- )
} define-operation
[ quotation? ] H{
{ +group+ "Quotations" }
{ +name+ "Walk" }
{ +gesture+ T{ key-down f { C+ A+ } "w" } }
{ +quot+ [ walk ] }
@ -273,6 +289,7 @@ M: operation invoke-command ( target operation -- )
} define-operation
[ quotation? ] H{
{ +group+ "Quotations" }
{ +name+ "Time" }
{ +gesture+ T{ key-down f { C+ A+ } "t" } }
{ +quot+ [ time ] }
@ -302,8 +319,9 @@ define-commands*
interactor [
{
{ f "Evaluate" T{ key-down f f "RETURN" } [ interactor-commit ] }
{ f "Send EOF" T{ key-down f { C+ } "d" } [ f swap interactor-eval ] }
"Listener"
{ "Evaluate" T{ key-down f f "RETURN" } [ interactor-commit ] }
{ "Send EOF" T{ key-down f { C+ } "d" } [ f swap interactor-eval ] }
} <commands> %
[ word-action ] \ word class-operations modify-listener-operations %
@ -311,8 +329,9 @@ interactor [
[ quot-action ] quotation class-operations modify-listener-operations %
{
{ f "History" T{ key-down f { C+ } "h" } [ [ interactor-history. ] swap interactor-call ] }
{ f "Clear output" T{ key-down f f "CLEAR" } [ [ clear-output ] swap interactor-call ] }
{ f "Clear stack" T{ key-down f { C+ } "CLEAR" } [ [ clear ] swap interactor-call ] }
"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*

19
library/ui/ui.factor
View File

@ -133,13 +133,24 @@ C: titled-gadget ( gadget title -- )
"Gadget: " write
[ class word-name ] keep write-object terpri ;
: commands. ( gadget -- )
dup gadget-info
all-commands
[ first command-gesture key-down? ] subset
: command-table. ( commands group -- )
$heading
[ first2 swap command-description ] map
{ "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 -- )
>r make-pane <scroller> r> open-titled-window ;