]> gitweb.factorcode.org Git - factor.git/commitdiff
Overhaul UI listener history code; C-p, C-n cycles through history, C-r displays...
authorSlava Pestov <slava@slava-pestovs-macbook-pro.local>
Fri, 16 Jan 2009 03:34:41 +0000 (21:34 -0600)
committerSlava Pestov <slava@slava-pestovs-macbook-pro.local>
Fri, 16 Jan 2009 03:34:41 +0000 (21:34 -0600)
basis/ui/gadgets/editors/editors.factor
basis/ui/tools/listener/completion/authors.txt [new file with mode: 0644]
basis/ui/tools/listener/completion/completion-tests.factor [new file with mode: 0644]
basis/ui/tools/listener/completion/completion.factor [new file with mode: 0644]
basis/ui/tools/listener/history/authors.txt [new file with mode: 0644]
basis/ui/tools/listener/history/history-tests.factor [new file with mode: 0644]
basis/ui/tools/listener/history/history.factor [new file with mode: 0644]
basis/ui/tools/listener/listener.factor
basis/ui/tools/operations/operations.factor

index 3fdddd170f664aa5b0616a30af9a0f7afcd0dfcb..5624c654fabeba6926ec8437cdc44edfef6324c6 100755 (executable)
@@ -81,20 +81,20 @@ M: editor ungraft*
     dup caret>> deactivate-editor-model
     dup mark>> deactivate-editor-model ;
 
-: editor-caret* ( editor -- loc ) caret>> value>> ;
+: editor-caret ( editor -- loc ) caret>> value>> ;
 
-: editor-mark* ( editor -- loc ) mark>> value>> ;
+: editor-mark ( editor -- loc ) mark>> value>> ;
 
 : set-caret ( loc editor -- )
     [ model>> validate-loc ] keep
     caret>> set-model ;
 
 : change-caret ( editor quot -- )
-    [ [ [ editor-caret* ] [ model>> ] bi ] dip call ] [ drop ] 2bi
+    [ [ [ editor-caret ] [ model>> ] bi ] dip call ] [ drop ] 2bi
     set-caret ; inline
 
 : mark>caret ( editor -- )
-    [ editor-caret* ] [ mark>> ] bi set-model ;
+    [ editor-caret ] [ mark>> ] bi set-model ;
 
 : change-caret&mark ( editor quot -- )
     [ change-caret ] [ drop mark>caret ] 2bi ; inline
@@ -150,7 +150,7 @@ M: editor ungraft*
     [ loc>x ] [ [ first ] dip line>y ] 2bi 2array ;
 
 : caret-loc ( editor -- loc )
-    [ editor-caret* ] keep loc>point ;
+    [ editor-caret ] keep loc>point ;
 
 : caret-dim ( editor -- dim )
     line-height 0 swap 2array ;
@@ -220,7 +220,7 @@ M: editor ungraft*
     ] with-editor-translation ;
 
 : selection-start/end ( editor -- start end )
-    [ editor-mark* ] [ editor-caret* ] bi sort-pair ;
+    [ editor-mark ] [ editor-caret ] bi sort-pair ;
 
 : (draw-selection) ( x1 x2 -- )
     over -
@@ -298,7 +298,7 @@ M: editor gadget-text* editor-string % ;
     } at one-line-elt or ;
 
 : drag-direction? ( loc editor -- ? )
