From 3781b1382401711334d39fe63bb85d619cc60269 Mon Sep 17 00:00:00 2001 From: slava Date: Thu, 24 Aug 2006 04:45:58 +0000 Subject: [PATCH] Experimental new developer tools in UI --- TODO.FACTOR.txt | 14 --------- library/syntax/parser.factor | 13 ++++---- library/tools/word-tools.factor | 8 +++-- library/ui/text/field.factor | 4 +-- library/ui/text/interactor.factor | 52 +++++++++++++++++++++++++------ library/ui/tools/walker.factor | 7 +++++ library/words.factor | 3 ++ 7 files changed, 65 insertions(+), 36 deletions(-) diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt index cea7518bd0..8f2419725b 100644 --- a/TODO.FACTOR.txt +++ b/TODO.FACTOR.txt @@ -14,20 +14,11 @@ - fix ui listener delay - we have trouble drawing rectangles -- remaining walker tasks: - - integrate walker with listener - - handled by walker itself - - ^W in interactor - - ^I in interactor - - error handling is still screwy - - continuation handling is also screwy - - keyboard commands - editor: - only redraw visible lines - more efficient multi-line inserts - editor should support stream output protocol - slider needs to be modelized -- listener tab completion - track individual method usages - modularize core - track module files and modification times, and a list of assets loaded @@ -43,14 +34,9 @@ + ui: -- list of key bindings -- presentation types -- present/accept - graphical module manager tool - figure out what goes in the .app and what doesn't - should be possible to drop an image file on the .app to run it -- the UI listener has a shitty design. perhaps it should not call out - to the real listener. - add-gadget, model-changed, set-model should compile - shortcuts: - find a listener diff --git a/library/syntax/parser.factor b/library/syntax/parser.factor index 05df542955..de30981e4f 100644 --- a/library/syntax/parser.factor +++ b/library/syntax/parser.factor @@ -27,7 +27,7 @@ namespaces prettyprint sequences strings vectors words ; SYMBOL: string-mode : do-what-i-mean ( string -- restarts ) - all-words [ word-name = ] subset-with natural-sort [ + words-named natural-sort [ [ "Use the word " swap synopsis append ] keep 2array ] map ; @@ -36,14 +36,15 @@ TUPLE: no-word name ; : no-word ( name -- word ) dup swap do-what-i-mean condition ; +: search ( str -- word ) + dup use get hash-stack [ ] [ + no-word dup word-vocabulary use+ + ] ?if ; + : scan-word ( -- obj ) scan dup [ dup ";" = not string-mode get and [ - dup use get hash-stack [ ] [ - dup string>number [ ] [ - no-word dup word-vocabulary use+ - ] ?if - ] ?if + dup string>number [ ] [ search ] ?if ] unless ] when ; diff --git a/library/tools/word-tools.factor b/library/tools/word-tools.factor index 9d50a0dd1e..3b2b2d7105 100644 --- a/library/tools/word-tools.factor +++ b/library/tools/word-tools.factor @@ -84,8 +84,8 @@ math namespaces prettyprint sequences strings styles ; ] keep 3array ; -: completions ( str -- seq ) - all-words [ completion ] map-with [ first zero? not ] subset +: completions ( str words -- seq ) + [ completion ] map-with [ first zero? not ] subset [ [ first ] 2apply swap - ] sort dup length 20 min head ; : fuzzy. ( fuzzy full -- ) @@ -94,7 +94,7 @@ math namespaces prettyprint sequences strings styles ; [ hilite-style >r ch>string r> format ] [ write1 ] if ] 2each drop ; -: apropos ( str -- ) +: (apropos) ( str words -- ) completions [ first3 dup presented associate [ dup word-vocabulary write bl word-name fuzzy. @@ -102,3 +102,5 @@ math namespaces prettyprint sequences strings styles ; write ] with-nesting terpri ] each ; + +: apropos ( str -- ) all-words (apropos) ; diff --git a/library/ui/text/field.factor b/library/ui/text/field.factor index 754fa8771e..cf0044a4f5 100644 --- a/library/ui/text/field.factor +++ b/library/ui/text/field.factor @@ -3,17 +3,15 @@ IN: gadgets-text USING: gadgets gadgets-controls generic kernel models sequences ; -TUPLE: field model history ; +TUPLE: field model ; C: field ( model -- field ) over set-delegate - V{ } clone over set-field-history [ set-field-model ] keep dup dup set-control-self ; : field-commit ( field -- string ) [ editor-text ] keep - [ field-history push-new ] 2keep [ field-model [ dupd set-model ] when* ] keep select-all ; diff --git a/library/ui/text/interactor.factor b/library/ui/text/interactor.factor index 28b48e89c8..ed54c0015d 100644 --- a/library/ui/text/interactor.factor +++ b/library/ui/text/interactor.factor @@ -3,19 +3,20 @@ IN: gadgets-text USING: gadgets gadgets-controls gadgets-panes generic hashtables help io kernel namespaces prettyprint styles threads sequences -vectors ; +vectors jedit definitions parser words ; -TUPLE: interactor output continuation queue busy? ; +TUPLE: interactor history output continuation queue busy? ; C: interactor ( output -- gadget ) [ set-interactor-output ] keep f over set-gadget-delegate + V{ } clone over set-interactor-history dup dup set-control-self ; M: interactor graft* f over set-interactor-busy? delegate graft* ; -: interactor-eval ( string interactor -- ) +: (interactor-eval) ( string interactor -- ) dup interactor-busy? [ 2drop ] [ @@ -33,31 +34,62 @@ SYMBOL: structured-input ] with-stream* >r structured-input set-global "\"structured-input\" \"gadgets-text\" lookup get-global call" - r> interactor-eval ; + r> (interactor-eval) ; : interactor-input. ( string interactor -- ) interactor-output [ dup print-input ] with-stream* ; +: interactor-eval ( string interactor -- ) + dup control-model clear-doc + 2dup interactor-history push-new + 2dup interactor-input. + (interactor-eval) ; + : interactor-commit ( interactor -- ) dup interactor-busy? [ drop ] [ - dup field-commit - over control-model clear-doc - swap 2dup interactor-input. interactor-eval + [ field-commit ] keep interactor-eval + ] if ; + +: quot-action ( interactor word -- ) + over interactor-busy? [ + 2drop + ] [ + [ "[ " % over field-commit % " ] " % % ] "" make + swap interactor-eval ] if ; : interactor-history. ( interactor -- ) dup interactor-output [ "History:" print - field-history [ dup print-input ] each + interactor-history [ dup print-input ] each ] with-stream* ; +: word-action ( interactor word -- ) + over gadget-selection? + [ over T{ word-elt } editor-select-prev ] unless + over gadget-selection add* swap interactor-call ; + +: usable-words ( -- seq ) + use get [ hash-values natural-sort ] map concat prune ; + +: use-word ( str -- ) + words-named [ word-vocabulary dup print use+ ] each ; + interactor H{ { T{ key-down f f "RETURN" } [ interactor-commit ] } - { T{ key-down f { C+ } "h" } [ interactor-history. ] } - { T{ key-down f { C+ } "b" } [ interactor-output pane-clear ] } + { T{ key-down f { C+ } "h" } [ dup [ interactor-history. ] curry swap interactor-call ] } + { T{ key-down f { C+ } "b" } [ dup [ interactor-output pane-clear ] curry swap interactor-call ] } { T{ key-down f { C+ } "d" } [ f swap interactor-eval ] } + { T{ key-down f { C+ } "i" } [ "infer ." quot-action ] } + { T{ key-down f { C+ } "w" } [ "walk" quot-action ] } + { T{ key-down f { A+ } "s" } [ [ search see ] word-action ] } + { T{ key-down f { A+ } "j" } [ [ search jedit ] word-action ] } + { T{ key-down f { A+ } "r" } [ [ search reload ] word-action ] } + { T{ key-down f { A+ } "a" } [ [ apropos ] word-action ] } + { T{ key-down f { A+ } "u" } [ [ use-word ] word-action ] } + { T{ key-down f f "TAB" } [ [ usable-words (apropos) ] word-action ] } } set-gestures M: interactor stream-readln diff --git a/library/ui/tools/walker.factor b/library/ui/tools/walker.factor index 87bf9b02a7..2fadbb49e6 100644 --- a/library/ui/tools/walker.factor +++ b/library/ui/tools/walker.factor @@ -127,6 +127,13 @@ C: walker-gadget ( -- gadget ) } make-frame* dup walker-thread ; +\ walker-gadget H{ + { T{ key-down f { C+ } "s" } [ \ step walker-command ] } + { T{ key-down f { C+ } "n" } [ \ step-in walker-command ] } + { T{ key-down f { C+ } "o" } [ \ step-out walker-command ] } + { T{ key-down f { C+ } "l" } [ \ step-all walker-command ] } +} set-gestures + : walker-tool [ walker-gadget? ] [ ] [ (walk) ] ; diff --git a/library/words.factor b/library/words.factor index 15851502a0..6bd295f928 100644 --- a/library/words.factor +++ b/library/words.factor @@ -183,6 +183,9 @@ TUPLE: check-create name vocab ; ] when lookup ] when ; +: words-named ( str -- seq ) + all-words [ word-name = ] subset-with ; + ! Definition protocol M: word where "loc" word-prop ;