Even better completion

TODO.FACTOR.txt

@@ -1,13 +1,7 @@
 + 0.87:
 
 - live search operations need to hide the minibuffer
-- vocab links don't work
-- browse modules and vocabs by showing a new list
-- get rid of the navigator in the browser tool
 - list gadget mouse over help
-- tabs across the bottom:
-  [History] [Words] [Vocabs] [Sources] [Modules] [Help]
-  to show various search gadgets
 - top level window positioning on ms windows
 - scroll>rect broken if there are gadgets in between
 - completion is not ideal: eg, C+e "buttons"

library/ui/gadgets/lists.factor

@@ -82,7 +82,7 @@ M: list focusable-child* drop t ;
     ] [
         [
             list-value dup secondary-operation invoke-command
-        ] keep list-hook call
+        ] keep dup list-hook call
     ] if ; inline
 
 list H{

library/ui/gadgets/theme.factor

@@ -103,3 +103,7 @@ USING: arrays gadgets kernel sequences styles ;
     { 1.0 0.0 0.0 1.0 } over set-editor-caret-color
     { 0.8 0.8 1.0 1.0 } over set-editor-selection-color
     { "monospace" plain 12 } swap set-editor-font ;
+
+: popup-theme ( gadget -- )
+    T{ solid f { 0.95 0.95 0.95 0.95 } }
+    swap set-gadget-interior ;

library/ui/load.factor

@@ -39,7 +39,6 @@ PROVIDE: library/ui
     "gadgets/presentations.factor"
     "ui.factor"
     "tools/tools.factor"
-    "tools/search.factor"
     "tools/messages.factor"
     "tools/listener.factor"
     "tools/walker.factor"
@@ -47,6 +46,7 @@ PROVIDE: library/ui
     "tools/help.factor"
     "tools/dataflow.factor"
     "tools/workspace.factor"
+    "tools/search.factor"
     "tools/operations.factor"
     "text/editor.facts"
 } }

library/ui/tools/browser.factor

@@ -4,11 +4,10 @@ USING: arrays sequences kernel gadgets-panes definitions
 prettyprint gadgets-theme gadgets-borders gadgets
 generic gadgets-scrolling math io words models styles
 namespaces gadgets-tracks gadgets-presentations
-gadgets-workspace help gadgets-buttons
+gadgets-workspace help gadgets-buttons tools ;
-gadgets-search tools ;
 IN: gadgets-browser
 
-TUPLE: browser navigator definitions ;
+TUPLE: browser definitions ;
 
 TUPLE: definitions showing ;
 
@@ -60,51 +59,15 @@ tile "toolbar" { { "Close" f [ close-tile ] } } define-commands
         scroll>bottom
     ] if ;
 
-: <list-control> ( model quot -- gadget )
-    [ map [ first2 write-object terpri ] each ] curry
-    <pane-control> ;
-
-TUPLE: navigator vocab ;
-
-: <vocab-list> ( -- gadget )
-    vocabs <model> [ dup <vocab-link> 2array ]
-    <list-control> ;
-
-: <word-list> ( model -- gadget )
-    gadget get navigator-vocab
-    [ words natural-sort ] <filter>
-    [ dup word-name swap 2array ]
-    <list-control> ;
-
-C: navigator ( -- gadget )
-    f <model> over set-navigator-vocab
-    {
-        { [ <vocab-list> ] f [ <scroller> ] 1/2 }
-        { [ <word-list> ] f [ <scroller> ] 1/2 }
-    } { 1 0 } make-track* ;
-
 C: browser ( -- gadget )
     {
-        {
-            [ <navigator> ]
-            set-browser-navigator
-            f
-            1/5
-        }
         {
             [ <definitions> ]
             set-browser-definitions
             [ <scroller> ]
-            4/5
+            @center
         }
-    } { 0 1 } make-track* ;
+    } make-frame* ;
-
-: show-vocab ( vocab browser -- )
-    browser-navigator navigator-vocab set-model* ;
-
-: show-word ( word browser -- )
-    over word-vocabulary over show-vocab
-    browser-definitions show-definition ;
 
 : clear-browser ( browser -- )
     browser-definitions close-definitions ;
@@ -114,11 +77,7 @@ browser "toolbar" {
 } define-commands
 
 M: browser call-tool*
-    over vocab-link? [
+    browser-definitions show-definition ;
-        >r vocab-link-name r> show-vocab
-    ] [
-        show-word
-    ] if ;
 
 M: browser tool-scroller browser-definitions find-scroller ;
 