-    editor-mark* before? ;
+    editor-mark before? ;
 
 : drag-selection-caret ( loc editor element -- loc )
     [
@@ -308,7 +308,7 @@ M: editor gadget-text* editor-string % ;
 : drag-selection-mark ( loc editor element -- loc )
     [
         [ drag-direction? not ] keep
-        [ editor-mark* ] [ model>> ] bi
+        [ editor-mark ] [ model>> ] bi
     ] dip prev/next-elt ? ;
 
 : drag-caret&mark ( editor -- caret mark )
@@ -328,7 +328,7 @@ M: editor gadget-text* editor-string % ;
     over gadget-selection? [
         drop remove-selection
     ] [
-        [ [ [ editor-caret* ] [ model>> ] bi ] dip call ]
+        [ [ [ editor-caret ] [ model>> ] bi ] dip call ]
         [ drop model>> ]
         2bi remove-doc-range
     ] if ; inline
@@ -355,7 +355,7 @@ M: editor gadget-text* editor-string % ;
     tuck caret>> set-model mark>> set-model ;
 
 : select-elt ( editor elt -- )
-    [ [ [ editor-caret* ] [ model>> ] bi ] dip prev/next-elt ] [ drop ] 2bi
+    [ [ [ editor-caret ] [ model>> ] bi ] dip prev/next-elt ] [ drop ] 2bi
     editor-select ;
 
 : start-of-document ( editor -- ) doc-elt editor-prev ;
diff --git a/basis/ui/tools/listener/completion/authors.txt b/basis/ui/tools/listener/completion/authors.txt
new file mode 100644 (file)
index 0000000..d4f5d6b
--- /dev/null
@@ -0,0 +1 @@
+Slava Pestov
\ No newline at end of file
diff --git a/basis/ui/tools/listener/completion/completion-tests.factor b/basis/ui/tools/listener/completion/completion-tests.factor
new file mode 100644 (file)
index 0000000..9b4c04e
--- /dev/null
@@ -0,0 +1,4 @@
+! Copyright (C) 2009 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: tools.test ui.tools.listener.completion ;
+IN: ui.tools.listener.completion.tests
diff --git a/basis/ui/tools/listener/completion/completion.factor b/basis/ui/tools/listener/completion/completion.factor
new file mode 100644 (file)
index 0000000..d7c577e
--- /dev/null
@@ -0,0 +1,140 @@
+! Copyright (C) 2009 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors arrays assocs calendar colors documents fry kernel
+sets splitting math math.vectors models.delay models.filter
+combinators.short-circuit parser present sequences tools.completion
+ui.commands ui.gadgets ui.gadgets.editors ui.gadgets.glass
+ui.gadgets.scrollers ui.gadgets.tables
+ui.gadgets.theme ui.gadgets.worlds ui.gadgets.wrappers ui.gestures
+ui.render ui.tools.listener.history ;
+IN: ui.tools.listener.completion
+
+: complete-IN:/USE:? ( tokens -- ? )
+    2 short tail* { "IN:" "USE:" } intersects? ;
+
+: chop-; ( seq -- seq' )
+    { ";" } split1-last [ ] [ ] ?if ;
+
+: complete-USING:? ( tokens -- ? )
+    chop-; { "USING:" } intersects? ;
+
+: up-to-caret ( caret document -- string )
+    [ { 0 0 } ] 2dip doc-range ;
+
+: vocab-completion? ( interactor -- ? )
+    [ editor-caret ] [ model>> ] bi up-to-caret " \r\n" split
+    { [ complete-IN:/USE:? ] [ complete-USING:? ] } 1|| ;
+
+! We don't directly depend on the listener tool but we use a couple
+! of slots
+SLOT: interactor
+SLOT: history
+
+TUPLE: completion-popup < wrapper table interactor element ;
+
+: find-completion-popup ( gadget -- popup )
+    [ completion-popup? ] find-parent ;
+
+SINGLETON: completion-renderer
+M: completion-renderer row-columns drop present 1array ;
+M: completion-renderer row-value drop ;
+
+: <completion-model> ( editor quot -- model )
+    [ one-word-elt <element-model> 1/3 seconds <delay> ] dip
+    '[ @ keys 1000 short head ] <filter> ;
+
+M: completion-popup hide-glass-hook
+    interactor>> f >>completion-popup request-focus ;
+
+: hide-completion-popup ( popup -- )
+    find-world hide-glass ;
+
+: completion-loc/doc ( popup -- loc doc )
+    interactor>> [ editor-caret ] [ model>> ] bi ;
+
+: accept-completion ( item table -- )
+    find-completion-popup
+    [ [ present ] [ completion-loc/doc ] bi* one-word-elt set-elt-string ]
+    [ hide-completion-popup ]
+    bi ;
+
+: <completion-table> ( interactor quot -- table )
+    <completion-model> <table>
+        monospace-font >>font
+        t >>selection-required?
+        completion-renderer >>renderer
+        dup '[ _ accept-completion ] >>action ;
+
+: <completion-scroller> ( object -- object )
+    <limited-scroller>
+        { 300 120 } >>min-dim
+        { 300 120 } >>max-dim ;
+
+: <completion-popup> ( interactor quot -- popup )
+    [ completion-popup new-gadget ] 2dip
+    [ drop >>interactor ] [ <completion-table> >>table ] 2bi
+    dup table>> <completion-scroller> add-gadget
+    white <solid> >>interior ;
+
+completion-popup H{
+    { T{ key-down f f "ESC" } [ hide-completion-popup ] }
+    { T{ key-down f f "TAB" } [ table>> row-action ] }
+    { T{ key-down f f " " } [ table>> row-action ] }
+} set-gestures
+
+CONSTANT: completion-popup-offset { -4 0 }
+
+: (completion-popup-loc) ( interactor element -- loc )
+    [ drop screen-loc ] [
+        [ [ [ editor-caret ] [ model>> ] bi ] dip prev-elt ] [ drop ] 2bi
+        loc>point
+    ] 2bi v+ completion-popup-offset v+ ;
+
+: completion-popup-loc-1 ( interactor element -- loc )
+    [ (completion-popup-loc) ] [ drop caret-dim ] 2bi v+ ;
+
+: completion-popup-loc-2 ( interactor element popup -- loc )
+    [ (completion-popup-loc) ] dip pref-dim { 0 1 } v* v- ;
+
+: completion-popup-fits? ( interactor element popup -- ? )
+    [ [ completion-popup-loc-1 ] dip pref-dim v+ ]
+    [ 2drop find-world dim>> ]
+    3bi [ second ] bi@ <= ;
+
+: completion-popup-loc ( interactor element popup -- loc )
+    3dup completion-popup-fits?
+    [ drop completion-popup-loc-1 ]
+    [ completion-popup-loc-2 ]
+    if ;
+
+: show-completion-popup ( interactor quot element -- )
+    [ nip ] [ drop <completion-popup> ] 3bi
+    [ nip >>completion-popup drop ]
+    [ [ 2drop find-world ] [ 2nip ] [ completion-popup-loc ] 3tri ] 3bi
+    show-glass ;
+
+: word-completion-popup ( interactor -- )
+    dup vocab-completion?
+    [ vocabs-matching ] [ words-matching ] ? '[ [ { } ] _ if-empty ]
+    one-word-elt show-completion-popup ;
+
+: history-matching ( interactor -- alist )
+    history>> elements>>
+    [ dup string>> { { CHAR: \n CHAR: \s } } substitute ] { } map>assoc
+    <reversed> ;
+
+: history-completion-popup ( interactor -- )
+    dup '[ drop _ history-matching ] one-line-elt show-completion-popup ;
+
+: recall-previous ( interactor -- )
+    history>> history-recall-previous ;
+
+: recall-next ( interactor -- )
+    history>> history-recall-next ;
+
+: selected-word ( editor -- word )
+    dup completion-popup>> [
+        [ table>> selected-row drop ] [ hide-completion-popup ] bi
+    ] [
+        selected-token dup search [ ] [ no-word ] ?if
+    ] ?if ;
\ No newline at end of file
diff --git a/basis/ui/tools/listener/history/authors.txt b/basis/ui/tools/listener/history/authors.txt
new file mode 100644 (file)
index 0000000..d4f5d6b
--- /dev/null
@@ -0,0 +1 @@
+Slava Pestov
\ No newline at end of file
diff --git a/basis/ui/tools/listener/history/history-tests.factor b/basis/ui/tools/listener/history/history-tests.factor
new file mode 100644 (file)
index 0000000..5a2e3cf
--- /dev/null
@@ -0,0 +1,54 @@
+! Copyright (C) 2009 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: documents namespaces tools.test io.styles
+ui.tools.listener.history kernel ;
+IN: ui.tools.listener.history.tests
+
+[ ] [ <document> "d" set ] unit-test
+[ ] [ "d" get <history> "h" set ] unit-test
+
+[ ] [ "1" "d" get set-doc-string ] unit-test
+[ T{ input f "1" } ] [ "h" get history-add ] unit-test
+
+[ ] [ "2" "d" get set-doc-string ] unit-test
+[ T{ input f "2" } ] [ "h" get history-add ] unit-test
+
+[ ] [ "3" "d" get set-doc-string ] unit-test
+[ T{ input f "3" } ] [ "h" get history-add ] unit-test
+
+[ ] [ "" "d" get set-doc-string ] unit-test
+
+[ ] [ "h" get history-recall-previous ] unit-test
+[ "3" ] [ "d" get doc-string ] unit-test
+
+[ ] [ "h" get history-recall-previous ] unit-test
+[ "2" ] [ "d" get doc-string ] unit-test
+
+[ ] [ "h" get history-recall-previous ] unit-test
+[ "1" ] [ "d" get doc-string ] unit-test
+
+[ ] [ "h" get history-recall-previous ] unit-test
+[ "1" ] [ "d" get doc-string ] unit-test
+
+[ ] [ "h" get history-recall-next ] unit-test
+[ "2" ] [ "d" get doc-string ] unit-test
+
+[ ] [ "22" "d" get set-doc-string ] unit-test
+
+[ ] [ "h" get history-recall-next ] unit-test
+[ "3" ] [ "d" get doc-string ] unit-test
+
+[ ] [ "h" get history-recall-previous ] unit-test
+[ "22" ] [ "d" get doc-string ] unit-test
+
+[ ] [ "h" get history-recall-previous ] unit-test
+[ "1" ] [ "d" get doc-string ] unit-test
+
+[ ] [ "222" "d" get set-doc-string ] unit-test
+[ T{ input f "222" } ] [ "h" get history-add ] unit-test
+
+[ ] [ "h" get history-recall-previous ] unit-test
+[ ] [ "h" get history-recall-previous ] unit-test
+[ ] [ "h" get history-recall-previous ] unit-test
+
+[ "22" ] [ "d" get doc-string ] unit-test
diff --git a/basis/ui/tools/listener/history/history.factor b/basis/ui/tools/listener/history/history.factor
new file mode 100644 (file)
index 0000000..aacd618
--- /dev/null
@@ -0,0 +1,44 @@
+! Copyright (C) 2009 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors documents io.styles kernel math math.order
+sequences fry ;
+IN: ui.tools.listener.history
+
+TUPLE: history document elements index ;
+
+: <history> ( document -- history )
+    V{ } clone 0 history boa ;
+
+: history-add ( history -- input )
+    dup elements>> length 1+ >>index
+    [ document>> doc-string [ <input> ] [ empty? ] bi ] keep
+    '[ [ _ elements>> push ] keep ] unless ;
+
+: save-history ( history -- )
+    [ document>> doc-string ] keep
+    '[ <input> _ [ index>> ] [ elements>> ] bi set-nth ]
+    unless-empty ;
+
+: update-document ( history -- )
+    [ [ index>> ] [ elements>> ] bi nth string>> ]
+    [ document>> ] bi
+    set-doc-string ;
+
+: change-history-index ( history i -- )
+    over elements>> length 1-
+    '[ _ + _ min 0 max ] change-index drop ;
+
+: history-recall ( history i -- )
+    [ [ elements>> empty? ] keep ] dip '[
+        _
+        [ save-history ]
+        [ _ change-history-index ]
+        [ update-document ]
+        tri
+    ] unless ;
+
+: history-recall-previous ( history -- )
+    -1 history-recall ;
+
+: history-recall-next ( history -- )
+    1 history-recall ;
index 799dddd9dee5d9401a9b8bc7f1c6f279019832da..c57ef4b3d79fd06d2b9828aa8e71246b71d64f39 100644 (file)
@@ -1,20 +1,18 @@
 ! Copyright (C) 2005, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: inspector kernel help help.markup io io.styles models math.vectors
-strings splitting namespaces parser quotations sequences vocabs words
-continuations prettyprint listener debugger threads boxes
-concurrency.flags math arrays generic accessors combinators
-combinators.short-circuit combinators.smart
-assocs fry generic.standard.engines.tuple
-tools.vocabs concurrency.mailboxes vocabs.parser calendar
-models.delay models.filter documents hashtables sets destructors lexer
-ui.commands ui.gadgets ui.gadgets.editors ui.gadgets.labelled
-ui.gadgets.panes ui.gadgets.buttons ui.gadgets.scrollers
-ui.gadgets.packs ui.gadgets.tracks ui.gadgets.borders
-ui.gadgets.frames ui.gadgets.grids ui.gadgets.status-bar
-ui.gadgets.viewports ui.gadgets.wrappers ui.gestures ui.operations
-ui.tools.browser ui.tools.debugger ui.gadgets.theme
-ui.tools.inspector ui.tools.common ui ;
+USING: accessors arrays assocs calendar combinators
+combinators.short-circuit compiler.units concurrency.flags
+concurrency.mailboxes continuations destructors documents fry generic
+generic.standard.engines.tuple hashtables help help.markup io
+io.styles kernel lexer listener math models models.delay models.filter
+namespaces parser prettyprint quotations sequences strings threads
+tools.vocabs ui ui.commands ui.gadgets ui.gadgets.buttons
+ui.gadgets.editors ui.gadgets.frames ui.gadgets.grids
+ui.gadgets.labelled ui.gadgets.panes ui.gadgets.scrollers
+ui.gadgets.status-bar ui.gadgets.tracks ui.gestures ui.operations
+ui.tools.browser ui.tools.common ui.tools.debugger
+ui.tools.listener.completion ui.tools.listener.history vocabs
+vocabs.parser words ;
 IN: ui.tools.listener
 
 ! If waiting is t, we're waiting for user input, and invoking
@@ -44,22 +42,6 @@ completion-popup ;
         assoc-stack
     ] if ;
 
