1 ! Copyright (C) 2008, 2010 Slava Pestov.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors arrays assocs fry help.markup help.topics io
4 kernel make math math.parser namespaces sequences sorting
5 summary tools.completion vocabs.hierarchy help.vocabs
6 vocabs words unicode help combinators locals ;
9 : $completions ( seq -- )
10 dup [ word? ] all? [ words-table ] [
11 dup [ vocab-spec? ] all? [
14 [ <$pretty-link> 1array ] map $table
18 SYMBOLS: word-result vocabulary-result article-result ;
20 : category>title ( category -- name )
22 { word-result [ "Words" ] }
23 { vocabulary-result [ "Vocabularies" ] }
24 { article-result [ "Help articles" ] }
27 : category>name ( category -- name )
29 { word-result [ "word" ] }
30 { vocabulary-result [ "vocabulary" ] }
31 { article-result [ "help article" ] }
34 TUPLE: more-completions seq search category ;
36 CONSTANT: max-completions 5
38 M: more-completions valid-article? drop t ;
40 M: more-completions article-title
43 [ seq>> length # " " % ]
44 [ category>> category>name % ]
45 [ " results for “" % search>> % "”" % ] tri
48 M: more-completions article-content
49 seq>> [ second >lower ] sort-with keys \ $completions prefix ;
51 :: (apropos) ( search completions category -- element )
55 [ max-completions cramp head keys \ $completions prefix , ]
57 length max-completions >
58 [ { $link T{ more-completions f completions search category } } , ] when
63 : articles-matching ( str -- seq )
65 [ [ >link ] [ title>> ] bi* ] { } assoc-map-as
70 [ dup words-matching word-result (apropos) ]
71 [ dup vocabs-matching vocabulary-result (apropos) ]
72 [ dup articles-matching article-result (apropos) ]
73 tri 3array print-element ;
75 TUPLE: apropos-search text ;
77 C: <apropos-search> apropos-search
79 M: apropos-search valid-article? drop t ;
81 M: apropos-search article-title
82 text>> "Search results for “" "”" surround ;
84 M: apropos-search article-content
85 text>> 1array \ $apropos prefix ;
87 M: apropos-search >link ;
89 INSTANCE: apropos-search topic
92 [ unicode:blank? ] trim <apropos-search> print-topic ;