Display articles in history better. Fixes issue #29.
Define a default method on article-name to call article-title.db4
parent
003271f2b8
commit
dd824bf0e5
|
@ -3,7 +3,8 @@
|
|||
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 -- )
|
||||
|
@ -15,28 +16,48 @@ IN: help.apropos
|
|||
] 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 ;
|
||||
|
||||
|
@ -47,9 +68,9 @@ M: more-completions article-content
|
|||
|
||||
: $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 ;
|
||||
|
@ -61,8 +82,6 @@ M: apropos valid-article? drop t ;
|
|||
M: apropos article-title
|
||||
search>> "Search results for “" "”" surround ;
|
||||
|
||||
M: apropos article-name article-title ;
|
||||
|
||||
M: apropos article-content
|
||||
search>> 1array \ $apropos prefix ;
|
||||
|
||||
|
|
|
@ -39,19 +39,20 @@ SYMBOL: article-xref
|
|||
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>> ;
|
||||
|
||||
|
@ -64,14 +65,12 @@ M: no-article summary
|
|||
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 ;
|
||||
|
@ -79,7 +78,6 @@ M: link set-article-parent name>> set-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 ;
|
||||
|
|
Loading…
Reference in New Issue