1 ! Copyright (C) 2012 John Benediktsson
2 ! See http://factorcode.org/license.txt for BSD license
4 USING: arrays assocs combinators combinators.short-circuit fry
5 help help.apropos help.markup help.stylesheet help.topics io
6 io.streams.string io.styles kernel math memoize namespaces
7 sequences sequences.deep sorting splitting strings unicode
14 : search-words ( str -- seq )
15 >lower "-" split [ [ blank? ] split-when ] map concat ;
17 : element-value ( element -- str )
20 { \ $link [ second article-name ] }
21 { \ $vocab-link [ second ] }
22 { \ $emphasis [ second ] }
23 { \ $subsection [ second article-name ] }
24 { \ $subsections [ rest [ article-name ] map unwords ] }
25 { \ $description [ rest [ element-value ] map unwords ] }
26 { \ $notes [ rest [ element-value ] map unwords ] }
27 { \ $snippet [ rest [ element-value ] map unwords ] }
30 ] [ dup string? [ drop f ] unless ] if ;
32 MEMO: article-words ( name -- words )
33 article-content [ element-value ] map unwords search-words
34 [ [ digit? ] all? ] reject
35 [ [ { [ letter? ] [ digit? ] } 1|| not ] trim ] map! harvest ;
37 : (search-articles) ( string -- seq' )
38 search-words [ { } ] [
41 '[ article-words _ swap subseq? ] filter
43 first '[ article-words [ _ head? ] any? ] filter
45 ] if-empty [ article-name ] sort-with ;
49 : search-articles ( string -- )
53 "Search results for “" "”" surround
54 title-style get [ format ] ($block)
57 (search-articles) [ word? ] partition swap
59 [ over empty? [ 2drop ] [ $heading $completions ] if ]
62 ] with-default-style nl ;