-: complete-IN:/USE:? ( tokens -- ? )
-    2 short tail* { "IN:" "USE:" } intersects? ;
-
-: chop-; ( seq -- seq' )
-    { ";" } split1-last [ ] [ ] ?if ;
-
-: complete-USING:? ( tokens -- ? )
-    chop-; { "USING:" } intersects? ;
-
-: up-to-caret ( caret document -- string )
-    [ { 0 0 } ] 2dip doc-range ;
-
-: vocab-completion? ( interactor -- ? )
-    [ editor-caret ] [ model>> ] bi up-to-caret " \r\n" split
-    { [ complete-IN:/USE:? ] [ complete-USING:? ] } 1|| ;
-
 : <word-model> ( interactor -- model )
     [ one-word-elt <element-model> 1/3 seconds <delay> ] keep
     '[
@@ -69,9 +51,9 @@ completion-popup ;
 
 : <interactor> ( output -- gadget )
     interactor new-editor
-        V{ } clone >>history
         <flag> >>flag
         dup <word-model> >>help
+        dup model>> <history> >>history
         swap >>output ;
 
 M: interactor graft*
@@ -98,18 +80,12 @@ M: object (print-input)
 : print-input ( object interactor -- )
     output>> [ (print-input) ] with-output-stream* ;
 
-: add-interactor-history ( input interactor -- )
-    over string>> empty? [ 2drop ] [ history>> adjoin ] if ;
-
 : interactor-continue ( obj interactor -- )
     mailbox>> mailbox-put ;
 
 : interactor-finish ( interactor -- )
-    [ editor-string <input> ] keep
-    [ print-input ]
-    [ add-interactor-history ]
-    [ clear-editor drop ]
-    2tri ;
+    [ history>> history-add ] keep
+    [ print-input ] [ clear-editor drop ] 2bi ;
 
 : interactor-eof ( interactor -- )
     dup interactor-busy? [
@@ -304,10 +280,8 @@ M: engine-word word-completion-string method-completion-string ;
     2bi ;
 
 : quot-action ( interactor -- lines )
-    [ [ editor-string <input> ] keep add-interactor-history ]
-    [ control-value ]
-    [ select-all ]
-    tri ;
+    [ history>> history-add drop ] [ control-value ] [ select-all ] tri
+    [ parse-lines ] with-compilation-unit ;
 
 : hide-popup ( listener -- )
     dup popup>> track-remove
@@ -358,11 +332,30 @@ M: interactor stream-read-quot
         ]
     } cond ;
 
