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

Even better completion

darcs
slava 2006-11-17 23:11:35 +00:00
parent 4852c894f2
commit 109a4c9447
11 changed files with 206 additions and 179 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
TODO.FACTOR.txt
View File

@ -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"

2
library/ui/gadgets/lists.factor
View File

@ -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{

4
library/ui/gadgets/theme.factor
View File

@ -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 ;

2
library/ui/load.factor
View File

@ -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"
} }

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

@ -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-search tools ;
gadgets-workspace help gadgets-buttons 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* ;
: show-vocab ( vocab browser -- )
browser-navigator navigator-vocab set-model* ;
: show-word ( word browser -- )
over word-vocabulary over show-vocab
browser-definitions show-definition ;
} make-frame* ;
: clear-browser ( browser -- )
browser-definitions close-definitions ;
@ -114,11 +77,7 @@ browser "toolbar" {
} define-commands
M: browser call-tool*
over vocab-link? [
>r vocab-link-name r> show-vocab
] [
show-word
] if ;
browser-definitions show-definition ;
M: browser tool-scroller browser-definitions find-scroller ;

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

@ -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 ;

98
library/ui/tools/listener.factor
View File

@ -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
gadgets-panes gadgets-scrolling gadgets-text gadgets-lists
gadgets-search gadgets-theme gadgets-tracks gadgets-workspace
USING: arrays compiler gadgets gadgets-labels
gadgets-panes gadgets-scrolling gadgets-text
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

56
library/ui/tools/operations.factor
View File

@ -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" }
{ +keyboard+ T{ key-down f { A+ } "r" } }
{ +quot+ [ reload-module ] }
{ +primary+ t }
{ +name+ "Browse" }
{ +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+ [ see ] }
{ +quot+ [ browser call-tool ] }
{ +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

115
library/ui/tools/search.factor
View File

@ -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
completion styles strings modules ;
gadgets-borders gadgets-lists gadgets-workspace gadgets-listener
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 )
-rot curry <search-model> <list> ;
: <search-list> ( seq producer presenter -- gadget )
-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

8
library/ui/tools/tools.factor
View File

@ -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 ;

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

@ -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 )
control-model
: <workspace-tabs> ( workspace -- tabs )
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 ] }