Simplify completion, add module completion
slava
parent
4a13299219
commit
1c2596114e
|
|
@ -10,7 +10,7 @@ ARTICLE: "handbook" "Factor documentation"
|
|||
{ "The basic unit of code, corresponding to a \"function\" in other languages, is called a " { $emphasis "word" } " in Factor." }
|
||||
{ "Word take inputs from the stack, and leave output values on the stack. This is documented in a " { $emphasis "stack effect declaration" } ", for example " { $snippet "( x y -- z )" } " denotes that a word takes two inputs, with " { $snippet "y" } " at the top of the stack, and returns one output. See " { $link "effect-declaration" } " for details." }
|
||||
{ "You can load source files with " { $link run-file } ":"
|
||||
{ $code "\"hello-world.factor\" run-file" } }
|
||||
{ $code "\"my-program.factor\" run-file" } }
|
||||
{ { "You can load modules from " { $snippet "contrib/" } " and " { $snippet "examples/" } " with " { $link require } ":" }
|
||||
{ $code "\"contrib/httpd\" require" } }
|
||||
{ { "Some modules have a defined main entry point, and can be run just like applications in an operating system:" }
|
||||
|
|
|
|||
|
|
@ -9,6 +9,11 @@ SYMBOL: modules
|
|||
|
||||
TUPLE: module name loc files tests help main ;
|
||||
|
||||
! For presentations
|
||||
TUPLE: module-link name ;
|
||||
|
||||
M: module-link module-name module-link-name ;
|
||||
|
||||
: module-def ( name -- path )
|
||||
"resource:" over ".factor" append3
|
||||
dup ?resource-path exists? [
|
||||
|
|
@ -17,8 +22,6 @@ TUPLE: module name loc files tests help main ;
|
|||
drop "resource:" swap "/load.factor" append3
|
||||
] if ;
|
||||
|
||||
M: module <=> [ module-name ] 2apply <=> ;
|
||||
|
||||
: module modules get [ module-name = ] find-with nip ;
|
||||
|
||||
: load-module ( name -- )
|
||||
|
|
@ -68,10 +71,6 @@ M: module <=> [ module-name ] 2apply <=> ;
|
|||
: test-modules ( -- )
|
||||
modules get [ module-tests* ] map concat run-tests ;
|
||||
|
||||
: modules. ( -- )
|
||||
modules get natural-sort
|
||||
[ [ module-name ] keep write-object terpri ] each ;
|
||||
|
||||
: reload-module ( module -- )
|
||||
dup module-name module-def source-modified? [
|
||||
module-name load-module
|
||||
|
|
@ -101,3 +100,33 @@ M: module synopsis* \ PROVIDE: pprint-word module-name text ;
|
|||
M: module definition module>alist t ;
|
||||
|
||||
M: module where* module-loc ;
|
||||
|
||||
: module-dir? ( path -- ? )
|
||||
"load.factor" path+ resource-path exists? ;
|
||||
|
||||
: (available-modules) ( path -- )
|
||||
dup directory [ path+ ] map-with
|
||||
dup [ module-dir? ] subset %
|
||||
[ (available-modules) ] each ;
|
||||
|
||||
: small-modules ( path -- seq )
|
||||
dup resource-path directory [ path+ ] map-with
|
||||
[ ".factor" tail? ] subset
|
||||
[ ".factor" ?tail drop ] map ;
|
||||
|
||||
: available-modules ( -- seq )
|
||||
[
|
||||
"library" (available-modules)
|
||||
"contrib" (available-modules)
|
||||
"contrib" small-modules %
|
||||
"examples" (available-modules)
|
||||
"examples" small-modules %
|
||||
] { } make natural-sort
|
||||
[ dup module [ ] [ <module-link> ] ?if ] map ;
|
||||
|
||||
: module-string ( obj -- str )
|
||||
dup module-name swap module? [ " (loaded)" append ] when ;
|
||||
|
||||
: modules. ( -- )
|
||||
available-modules
|
||||
[ [ module-string ] keep write-object terpri ] each ;
|
||||
|
|
|
|||
|
|
@ -50,31 +50,25 @@ USING: kernel arrays sequences math namespaces strings io ;
|
|||
|
||||
: rank-completions ( results -- newresults )
|
||||
#! Discard results in the low 33%
|
||||
[ [ second ] 2apply swap - ] sort
|
||||
[ 0 [ second max ] reduce 3 / ] keep
|
||||
[ second < ] subset-with ;
|
||||
[ [ first ] 2apply swap - ] sort
|
||||
[ 0 [ first max ] reduce 3 / ] keep
|
||||
[ first < ] subset-with
|
||||
[ second ] map ;
|
||||
|
||||
: completion ( str quot obj -- pair )
|
||||
#! pair is { obj score }
|
||||
pick empty? [
|
||||
2nip 1 2array
|
||||
] [
|
||||
[ swap call dup rot fuzzy score ] keep swap 2array
|
||||
] if ; inline
|
||||
[ swap call dup rot fuzzy score ] keep 2array ; inline
|
||||
|
||||
: completions ( str quot candidates -- seq )
|
||||
pick empty? [
|
||||
dup length 100 > [
|
||||
3drop f
|
||||
] [
|
||||
2nip [ 1 2array ] map
|
||||
2nip
|
||||
] if
|
||||
] [
|
||||
[ >r 2dup r> completion ] map 2nip rank-completions
|
||||
] if ; inline
|
||||
|
||||
: completion>string ( score str -- newstr )
|
||||
[ % " (score: " % >fixnum # ")" % ] "" make ;
|
||||
|
||||
: string-completions ( str strs -- seq )
|
||||
f swap completions ;
|
||||
|
|
|
|||
|
|
@ -47,12 +47,8 @@ generic completion ;
|
|||
swap [ global [ inc ] bind ] curry swap append
|
||||
] annotate ;
|
||||
|
||||
: word-completion. ( pair -- )
|
||||
first2 over summary completion>string swap write-object ;
|
||||
|
||||
: word-completions ( str words -- seq )
|
||||
[ word-name ] swap completions ;
|
||||
|
||||
: apropos ( str -- )
|
||||
all-words word-completions
|
||||
[ word-completion. terpri ] each ;
|
||||
all-words word-completions [ . ] each ;
|
||||
|
|
|
|||
|
|
@ -1,19 +1,20 @@
|
|||
! Copyright (C) 2006 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
IN: gadgets-lists
|
||||
USING: gadgets gadgets-scrolling kernel sequences models opengl
|
||||
math namespaces ;
|
||||
USING: gadgets gadgets-labels gadgets-scrolling kernel sequences
|
||||
models opengl math namespaces gadgets-theme ;
|
||||
|
||||
TUPLE: list index presenter action color ;
|
||||
|
||||
: list-theme ( list -- )
|
||||
{ 0.8 0.8 1.0 1.0 } swap set-list-color ;
|
||||
|
||||
C: list ( model presenter action -- gadget )
|
||||
[ set-list-action ] keep
|
||||
C: list ( action presenter model -- gadget )
|
||||
[ swap <pile> delegate>control ] keep
|
||||
[ set-list-presenter ] keep
|
||||
dup rot <pile> 1 over set-pack-fill delegate>control
|
||||
[ set-list-action ] keep
|
||||
0 over set-list-index
|
||||
1 over set-pack-fill
|
||||
dup list-theme ;
|
||||
|
||||
: bound-index ( list -- )
|
||||
|
|
@ -22,7 +23,9 @@ C: list ( model presenter action -- gadget )
|
|||
|
||||
M: list model-changed
|
||||
dup clear-gadget
|
||||
dup control-value over list-presenter map over add-gadgets
|
||||
dup control-value
|
||||
over list-presenter map [ <label> dup text-theme ] map
|
||||
over add-gadgets
|
||||
bound-index ;
|
||||
|
||||
: selected-rect ( list -- rect )
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
IN: temporary
|
||||
USING: gadgets-lists models prettyprint math test ;
|
||||
|
||||
[ ] [ f <model> [ ] [ 3 + . ] <list> call-action ] unit-test
|
||||
[ ] [ [ ] [ 3 + . ] f <model> <list> call-action ] unit-test
|
||||
|
|
|
|||
|
|
@ -5,13 +5,6 @@ sequences threads freetype timers kernel ;
|
|||
timers get [ init-timers ] unless
|
||||
|
||||
[
|
||||
[ "hey man (score: 123)" ]
|
||||
[
|
||||
[
|
||||
{ "hey man" 123 } [ <pathname> ] string-completion.
|
||||
] string-out
|
||||
] unit-test
|
||||
|
||||
"set-word-prop" [ ] <word-search> "search" set
|
||||
"search" get graft
|
||||
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@ gadgets-panes gadgets-scrolling gadgets-text gadgets-lists
|
|||
gadgets-search 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 ;
|
||||
threads words definitions help modules ;
|
||||
|
||||
TUPLE: listener-gadget input output stack use minibuffer ;
|
||||
|
||||
|
|
@ -145,6 +145,11 @@ M: listener-gadget tool-help
|
|||
>r dup listener-gadget-input selected-word r>
|
||||
<vocabs-search> "Vocabulary search" show-titled-minibuffer ;
|
||||
|
||||
: show-modules-search ( listener action -- )
|
||||
minibuffer-action
|
||||
"" swap <modules-search>
|
||||
"Module search" show-titled-minibuffer ;
|
||||
|
||||
: listener-history ( listener -- seq )
|
||||
listener-gadget-input interactor-history <reversed> ;
|
||||
|
||||
|
|
@ -153,8 +158,9 @@ M: listener-gadget tool-help
|
|||
|
||||
: show-history ( listener -- )
|
||||
dup listener-gadget-input editor-text
|
||||
over listener-history [ history-action ] minibuffer-action
|
||||
<history-search> "History search" show-titled-minibuffer ;
|
||||
[ input-string history-action ] minibuffer-action
|
||||
pick listener-history <history-search>
|
||||
"History search" show-titled-minibuffer ;
|
||||
|
||||
: completion-string ( word listener -- string )
|
||||
>r dup word-name swap word-vocabulary dup vocab r>
|
||||
|
|
@ -166,7 +172,7 @@ M: listener-gadget tool-help
|
|||
listener-gadget-input user-input ;
|
||||
|
||||
listener-gadget "toolbar" {
|
||||
{ "Restart" T{ key-down f { C+ } "r" } [ start-listener ] }
|
||||
{ "Restart" f [ start-listener ] }
|
||||
{
|
||||
"History"
|
||||
T{ key-down f { C+ } "h" }
|
||||
|
|
@ -194,12 +200,17 @@ listener-gadget "completion" {
|
|||
{
|
||||
"Edit file"
|
||||
T{ key-down f { C+ } "e" }
|
||||
[ [ edit-file ] show-source-files-search ]
|
||||
[ [ pathname-string edit-file ] show-source-files-search ]
|
||||
}
|
||||
{
|
||||
"Use vocabulary"
|
||||
T{ key-down f { C+ } "u" }
|
||||
[ [ [ use+ ] curry call-listener ] show-vocabs-search ]
|
||||
[ [ [ vocab-link-name use+ ] curry call-listener ] show-vocabs-search ]
|
||||
}
|
||||
{
|
||||
"Run module"
|
||||
T{ key-down f { C+ } "m" }
|
||||
[ [ [ module-name run-module ] curry call-listener ] show-modules-search ]
|
||||
}
|
||||
{
|
||||
"Hide minibuffer"
|
||||
|
|
|
|||
|
|
@ -5,9 +5,9 @@ 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 ;
|
||||
completion styles strings modules ;
|
||||
|
||||
TUPLE: live-search field list producer action presenter ;
|
||||
TUPLE: live-search field list ;
|
||||
|
||||
: find-live-search [ live-search? ] find-parent ;
|
||||
|
||||
|
|
@ -15,10 +15,9 @@ TUPLE: live-search field list producer action presenter ;
|
|||
|
||||
TUPLE: search-field ;
|
||||
|
||||
C: search-field ( string -- gadget )
|
||||
C: search-field ( -- gadget )
|
||||
<editor> over set-gadget-delegate
|
||||
dup dup set-control-self
|
||||
[ set-editor-text ] keep
|
||||
[ editor-doc-end ] keep ;
|
||||
|
||||
search-field H{
|
||||
|
|
@ -27,22 +26,15 @@ search-field H{
|
|||
{ T{ key-down f f "RETURN" } [ find-search-list call-action ] }
|
||||
} set-gestures
|
||||
|
||||
: <search-model> ( -- model )
|
||||
gadget get dup live-search-field control-model
|
||||
200 <delay>
|
||||
swap live-search-producer [ "\n" join ] swap append
|
||||
<filter> ;
|
||||
: <search-model> ( producer -- model )
|
||||
gadget get live-search-field control-model 200 <delay>
|
||||
[ "\n" join ] <filter>
|
||||
swap <filter> ;
|
||||
|
||||
: <search-list>
|
||||
<search-model>
|
||||
gadget get live-search-presenter [ make-pane ] curry
|
||||
gadget get live-search-action \ first add*
|
||||
<list> ;
|
||||
: <search-list> ( action seq producer presenter -- gadget )
|
||||
-rot curry <search-model> <list> ;
|
||||
|
||||
C: live-search ( string action producer presenter -- gadget )
|
||||
[ set-live-search-presenter ] keep
|
||||
[ set-live-search-producer ] keep
|
||||
[ set-live-search-action ] keep
|
||||
C: live-search ( string action seq producer presenter -- gadget )
|
||||
{
|
||||
{
|
||||
[ <search-field> ]
|
||||
|
|
@ -56,37 +48,48 @@ C: live-search ( string action producer presenter -- gadget )
|
|||
[ <scroller> ]
|
||||
@center
|
||||
}
|
||||
} make-frame* ;
|
||||
} make-frame*
|
||||
[ live-search-field set-editor-text ] keep ;
|
||||
|
||||
M: live-search focusable-child* live-search-field ;
|
||||
|
||||
: <word-search> ( string action -- gadget )
|
||||
all-words
|
||||
[ word-completions ] curry
|
||||
[ word-completion. ]
|
||||
[ word-completions ]
|
||||
[ word-name ]
|
||||
<live-search> ;
|
||||
|
||||
: help-completions ( str pairs -- seq )
|
||||
>r >lower r>
|
||||
[ second >lower ] swap completions
|
||||
[ first <link> ] map ;
|
||||
|
||||
: <help-search> ( string action -- gadget )
|
||||
[ search-help ]
|
||||
[ first ($link) ]
|
||||
all-articles [ dup article-title 2array ] map
|
||||
[ help-completions ]
|
||||
[ article-title ]
|
||||
<live-search> ;
|
||||
|
||||
: string-completion. ( pair quot -- )
|
||||
>r first2 over completion>string swap r> call write-object ;
|
||||
inline
|
||||
|
||||
: <source-files-search> ( string action -- gadget )
|
||||
source-files get hash-keys natural-sort
|
||||
[ string-completions ] curry
|
||||
[ [ <pathname> ] string-completion. ]
|
||||
[ string-completions [ <pathname> ] map ]
|
||||
[ pathname-string ]
|
||||
<live-search> ;
|
||||
|
||||
: module-completions ( str modules -- seq )
|
||||
[ module-name ] swap completions ;
|
||||
|
||||
: <modules-search> ( string action -- gadget )
|
||||
available-modules [ module-completions ]
|
||||
[ module-name ]
|
||||
<live-search> ;
|
||||
|
||||
: <vocabs-search> ( string action -- gadget )
|
||||
vocabs [ string-completions ] curry
|
||||
[ [ <vocab-link> ] string-completion. ]
|
||||
vocabs [ string-completions [ <vocab-link> ] map ]
|
||||
[ vocab-link-name ]
|
||||
<live-search> ;
|
||||
|
||||
: <history-search> ( string seq action -- gadget )
|
||||
swap [ string-completions ] curry
|
||||
[ first dup <input> write-object ]
|
||||
: <history-search> ( string action seq -- gadget )
|
||||
[ string-completions [ <input> ] map ]
|
||||
[ input-string ]
|
||||
<live-search> ;
|
||||
|
|
|
|||
|
|
@ -148,7 +148,8 @@ C: labelled-gadget ( gadget title -- gadget )
|
|||
M: labelled-gadget focusable-child* labelled-gadget-content ;
|
||||
|
||||
: <labelled-pane> ( model quot title -- gadget )
|
||||
>r <pane-control> <scroller> r> <labelled-gadget> ;
|
||||
>r <pane-control> t over set-pane-scrolls? <scroller> r>
|
||||
<labelled-gadget> ;
|
||||
|
||||
: pane-window ( quot title -- )
|
||||
>r make-pane <scroller> r> open-titled-window ;
|
||||
|
|
|
|||
Loading…
Reference in New Issue