+: pass-to-popup? ( gesture interactor -- ? )
+    [ [ key-down? ] [ key-up? ] bi or ]
+    [ completion-popup>> ]
+    bi* and ;
+
+M: interactor handle-gesture
+    2dup pass-to-popup? [
+        2dup completion-popup>>
+        focusable-child resend-gesture
+        [ call-next-method ] [ 2drop f ] if
+    ] [ call-next-method ] if ;
+
 interactor "interactor" f {
     { T{ key-down f f "RET" } evaluate-input }
     { T{ key-down f { C+ } "k" } clear-editor }
 } define-command-map
 
+interactor "completion" f {
+    { T{ key-down f f "TAB" } word-completion-popup }
+    { T{ key-down f { C+ } "p" } recall-previous }
+    { T{ key-down f { C+ } "n" } recall-next }
+    { T{ key-down f { C+ } "r" } history-completion-popup }
+} define-command-map
+
 : welcome. ( -- )
     "If this is your first time with Factor, please read the " print
     "handbook" ($link) ". To see a list of keyboard shortcuts," print
@@ -436,133 +429,4 @@ M: listener-gadget graft*
     [ call-next-method ] [ restart-listener ] bi ;
 
 M: listener-gadget ungraft*
-    [ com-end ] [ call-next-method ] bi ;
-
-! Foo
-USING: summary ui.gadgets.labels ui.gadgets.tables colors ui.render
-ui.gadgets.worlds ui.gadgets.glass tools.completion ui.gadgets
-present ;
-USE: tools.completion
-
-: <summary-gadget> ( model -- gadget )
-    [ summary ] <filter> <label-control> ;
-
-TUPLE: completion-popup < wrapper table interactor element ;
-
-: find-completion-popup ( gadget -- popup )
-    [ completion-popup? ] find-parent ;
-
-SINGLETON: completion-renderer
-M: completion-renderer row-columns drop present 1array ;
-M: completion-renderer row-value drop ;
-
-: <completion-model> ( editor quot -- model )
-    [ one-word-elt <element-model> 1/3 seconds <delay> ] dip
-    '[ @ keys 1000 short head ] <filter> ;
-
-M: completion-popup hide-glass-hook
-    interactor>> f >>completion-popup request-focus ;
-
-: hide-completion-popup ( popup -- )
-    find-world hide-glass ;
-
-: completion-loc/doc ( popup -- loc doc )
-    interactor>> [ editor-caret ] [ model>> ] bi ;
-
-: accept-completion ( item table -- )
-    find-completion-popup
-    [ [ present ] [ completion-loc/doc ] bi* one-word-elt set-elt-string ]
-    [ hide-completion-popup ]
-    bi ;
-
-: <completion-table> ( interactor quot -- table )
-    <completion-model> <table>
-        monospace-font >>font
-        t >>selection-required?
-        completion-renderer >>renderer
-        dup '[ _ accept-completion ] >>action ;
-
-: <completion-scroller> ( object -- object )
-    <limited-scroller>
-        { 300 120 } >>min-dim
-        { 300 120 } >>max-dim ;
-
-: <completion-popup> ( interactor quot -- popup )
-    [ completion-popup new-gadget ] 2dip
-    [ drop >>interactor ] [ <completion-table> >>table ] 2bi
-    dup table>> <completion-scroller> add-gadget
-    white <solid> >>interior ;
-
-completion-popup H{
-    { T{ key-down f f "ESC" } [ hide-completion-popup ] }
-    { T{ key-down f f "TAB" } [ table>> row-action ] }
-    { T{ key-down f f " " } [ table>> row-action ] }
-} set-gestures
-
-CONSTANT: completion-popup-offset { -4 0 }
-
-: (completion-popup-loc) ( interactor element -- loc )
-    [ drop screen-loc ] [
-        [ [ [ editor-caret ] [ model>> ] bi ] dip prev-elt ] [ drop ] 2bi
-        loc>point
-    ] 2bi v+ completion-popup-offset v+ ;
-
-: completion-popup-loc-1 ( interactor element -- loc )
-    [ (completion-popup-loc) ] [ drop caret-dim ] 2bi v+ ;
-
-: completion-popup-loc-2 ( interactor element popup -- loc )
-    [ (completion-popup-loc) ] dip pref-dim { 0 1 } v* v- ;
-
-: completion-popup-fits? ( interactor element popup -- ? )
-    [ [ completion-popup-loc-1 ] dip pref-dim v+ ]
-    [ 2drop find-world dim>> ]
-    3bi [ second ] bi@ <= ;
-
-: completion-popup-loc ( interactor element popup -- loc )
-    3dup completion-popup-fits?
-    [ drop completion-popup-loc-1 ]
-    [ completion-popup-loc-2 ]
-    if ;
-
-: show-completion-popup ( interactor quot element -- )
-    [ nip ] [ drop <completion-popup> ] 3bi
-    [ nip >>completion-popup drop ]
-    [ [ 2drop find-world ] [ 2nip ] [ completion-popup-loc ] 3tri ] 3bi
-    show-glass ;
-
-: word-completion-popup ( interactor -- )
-    dup vocab-completion?
-    [ vocabs-matching ] [ words-matching ] ? '[ [ { } ] _ if-empty ]
-    one-word-elt show-completion-popup ;
-
-: history-matching ( interactor -- alist )
-    history>>
-    [ dup string>> { { CHAR: \n CHAR: \s } } substitute ] { } map>assoc
-    <reversed> ;
-
-: history-completion-popup ( interactor -- )
-    dup '[ drop _ history-matching ] one-line-elt show-completion-popup ;
-
-: pass-to-popup? ( gesture interactor -- ? )
-    [ [ key-down? ] [ key-up? ] bi or ]
-    [ completion-popup>> ]
-    bi* and ;
-
-M: interactor handle-gesture
-    2dup pass-to-popup? [
-        2dup completion-popup>>
-        focusable-child resend-gesture
-        [ call-next-method ] [ 2drop f ] if
-    ] [ call-next-method ] if ;
-
-: selected-word ( editor -- word )
-    dup completion-popup>> [
-        [ table>> selected-row drop ] [ hide-completion-popup ] bi
-    ] [
-        selected-token dup search [ ] [ no-word ] ?if
-    ] ?if ;
-
-interactor "completion" f {
-    { T{ key-down f f "TAB" } word-completion-popup }
-    { T{ key-down f { C+ } "p" } history-completion-popup }
-} define-command-map
\ No newline at end of file
+    [ com-end ] [ call-next-method ] bi ;
\ No newline at end of file
index a97399cdca1a7330fb7a4dd51729ee5c3af40386..373eaea3469f84be9fe99c16d6e919cfa8f0bcfa 100644 (file)
@@ -140,12 +140,10 @@ M: word com-stack-effect def>> com-stack-effect ;
 } define-operation
 
 [ vocab-spec? ] \ run H{
-    { +keyboard+ T{ key-down f { C+ } "r" } }
     { +listener+ t }
 } define-operation
 
 [ vocab? ] \ test H{
-    { +keyboard+ T{ key-down f { C+ } "t" } }
     { +listener+ t }
 } define-operation
 
@@ -170,12 +168,10 @@ M: word com-stack-effect def>> com-stack-effect ;
 : com-profile ( quot -- ) profile profiler-window ;
 
 [ quotation? ] \ com-profile H{
-    { +keyboard+ T{ key-down f { C+ } "r" } }
+    { +keyboard+ T{ key-down f { C+ } "f" } }
     { +listener+ t }
 } define-operation
 
-USE: ui.gadgets.tables
-
 ! Operations -> commands
 source-editor
 "word"
@@ -188,5 +184,5 @@ interactor
 "quotation"
 "These commands operate on the entire contents of the input area."
 [ ]
-[ quot-action [ parse-lines ] with-compilation-unit ]
+[ quot-action ]
 define-operation-map