library/ui/tools/help.factor

@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 IN: gadgets-help
 USING: gadgets gadgets-borders gadgets-buttons
-gadgets-panes gadgets-search gadgets-scrolling help kernel
+gadgets-panes gadgets-scrolling help kernel
 models namespaces sequences gadgets-tracks gadgets-workspace ;
 
 TUPLE: help-gadget pane history ;

library/ui/tools/listener.factor

@@ -1,14 +1,14 @@
 ! Copyright (C) 2005, 2006 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 IN: gadgets-listener
-USING: compiler arrays gadgets gadgets-labels
+USING: arrays compiler gadgets gadgets-labels
-gadgets-panes gadgets-scrolling gadgets-text gadgets-lists
+gadgets-panes gadgets-scrolling gadgets-text
-gadgets-search gadgets-theme gadgets-tracks gadgets-workspace
+gadgets-theme gadgets-tracks gadgets-workspace
 generic hashtables tools io kernel listener math models
 namespaces parser prettyprint sequences shells strings styles
-threads words definitions help modules ;
+threads words definitions help ;
 
-TUPLE: listener-gadget input output stack use minibuffer ;
+TUPLE: listener-gadget input output stack use ;
 
 : ui-listener-hook ( listener -- )
     use get over set-listener-gadget-use
@@ -113,56 +113,6 @@ M: listener-gadget tool-help
 : clear-listener-stack ( listener -- )
     [ clear ] swap (call-listener) ;
 
