steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

help.search: bit faster, allow searching for things like "first2", formatted output, and allow both phrase and starts-with searching.

db4
John Benediktsson 2012-07-31 14:23:18 -07:00
parent 2b03973a7b
commit 692ae29078
1 changed files with 48 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

67
basis/help/search/search.factor
View File

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