USING: accessors arrays assocs fry help.markup help.topics io
kernel make math math.parser namespaces sequences sorting
summary tools.completion vocabs.hierarchy help.vocabs
-vocabs words unicode.case help unicode.categories ;
+vocabs words unicode.case help unicode.categories
+combinators locals ;
IN: help.apropos
: $completions ( seq -- )
] if
] if ;
-TUPLE: more-completions seq ;
+SYMBOLS: word-result vocabulary-result article-result ;
+
+: category>title ( category -- name )
+ {
+ { word-result [ "Words" ] }
+ { vocabulary-result [ "Vocabularies" ] }
+ { article-result [ "Help articles" ] }
+ } case ;
+
+: category>name ( category -- name )
+ {
+ { word-result [ "word" ] }
+ { vocabulary-result [ "vocabulary" ] }
+ { article-result [ "help article" ] }
+ } case ;
+
+TUPLE: more-completions seq search category ;
CONSTANT: max-completions 5
M: more-completions valid-article? drop t ;
M: more-completions article-title
- seq>> length number>string " results" append ;
-
-M: more-completions article-name
- seq>> length max-completions - number>string " more results" append ;
-
+ [
+ "All " %
+ [ seq>> length # " " % ]
+ [ category>> category>name % ]
+ [ " results for “" % search>> % "”" % ] tri
+ ] "" make ;
+
M: more-completions article-content
seq>> [ second >lower ] sort-with keys \ $completions prefix ;
-: (apropos) ( completions title -- element )
- [
- '[
- _ 1array \ $heading prefix ,
+:: (apropos) ( search completions category -- element )
+ completions [
+ [
+ { $heading search } ,
[ max-completions short head keys \ $completions prefix , ]
- [ dup length max-completions > [ more-completions boa <$link> , ] [ drop ] if ]
- bi
+ [
+ length max-completions >
+ [ { $link T{ more-completions f completions search category } } , ] when
+ ] bi
] unless-empty
] { } make ;
: $apropos ( str -- )
first
- [ words-matching "Words" (apropos) ]
- [ vocabs-matching "Vocabularies" (apropos) ]
- [ articles-matching "Help articles" (apropos) ]
+ [ dup words-matching word-result (apropos) ]
+ [ dup vocabs-matching vocabulary-result (apropos) ]
+ [ dup articles-matching article-result (apropos) ]
tri 3array print-element ;
TUPLE: apropos search ;
M: apropos article-title
search>> "Search results for “" "”" surround ;
-M: apropos article-name article-title ;
-
M: apropos article-content
search>> 1array \ $apropos prefix ;
article-xref [ H{ } clone ] initialize
GENERIC: valid-article? ( topic -- ? )
-GENERIC: article-name ( topic -- string )
GENERIC: article-title ( topic -- string )
+GENERIC: article-name ( topic -- string )
GENERIC: article-content ( topic -- content )
GENERIC: article-parent ( topic -- parent )
GENERIC: set-article-parent ( parent topic -- )
+M: object article-name article-title ;
+
TUPLE: article title content loc ;
: <article> ( title content -- article )
f \ article boa ;
M: article valid-article? drop t ;
-M: article article-name title>> ;
M: article article-title title>> ;
M: article article-content content>> ;
articles get ?at [ no-article ] unless ;
M: object valid-article? articles get key? ;
-M: object article-name article article-name ;
M: object article-title article article-title ;
M: object article-content article article-content ;
M: object article-parent article-xref get at ;
M: object set-article-parent article-xref get set-at ;
M: link valid-article? name>> valid-article? ;
-M: link article-name name>> article-name ;
M: link article-title name>> article-title ;
M: link article-content name>> article-content ;
M: link article-parent name>> article-parent ;
! Special case: f help
M: f valid-article? drop t ;
-M: f article-name drop \ f article-name ;
M: f article-title drop \ f article-title ;
M: f article-content drop \ f article-content ;
M: f article-parent drop \ f article-parent ;