Remove some code duplication between apropos and help search

diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt
index 1e2299056e62c761b23450af5955157b810a41f4..2fc37b933cdc21e940b150472aa9a1b37fd25b36 100644 (file)
--- a/TODO.FACTOR.txt
+++ b/TODO.FACTOR.txt
@@ -12,6 +12,11 @@
 - minibuffer should show a title
 - clean up listener's minibuffer-related code
 - help search looks funny
+- vocab completer
+- vocab operations:
+  - browse
+  - insert IN:   -- or just 'become in'
+  - insert USE:  -- 'use'
 
 + ui:
 

diff --git a/library/help/search.factor b/library/help/search.factor
index 3a72961c2578cafbbfaaedbf583cdee1467b90b7..1c9179e78a09f96cb832f258474166b61107a649 100644 (file)
--- a/library/help/search.factor
+++ b/library/help/search.factor
@@ -36,12 +36,6 @@ SYMBOL: term-index
         drop
     ] if* ;
 
-: discard-irrelevant ( results -- newresults )
-    #! Discard results in the low 33%
-    dup 0 [ second max ] reduce
-    swap [ first2 rot / 2array ] map-with
-    [ second 1/3 > ] subset ;
-
 : count-occurrences ( seq -- hash )
     [
         dup [ [ drop off ] hash-each ] each
@@ -50,9 +44,7 @@ SYMBOL: term-index
 
 : search-help ( phrase -- assoc )
     tokenize [ term-index get hash ] map [ ] subset
-    count-occurrences hash>alist
-    [ first2 2array ] map
-    [ [ second ] 2apply swap - ] sort discard-irrelevant ;
+    count-occurrences hash>alist rank-completions ;
 
 : index-help ( -- )
     term-index get [
@@ -83,9 +75,6 @@ SYMBOL: term-index
     over >r "help" set-word-prop r>
     dup xref-article index-article ;
 
-: search-help. ( phrase -- )
-    search-help [ first ] map help-outliner ;
-
 ! Definition protocol
 M: link forget link-name remove-article ;
 

diff --git a/library/help/search.facts b/library/help/search.facts
index a044d74c8bf7a59f063241870783ca589910f5ef..87c978ae5067631ab0368e9cba6631938ee18735 100644 (file)
--- a/library/help/search.facts
+++ b/library/help/search.facts
@@ -36,7 +36,7 @@ HELP: search-help
 { $description "Performs a full-text search in the term index for help topics relating to " { $snippet "phrase" } ". The result is an association list of topic names paired with scores, sorted by decreasing score." } ;
 
 HELP: index-help
-{ $description "Updates the full-text search term index for use by " { $link search-help } " and " { $link search-help. } "." } ;
+{ $description "Updates the full-text search term index for use by " { $link search-help } "." } ;
 
 HELP: search-help.
 { $values { "phrase" "a string" } }

diff --git a/library/load.factor b/library/load.factor
index de76e006377b6b6d36f86b6b9629bd416bf90a9c..2054a4d7bd919178759eae9cd95e8fa096f50df5 100644 (file)
--- a/library/load.factor
+++ b/library/load.factor
@@ -94,7 +94,7 @@ PROVIDE: library {
     "tools/memory.factor"
     "tools/listener.factor"
     "tools/inspector.factor"
-    "tools/fuzzy.factor"
+    "tools/completion.factor"
     "tools/word-tools.factor"
     "tools/test.factor"
 
@@ -206,6 +206,7 @@ PROVIDE: library {
     "test/generic.factor"
     "test/help/porter-stemmer.factor"
     "test/help/topics.factor"
+    "test/help/search.factor"
     "test/inference.factor"
     "test/init.factor"
     "test/inspector.factor"

diff --git a/library/test/help/search.factor b/library/test/help/search.factor
new file mode 100644 (file)
index 0000000..6cb42aa
--- /dev/null
+++ b/library/test/help/search.factor
@@ -0,0 +1,6 @@
+IN: temporary
+USING: help sequences math test ;
+
+[ t ]
+[ "variables" search-help [ second number? ] all? ]
+unit-test

diff --git a/library/test/tools.factor b/library/test/tools.factor
index 21d9e835e690bdcf85a68d5e95e23079f7f3c130..11fccabaa332674e3b602df57c23b8a1c07526a1 100644 (file)
--- a/library/test/tools.factor
+++ b/library/test/tools.factor
@@ -2,3 +2,4 @@ IN: temporary
 USING: tools ;
 
 [ ] [ "" apropos ] unit-test
+[ ] [ "swp" apropos ] unit-test

diff --git a/library/tools/completion.factor b/library/tools/completion.factor
new file mode 100644 (file)
index 0000000..396d0fd
--- /dev/null
+++ b/library/tools/completion.factor
@@ -0,0 +1,72 @@
+! Copyright (C) 2005, 2006 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+IN: completion
+USING: kernel arrays sequences math namespaces strings io ;
+
+! Simple fuzzy search.
+
+: fuzzy ( full short -- indices )
+    0 swap >array [ swap pick index* [ 1+ ] keep ] map 2nip
+    -1 over member? [ drop f ] when ;
+
+: (runs) ( n i seq -- )
+    2dup length < [
+        3dup nth [
+            number= [
+                >r >r 1+ r> r>
+            ] [
+                split-next,
+                rot drop [ nth 1+ ] 2keep
+            ] if >r 1+ r>
+        ] keep split, (runs)
+    ] [
+        3drop
+    ] if ;
+
+: runs ( seq -- seq )
+    [
+        split-next,
+        dup first 0 rot (runs)
+    ] { } make ;
+
+: score-1 ( i full -- n )
+    {
+        { [ over zero? ] [ 2drop 10 ] }
+        { [ 2dup length 1- = ] [ 2drop 4 ] }
+        { [ 2dup >r 1- r> nth Letter? not ] [ 2drop 10 ] }
+        { [ 2dup >r 1+ r> nth Letter? not ] [ 2drop 4 ] }
+        { [ t ] [ 2drop 1 ] }
+    } cond ;
+
+: score ( full fuzzy -- n )
+    dup [
+        [ [ length ] 2apply - 15 swap [-] 3 / ] 2keep
+        runs [
+            [ swap score-1 ] map-with dup supremum swap length *
+        ] map-with sum +
+    ] [
+        2drop 0
+    ] if ;
+
+: rank-completions ( results -- newresults )
+    #! Discard results in the low 33%
+    [ [ second ] 2apply swap - ] sort
+    [ 0 [ second max ] reduce ] keep
+    [ second swap > ] subset-with ;
+
+: completion ( str quot obj -- pair )
+    #! pair is { obj score }
+    [ swap call dup rot fuzzy score ] keep swap 2array ; inline
+
+: completions ( str candidates quot -- seq )
+    pick empty? [
+        3drop f
+    ] [
+        [ >r 2dup r> completion ] map 2nip rank-completions
+    ] if ; inline
+
+: completion>string ( score str -- )
+    [ % " (score: " % >fixnum # ")" % ] "" make ;
+
+: string-completions ( str strs -- seq )
+    f swap completions ;

diff --git a/library/tools/fuzzy.factor b/library/tools/fuzzy.factor
deleted file mode 100644 (file)
index 25b60b4..0000000
--- a/library/tools/fuzzy.factor
+++ /dev/null
@@ -1,72 +0,0 @@
-! Copyright (C) 2005, 2006 Slava Pestov.
-! See http://factorcode.org/license.txt for BSD license.
-IN: tools
-USING: kernel arrays sequences math namespaces strings io ;
-
-! Simple fuzzy search.
-
-: fuzzy ( full short -- indices )
-    0 swap >array [ swap pick index* [ 1+ ] keep ] map 2nip
-    -1 over member? [ drop f ] when ;
-
-: (runs) ( n i seq -- )
-    2dup length < [
-        3dup nth [
-            number= [
-                >r >r 1+ r> r>
-            ] [
-                split-next,
-                rot drop [ nth 1+ ] 2keep
-            ] if >r 1+ r>
-        ] keep split, (runs)
-    ] [
-        3drop
-    ] if ;
-
-: runs ( seq -- seq )
-    [
-        split-next,
-        dup first 0 rot (runs)
-    ] { } make ;
-
-: score-1 ( i full -- n )
-    {
-        { [ over zero? ] [ 2drop 10 ] }
-        { [ 2dup length 1- = ] [ 2drop 4 ] }
-        { [ 2dup >r 1- r> nth Letter? not ] [ 2drop 10 ] }
-        { [ 2dup >r 1+ r> nth Letter? not ] [ 2drop 4 ] }
-        { [ t ] [ 2drop 1 ] }
-    } cond ;
-
-: score ( full fuzzy -- n )
-    dup [
-        [ [ length ] 2apply - 15 swap [-] 3 / ] 2keep
-        runs [
-            [ swap score-1 ] map-with dup supremum swap length *
-        ] map-with sum +
-    ] [
-        2drop 0
-    ] if ;
-
-: rank-completions ( seq -- seq )
-    [ first zero? not ] subset
-    [ [ first ] 2apply swap - ] sort
-    dup length 20 min head ;
-
-: completion ( str quot obj -- pair )
-    #! pair is { score obj }
-    [ swap call dup rot fuzzy score ] keep 2array ; inline
-
-: completions ( str candidates quot -- seq )
-    pick empty? [
-        3drop f
-    ] [
-        [ >r 2dup r> completion ] map 2nip rank-completions
-    ] if ; inline
-
-: completion. ( score str obj -- )
-    >r [ % " (score: " % >fixnum # ")" % ] "" make r>
-    write-object terpri ; inline
-
-: string-completions ( str strs -- seq )
-    f swap completions ;

diff --git a/library/tools/word-tools.factor b/library/tools/word-tools.factor
index 47ebf1290caad8bd51a9143c47d9d5b7385029c5..600b0940f6bef9e780d05d980fbc05182b26cc0f 100644 (file)
--- a/library/tools/word-tools.factor
+++ b/library/tools/word-tools.factor
@@ -3,7 +3,7 @@
 IN: tools
 USING: arrays definitions hashtables help tools io kernel
 math namespaces prettyprint sequences strings styles words
-generic ;
+generic completion ;
 
 : word-outliner ( seq -- )
     natural-sort [
@@ -48,10 +48,11 @@ generic ;
     ] annotate ;
 
 : word-completion. ( pair -- )
-    first2 [ summary ] keep completion. ;
+    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. ] each ;
+    all-words word-completions
+    [ word-completion. terpri ] each ;

diff --git a/library/ui/load.factor b/library/ui/load.factor
index aa4e9b8b62b7014da5dd6a370ad3cb89411122b6..e533ea55a41a2690293e3f94efe8726a86f0e919 100644 (file)
--- a/library/ui/load.factor
+++ b/library/ui/load.factor
@@ -54,5 +54,6 @@ PROVIDE: library/ui {
     "test/commands.factor"
     "test/panes.factor"
     "test/editor.factor"
+    "test/search.factor"
     "test/tracks.factor"
 } ;

diff --git a/library/ui/test/search.factor b/library/ui/test/search.factor
new file mode 100644 (file)
index 0000000..401eb81
--- /dev/null
+++ b/library/ui/test/search.factor
@@ -0,0 +1,6 @@
+IN: temporary
+USING: gadgets-search io test ;
+
+[ "hey man (score: 123)" ]
+[ [ { "hey man" 123 } file-completion. ] string-out ]
+unit-test

diff --git a/library/ui/tools/search.factor b/library/ui/tools/search.factor
index 1b69e441f955d818df8f3bc63b5f105ee0652f14..d826c887deb9887481af76554791df4072e84531 100644 (file)
--- a/library/ui/tools/search.factor
+++ b/library/ui/tools/search.factor
@@ -4,7 +4,8 @@ IN: gadgets-search
 USING: arrays gadgets gadgets-frames 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 namespaces parser hashtables io
+completion ;
 
 TUPLE: live-search field list model producer action presenter ;
 
@@ -59,7 +60,7 @@ C: live-search ( string action producer presenter -- gadget )
 M: live-search focusable-child* live-search-field ;
 
 : <word-search> ( string action -- gadget )
-    \ second add*
+    \ first add*
     all-words
     [ word-completions ] curry
     [ [ word-completion. ] make-pane ]
@@ -72,10 +73,10 @@ M: live-search focusable-child* live-search-field ;
     <live-search> ;
 
 : file-completion. ( pair -- )
-    first2 dup <pathname> completion. ;
+    first2 over completion>string swap <pathname> write-object ;
 
 : <source-files-search> ( string action -- gadget )
-    \ second add*
+    \ first add*
     source-files get hash-keys natural-sort
     [ string-completions ] curry
     [ [ file-completion. ] make-pane ]