diff --git a/basis/help/search/search.factor b/basis/help/search/search.factor index a2f671c231..0a127b177e 100644 --- a/basis/help/search/search.factor +++ b/basis/help/search/search.factor @@ -1,33 +1,62 @@ ! Copyright (C) 2012 John Benediktsson ! 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 -unicode.categories ; +unicode.categories words ; IN: help.search 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 ] } + { \ $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 ) - (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 search-words + [ [ digit? ] all? not ] filter + [ [ { [ letter? ] [ digit? ] } 1|| not ] trim ] map! 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> -: 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 ;