core: subseq-index? -> subseq-of?

[factor.git] / basis / help / search / search.factor

diff --git a/basis/help/search/search.factor b/basis/help/search/search.factor
index a2f671c2316326ef77a3fb629042a9a13f39a87c..7c4a4b10f4fc1dc18a4179e78ec841b16058ae24 100644 (file)
--- a/basis/help/search/search.factor
+++ b/basis/help/search/search.factor
@@ -1,33 +1,61 @@
 ! Copyright (C) 2012 John Benediktsson
 ! See http://factorcode.org/license.txt for BSD license
 
-USING: fry help help.markup help.topics io kernel memoize
-sequences sequences.deep sorting splitting strings unicode.case
-unicode.categories ;
+USING: arrays combinators combinators.short-circuit help
+help.apropos help.markup help.stylesheet help.topics io
+io.styles kernel math namespaces sequences sorting splitting
+strings unicode words ;
 
 IN: help.search
 
 <PRIVATE
 
-: (article-words) ( name -- words )
-    article-content [ string? ] filter
-    [ >lower [ blank? ] split-when ] map concat
-    [ CHAR: - over member? [ "-" split ] when ] map
-    flatten harvest ;
+: search-words ( str -- seq )
+    >lower "-" split [ [ blank? ] split-when ] map concat ;
+
+: element-value ( element -- str )
+    dup array? [
+        dup ?first {
+            { \ $link [ second article-name ] }
+            { \ $vocab-link [ second ] }
+            { \ $emphasis [ second ] }
+            { \ $subsection [ second article-name ] }
+            { \ $subsections [ rest [ article-name ] map join-words ] }
+            { \ $description [ rest [ element-value ] map join-words ] }
+            { \ $notes [ rest [ element-value ] map join-words ] }
+            { \ $snippet [ rest [ element-value ] map join-words ] }
+            [ 2drop f ]
+        } case
+    ] [ dup string? [ drop f ] unless ] if ;
 
 MEMO: article-words ( name -- words )
-    (article-words) [
-        dup [ letter? not ] any? [
-            [ [ letter? ] [ digit? ] bi or not ] split-when
-        ] when
-    ] map flatten [ [ digit? ] all? not ] filter harvest ;
+    article-content [ element-value ] map join-words search-words
+    [ [ digit? ] all? ] reject
+    [ [ { [ letter? ] [ digit? ] } 1|| not ] trim ] map! harvest  ;
+
+: (search-articles) ( string -- seq' )
+    search-words [ { } ] [
+        [ all-articles ] dip
+        dup length 1 > [
+            '[ article-words _ subseq-of? ] filter
+        ] [
+            first '[ article-words [ _ head? ] any? ] filter
+        ] if
+    ] if-empty [ article-name ] sort-with ;
 
 PRIVATE>
 
-: search-docs ( string -- seq' )
-    [ all-articles ] dip >lower [ blank? ] split-when
-    '[ article-words [ _ member? ] any? ] filter
-    [ article-name ] sort-with ;
-
-: search-docs. ( string -- )
-    search-docs [ ($link) nl ] each ;
+: search-articles ( string -- )
+    [
+        last-element off
+        [
+            "Search results for “" "”" surround
+            title-style get [ format ] ($block)
+        ]
+        [
+            (search-articles) [ word? ] partition swap
+            "Articles" "Words"
+            [ over empty? [ 2drop ] [ $heading $completions ] if ]
+            bi-curry@ bi*
+        ] bi
+    ] with-default-style nl ;