Display articles in history better. Fixes issue #29.

Define a default method on article-name to call article-title.
db4
Doug Coleman 2011-09-08 18:18:47 -07:00
parent 003271f2b8
commit dd824bf0e5
2 changed files with 40 additions and 23 deletions

View File

@ -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 ;

View File

@ -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 ;