diff --git a/library/ui/tools/operations.factor b/library/ui/tools/operations.factor index d16763ebdc..00faf44f29 100644 --- a/library/ui/tools/operations.factor +++ b/library/ui/tools/operations.factor @@ -61,17 +61,33 @@ M: operation invoke-command ( target operation -- ) [ pathname? ] H{ { +name+ "Run file" } + { +keyboard+ T{ key-down f { A+ } "r" } } { +quot+ [ pathname-string [ run-file ] curry call-listener ] } } define-operation ! Words [ word? ] H{ - { +default+ t } + { +primary+ t } { +name+ "Browse" } { +keyboard+ T{ key-down f { A+ } "b" } } { +quot+ [ browser call-tool ] } } define-operation +: word-completion-string ( word listener -- string ) + >r dup word-name swap word-vocabulary dup vocab r> + listener-gadget-use memq? + [ drop ] [ [ "USE: " % % " " % % ] "" make ] if ; + +: insert-word ( word -- ) + find-listener [ word-completion-string ] keep + listener-gadget-input user-input ; + +[ word? ] H{ + { +secondary+ t } + { +name+ "Insert" } + { +quot+ [ insert-word ] } +} define-operation + [ word? ] H{ { +name+ "Edit" } { +keyboard+ T{ key-down f { A+ } "e" } } @@ -129,28 +145,33 @@ M: operation invoke-command ( target operation -- ) ! Vocabularies [ vocab-link? ] H{ - { +default+ t } + { +primary+ t } { +name+ "Browse" } + { +keyboard+ T{ key-down f { A+ } "b" } } { +quot+ [ browser call-tool ] } } define-operation [ vocab-link? ] H{ { +name+ "Enter in" } + { +keyboard+ T{ key-down f { A+ } "i" } } { +quot+ [ vocab-link-name [ set-in ] curry call-listener ] } } define-operation [ vocab-link? ] H{ + { +secondary+ t } { +name+ "Use" } { +quot+ [ vocab-link-name [ use+ ] curry call-listener ] } } define-operation [ vocab-link? ] H{ { +name+ "Forget" } + { +keyboard+ T{ key-down f { A+ } "f" } } { +quot+ [ vocab-link-name forget-vocab ] } } define-operation ! Modules [ module? ] H{ + { +primary+ t } { +name+ "Run" } { +quot+ [ module-name run-module ] } { +listener+ t } @@ -158,45 +179,53 @@ M: operation invoke-command ( target operation -- ) [ module? ] H{ { +name+ "Documentation" } + { +keyboard+ T{ key-down f { A+ } "h" } } { +quot+ [ module-help [ help-gadget call-tool ] when* ] } } define-operation [ module? ] H{ { +name+ "Edit" } + { +keyboard+ T{ key-down f { A+ } "e" } } { +quot+ [ edit ] } } define-operation [ module? ] H{ { +name+ "Reload" } + { +keyboard+ T{ key-down f { A+ } "r" } } { +quot+ [ reload-module ] } { +listener+ t } } define-operation [ module? ] H{ { +name+ "See" } + { +keyboard+ T{ key-down f { A+ } "b" } } { +quot+ [ see ] } { +listener+ t } } define-operation ! Link [ link? ] H{ - { +default+ t } + { +primary+ t } + { +secondary+ t } { +name+ "Follow" } { +quot+ [ help-gadget call-tool ] } } define-operation [ link? ] H{ { +name+ "Edit" } + { +keyboard+ T{ key-down f { A+ } "e" } } { +quot+ [ edit ] } } define-operation [ link? ] H{ { +name+ "Reload" } + { +keyboard+ T{ key-down f { A+ } "r" } } { +quot+ [ reload ] } } define-operation [ word-link? ] H{ { +name+ "Definition" } + { +keyboard+ T{ key-down f { A+ } "b" } } { +quot+ [ link-name browser call-tool ] } } define-operation @@ -230,9 +259,8 @@ M: operation invoke-command ( target operation -- ) } define-operation ! Dataflow nodes - [ [ node? ] is? ] H{ - { +default+ t } + { +primary+ t } { +name+ "Show dataflow" } { +quot+ [ dataflow-gadget call-tool ] } } define-operation @@ -245,13 +273,6 @@ M: operation invoke-command ( target operation -- ) ! Define commands in terms of operations -! Tile commands -tile "toolbar" -\ word class-operations [ tile-definition ] modify-operations -[ command-name "Browse" = not ] subset -{ "Close" f [ close-tile ] } add* -define-commands - ! Interactor commands : word-action ( target -- quot ) selected-word search ; @@ -278,3 +299,28 @@ link class-operations [ help-action ] modify-operations [ command-name "Follow" = not ] subset append define-commands + +\ word-search "operations" +\ word class-operations +[ search-action ] modify-operations +define-commands + +\ vocab-search "operations" +\ vocab-link class-operations +[ search-action ] modify-operations +define-commands + +\ module-search "operations" +\ module class-operations +[ search-action ] modify-operations +define-commands + +\ source-file-search "operations" +\ pathname class-operations +[ search-action ] modify-operations +define-commands + +\ help-search "operations" +\ link class-operations +[ search-action ] modify-operations +define-commands diff --git a/library/ui/tools/search.factor b/library/ui/tools/search.factor index 27942c8720..75ce1c5812 100644 --- a/library/ui/tools/search.factor +++ b/library/ui/tools/search.factor @@ -9,7 +9,7 @@ completion styles strings modules ; TUPLE: live-search field list ; -: find-live-search [ live-search? ] find-parent ; +: find-live-search [ [ live-search? ] is? ] find-parent ; : find-search-list find-live-search live-search-list ; @@ -23,7 +23,7 @@ C: search-field ( -- gadget ) search-field H{ { T{ key-down f f "UP" } [ find-search-list select-prev ] } { T{ key-down f f "DOWN" } [ find-search-list select-next ] } - { T{ key-down f f "RETURN" } [ find-search-list call-action ] } + { T{ key-down f f "RETURN" } [ find-search-list list-action ] } } set-gestures : ( producer -- model ) @@ -31,10 +31,10 @@ search-field H{ [ "\n" join ] swap ; -: ( action seq producer presenter -- gadget ) +: ( hook seq producer presenter -- gadget ) -rot curry ; -C: live-search ( string action seq producer presenter -- gadget ) +C: live-search ( string hook seq producer presenter -- gadget ) { { [ ] @@ -53,43 +53,73 @@ C: live-search ( string action seq producer presenter -- gadget ) M: live-search focusable-child* live-search-field ; -: ( string action -- gadget ) - all-words +: delegate>live-search ( string hook seq producer presenter gadget -- ) + >r r> set-gadget-delegate ; + +TUPLE: word-search ; + +C: word-search ( string action words -- gadget ) + >r [ word-completions ] [ word-name ] - ; + r> + [ delegate>live-search ] keep ; : help-completions ( str pairs -- seq ) >r >lower r> [ second >lower ] swap completions [ first ] map ; -: ( string action -- gadget ) +TUPLE: help-search ; + +C: help-search ( string action -- gadget ) + >r all-articles [ dup article-title 2array ] map + [ [ second ] 2apply <=> ] sort [ help-completions ] [ article-title ] - ; + r> + [ delegate>live-search ] keep ; -: ( string action -- gadget ) +TUPLE: source-file-search ; + +C: source-file-search ( string action -- gadget ) + >r source-files get hash-keys natural-sort [ string-completions [ ] map ] [ pathname-string ] - ; + r> + [ delegate>live-search ] keep ; : module-completions ( str modules -- seq ) [ module-name ] swap completions ; -: ( string action -- gadget ) +TUPLE: module-search ; + +: module-search ( string action -- gadget ) + >r available-modules [ module-completions ] [ module-name ] - ; + r> + [ delegate>live-search ] keep ; -: ( string action -- gadget ) +TUPLE: vocab-search ; + +C: vocab-search ( string action -- gadget ) + >r vocabs [ string-completions [ ] map ] [ vocab-link-name ] - ; + r> + [ delegate>live-search ] keep ; -: ( string action seq -- gadget ) +TUPLE: history-search ; + +C: history-search ( string action seq -- gadget ) + >r [ string-completions [ ] map ] [ input-string ] - ; + r> + [ delegate>live-search ] keep ; + +: search-action ( search -- obj ) + live-search-list list-value ;