-: hide-minibuffer ( listener -- )
-    dup listener-gadget-minibuffer dup
-    [ over track-remove ] [ drop ] if
-    dup listener-gadget-input request-focus
-    f swap set-listener-gadget-minibuffer ;
-
-: show-minibuffer ( gadget listener -- )
-    [ hide-minibuffer ] keep
-    [ set-listener-gadget-minibuffer ] 2keep
-    dupd track-add request-focus ;
-
-: show-titled-minibuffer ( listener gadget title -- )
-    <labelled-gadget> swap show-minibuffer ;
-
-: show-word-search ( listener words -- )
-    >r [ find-listener hide-minibuffer ]
-    >r dup listener-gadget-input selected-word r>
-    r> <word-search> "Word search" show-titled-minibuffer ;
-
-: show-help-search ( listener -- )
-    [ find-listener hide-minibuffer ]
-    "" swap <help-search> "Help search" show-titled-minibuffer ;
-
-: show-source-file-search ( listener action -- )
-    [ find-listener hide-minibuffer ]
-    "" swap <source-file-search>
-    "Source file search" show-titled-minibuffer ;
-
-: show-vocab-search ( listener action -- )
-    [ find-listener hide-minibuffer ]
-    >r dup listener-gadget-input selected-word r>
-    <vocab-search> "Vocabulary search" show-titled-minibuffer ;
-
-: show-module-search ( listener action -- )
-    [ find-listener hide-minibuffer ]
-    "" swap <module-search>
-    "Module search" show-titled-minibuffer ;
-
-: listener-history ( listener -- seq )
-    listener-gadget-input interactor-history <reversed> ;
-
-: history-action ( string -- )
-    find-listener listener-gadget-input set-editor-text ;
-
-: show-history ( listener -- )
-    dup listener-gadget-input editor-text
-    [ find-listener hide-minibuffer ]
-    pick listener-history <history-search>
-    "History search" show-titled-minibuffer ;
-
 listener-gadget "toolbar" {
     { "Restart" f [ start-listener ] }
     {
@@ -177,41 +127,3 @@ listener-gadget "toolbar" {
     }
     { "Send EOF" T{ key-down f { C+ } "d" } [ listener-eof ] }
 } define-commands
-
-listener-gadget "popups" {
-    {
-        "Complete word"
-        T{ key-down f f "TAB" }
-        [ all-words show-word-search ]
-    }
-    {
-        "Use vocabulary"
-        T{ key-down f { C+ } "u" }
-        [ show-vocab-search ]
-    }
-    {
-        "History"
-        T{ key-down f { C+ } "p" }
-        [ show-history ]
-    }
-    {
-        "Help search"
-        T{ key-down f { C+ } "h" }
-        [ show-help-search ]
-    }
-    {
-        "Run module"
-        T{ key-down f { C+ } "m" }
-        [ show-module-search ]
-    }
-    {
-        "Edit file"
-        T{ key-down f { C+ } "e" }
-        [ show-source-file-search ]
-    }
-    {
-        "Hide minibuffer"
-        T{ key-down f f "ESCAPE" }
-        [ hide-minibuffer ]
-    }
-} define-commands

library/ui/tools/operations.factor

@@ -54,8 +54,8 @@ M: operation invoke-command ( target operation -- )
 ! Pathnames
 [ pathname? ] H{
     { +primary+ t }
+    { +secondary+ t }
     { +name+ "Edit" }
-    { +keyboard+ T{ key-down f { A+ } "e" } }
     { +quot+ [ pathname-string edit-file ] }
 } define-operation
 
@@ -148,19 +148,21 @@ M: operation invoke-command ( target operation -- )
     { +primary+ t }
     { +name+ "Browse" }
     { +keyboard+ T{ key-down f { A+ } "b" } }
-    { +quot+ [ browser call-tool ] }
+    { +quot+ [ vocab-link-name find-workspace swap show-vocab-words ] }
 } define-operation
 
 [ vocab-link? ] H{
     { +name+ "Enter in" }
     { +keyboard+ T{ key-down f { A+ } "i" } }
-    { +quot+ [ vocab-link-name [ set-in ] curry call-listener ] }
+    { +quot+ [ vocab-link-name set-in ] }
+    { +listener+ t }
 } define-operation
 
 [ vocab-link? ] H{
     { +secondary+ t }
     { +name+ "Use" }
-    { +quot+ [ vocab-link-name [ use+ ] curry call-listener ] }
+    { +quot+ [ vocab-link-name use+ ] }
+    { +listener+ t }
 } define-operation
 
 [ vocab-link? ] H{
@@ -171,12 +173,25 @@ M: operation invoke-command ( target operation -- )
 
 ! Modules
 [ module? ] H{
-    { +primary+ t }
+    { +secondary+ t }
     { +name+ "Run" }
     { +quot+ [ module-name run-module ] }
     { +listener+ t }
 } define-operation
 
+[ module? ] H{
+    { +name+ "Load" }
+    { +quot+ [ module-name require ] }
+    { +listener+ t }
+} define-operation
+
+[ module? ] H{
+    { +name+ "Reload" }
+    { +keyboard+ T{ key-down f { A+ } "r" } }
+    { +quot+ [ reload-module ] }
+    { +listener+ t }
+} define-operation
+
 [ module? ] H{
     { +name+ "Documentation" }
     { +keyboard+ T{ key-down f { A+ } "h" } }
@@ -190,16 +205,37 @@ M: operation invoke-command ( target operation -- )
 } define-operation
 
 [ module? ] H{
-    { +name+ "Reload" }
+    { +primary+ t }
-    { +keyboard+ T{ key-down f { A+ } "r" } }
+    { +name+ "Browse" }
-    { +quot+ [ reload-module ] }
+    { +keyboard+ T{ key-down f { A+ } "b" } }
+    { +quot+ [ find-workspace swap show-module-files ] }
     { +listener+ t }
 } define-operation
 
 [ module? ] H{
     { +name+ "See" }
-    { +keyboard+ T{ key-down f { A+ } "b" } }
+    { +quot+ [ browser call-tool ] }
-    { +quot+ [ see ] }
+    { +listener+ t }
+} define-operation
+
+[ module? ] H{
+    { +name+ "Test" }
+    { +quot+ [ module-name test-module ] }
+    { +listener+ t }
+} define-operation
+
+! Module links
+[ module-link? ] H{
+    { +primary+ t }
+    { +secondary+ t }
+    { +name+ "Run" }
+    { +quot+ [ module-name run-module ] }
+    { +listener+ t }
+} define-operation
+
+[ module-link? ] H{
+    { +name+ "Load" }
+    { +quot+ [ module-name require ] }
     { +listener+ t }
 } define-operation
 

library/ui/tools/search.factor

@@ -4,8 +4,9 @@ IN: gadgets-search
 USING: arrays gadgets gadgets-labels gadgets-panes
 gadgets-scrolling gadgets-text gadgets-theme
 generic help tools kernel models sequences words
-gadgets-borders gadgets-lists namespaces parser hashtables io
+gadgets-borders gadgets-lists gadgets-workspace gadgets-listener
-completion styles strings modules ;
+namespaces parser hashtables io completion styles strings
+modules ;
 
 TUPLE: live-search field list ;
 
@@ -31,10 +32,12 @@ search-field H{
     [ "\n" join ] <filter>
     swap <filter> ;
 
-: <search-list> ( hook seq producer presenter -- gadget )
+: <search-list> ( seq producer presenter -- gadget )
-    -rot curry <search-model> <list> ;
+    -rot curry <search-model>
+    [ [ workspace? ] find-parent hide-popup ] -rot
+    <list> ;
 
-C: live-search ( string hook seq producer presenter -- gadget )
+C: live-search ( string seq producer presenter -- gadget )
     {
         {
             [ <search-field> ]
@@ -49,16 +52,18 @@ C: live-search ( string hook seq producer presenter -- gadget )
             @center
         }
     } make-frame*
-    [ live-search-field set-editor-text ] keep ;
+    [ live-search-field set-editor-text ] keep
+    [ live-search-field select-all ] keep
+    dup popup-theme ;
 
 M: live-search focusable-child* live-search-field ;
 
-: delegate>live-search ( string hook seq producer presenter gadget -- )
+: delegate>live-search ( string seq producer presenter gadget -- )
     >r <live-search> r> set-gadget-delegate ;
 
 TUPLE: word-search ;
 
-C: word-search ( string action words -- gadget )
+C: word-search ( string words -- gadget )
     >r
     [ word-completions ]
     [ word-name ]
@@ -72,7 +77,7 @@ C: word-search ( string action words -- gadget )
 
 TUPLE: help-search ;
 
-C: help-search ( string action -- gadget )
+C: help-search ( string -- gadget )
     >r
     all-articles [ dup article-title 2array ] map
     [ [ second ] 2apply <=> ] sort
@@ -83,9 +88,8 @@ C: help-search ( string action -- gadget )
 
 TUPLE: source-file-search ;
 
-C: source-file-search ( string action -- gadget )
+C: source-file-search ( string files -- gadget )
     >r
-    source-files get hash-keys natural-sort
     [ string-completions [ <pathname> ] map ]
     [ pathname-string ]
     r>
@@ -96,7 +100,7 @@ C: source-file-search ( string action -- gadget )
 
 TUPLE: module-search ;
 
-: module-search ( string action -- gadget )
+C: module-search ( string -- gadget )
     >r
     available-modules [ module-completions ]
     [ module-name ]
@@ -105,7 +109,7 @@ TUPLE: module-search ;
 
 TUPLE: vocab-search ;
 
-C: vocab-search ( string action -- gadget )
+C: vocab-search ( string -- gadget )
     >r
     vocabs [ string-completions [ <vocab-link> ] map ]
     [ vocab-link-name ]
@@ -114,7 +118,7 @@ C: vocab-search ( string action -- gadget )
 
 TUPLE: history-search ;
 
-C: history-search ( string action seq -- gadget )
+C: history-search ( string seq -- gadget )
     >r
     [ string-completions [ <input> ] map ]
     [ input-string ]
@@ -123,3 +127,86 @@ C: history-search ( string action seq -- gadget )
 
 : search-action ( search -- obj )
     live-search-list list-value ;
+
+: show-titled-popup ( workspace gadget title -- )
+    <labelled-gadget> swap show-popup ;
+
+: workspace-listener ( workspace -- listener )
+    listener-gadget swap find-tool tool-gadget nip ;
+
+: current-word ( workspace -- string )
+    workspace-listener listener-gadget-input selected-word ;
+
+: show-word-search ( workspace words -- )
+    >r dup current-word r> <word-search>
+    "Word search" show-titled-popup ;
+
+: show-vocab-words ( workspace vocab -- )
+    "" over words <word-search>
+    "Words in " rot append show-titled-popup ;
+
+: show-help-search ( workspace -- )
+    "" <help-search> "Help search" show-titled-popup ;
+
+: all-source-files ( -- seq )
+    source-files get hash-keys natural-sort ;
+
+: show-source-file-search ( workspace -- )
+    "" all-source-files <source-file-search>
+    "Source file search" show-titled-popup ;
+
+: show-module-files ( workspace module -- )
+    "" over module-files <source-file-search>
+    "Source files in " rot module-name append show-titled-popup ;
+
+: show-vocab-search ( workspace -- )
+    dup current-word <vocab-search>
+    "Vocabulary search" show-titled-popup ;
+
+: show-module-search ( workspace -- )
+    "" <module-search> "Module search" show-titled-popup ;
+
+: listener-history ( listener -- seq )
+    listener-gadget-input interactor-history <reversed> ;
+
+: history-action ( string -- )
+    find-listener listener-gadget-input set-editor-text ;
+
+: show-history ( workspace -- )
+    dup workspace-listener
+    [ listener-gadget-input editor-text ] keep listener-history
+    <history-search>
+    "History search" show-titled-popup ;
+
+workspace "toolbar" {
+    {
+        "History"
+        T{ key-down f { C+ } "p" }
+        [ show-history ]
+    }
+    {
+        "Words"
+        T{ key-down f f "TAB" }
+        [ all-words show-word-search ]
+    }
+    {
+        "Vocabularies"
+        T{ key-down f { C+ } "u" }
+        [ show-vocab-search ]
+    }
+    {
+        "Modules"
+        T{ key-down f { C+ } "m" }
+        [ show-module-search ]
+    }
+    {
+        "Sources"
+        T{ key-down f { C+ } "e" }
+        [ show-source-file-search ]
+    }
+    {
+        "Search help"
+        T{ key-down f { C+ } "h" }
+        [ show-help-search ]
+    }
+} define-commands

library/ui/tools/tools.factor

@@ -20,15 +20,17 @@ GENERIC: tool-help ( tool -- topic )
 
 M: gadget tool-help drop f ;
 
-TUPLE: workspace ;
+TUPLE: workspace book popup ;
 
 TUPLE: tool gadget ;
 
 : find-tool ( class workspace -- index tool )
-    gadget-children [ tool-gadget class eq? ] find-with ;
+    workspace-book gadget-children
+    [ tool-gadget class eq? ] find-with ;
 
 : show-tool ( class workspace -- tool )
-    [ find-tool swap ] keep control-model set-model* ;
+    [ find-tool swap ] keep workspace-book control-model
+    set-model* ;
 
 : select-tool ( workspace class -- ) swap show-tool drop ;
 

library/ui/tools/workspace.factor

@@ -53,14 +53,19 @@ tool "toolbar" {
         { "Dataflow" <dataflow-gadget> }
     } ;
 
+: <workspace-book> ( -- gadget )
+    workspace-tabs 1 <column> [ execute <tool> ] map <book> ;
+
 C: workspace ( -- workspace )
-    workspace-tabs 1 <column> [ execute <tool> ] map <book>
+    {
-    over set-gadget-delegate dup dup set-control-self ;
+        { [ <workspace-book> ] set-workspace-book f @center }
+        { [ gadget get { workspace } <toolbar> ] f f @bottom }
+    } make-frame* ;
 
 M: workspace pref-dim* delegate pref-dim* { 550 650 } vmax ;
 
-: <workspace-tabs> ( book -- tabs )
+: <workspace-tabs> ( workspace -- tabs )
-    control-model
+    workspace-book control-model
     workspace-tabs dup length [ swap first 2array ] 2map
     <radio-box> ;
 
@@ -70,6 +75,33 @@ M: workspace pref-dim* delegate pref-dim* { 550 650 } vmax ;
 : init-tabs ( world -- )
     [ world-gadget <workspace-tabs> ] keep @top grid-add ;
 
+: hide-popup ( workspace -- )
+    dup workspace-popup unparent
+    f over set-workspace-popup
+    request-focus ;
+
+: show-popup ( gadget workspace -- )
+    dup hide-popup 2dup set-workspace-popup dupd add-gadget
+    request-focus ;
+
+: popup-dim ( workspace -- dim )
+    rect-dim first2 3 /i 2array ;
+
+: popup-loc ( workspace -- loc )
+    dup rect-dim swap popup-dim v- ;
+
+: layout-popup ( workspace gadget -- )
+    over popup-dim over set-gadget-dim
+    swap popup-loc swap set-rect-loc ;
+
+M: workspace layout*
+    dup delegate layout*
+    dup workspace-popup dup [ layout-popup ] [ 2drop ] if ;
+
+M: workspace children-on nip gadget-children ;
+
+M: workspace focusable-child* workspace-book ;
+
 : workspace-window ( -- workspace )
     <workspace> dup <world>
     [ init-status ] keep
@@ -91,6 +123,7 @@ workspace "scrolling" {
 } define-commands
 
 workspace "tool-switch" {
+    { "Hide popup" T{ key-down f f "ESCAPE" } [ hide-popup ] }
     { "Listener" T{ key-down f f "F2" } [ listener-gadget select-tool ] }
     { "Messages" T{ key-down f f "F3" } [ messages select-tool ] }
     { "Definitions" T{ key-down f f "F4" } [ browser select-tool ] }