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 USING: accessors arrays assocs fry help.markup help.topics io
kernel make math math.parser namespaces sequences sorting kernel make math math.parser namespaces sequences sorting
summary tools.completion vocabs.hierarchy help.vocabs 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 IN: help.apropos
: $completions ( seq -- ) : $completions ( seq -- )
@ -15,28 +16,48 @@ IN: help.apropos
] if ] if
] 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 CONSTANT: max-completions 5
M: more-completions valid-article? drop t ; M: more-completions valid-article? drop t ;
M: more-completions article-title M: more-completions article-title
seq>> length number>string " results" append ; [
"All " %
M: more-completions article-name [ seq>> length # " " % ]
seq>> length max-completions - number>string " more results" append ; [ category>> category>name % ]
[ " results for “" % search>> % "”" % ] tri
] "" make ;
M: more-completions article-content M: more-completions article-content
seq>> [ second >lower ] sort-with keys \ $completions prefix ; seq>> [ second >lower ] sort-with keys \ $completions prefix ;
: (apropos) ( completions title -- element ) :: (apropos) ( search completions category -- element )
[ completions [
'[ [
_ 1array \ $heading prefix , { $heading search } ,
[ max-completions short head keys \ $completions prefix , ] [ 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 ] unless-empty
] { } make ; ] { } make ;
@ -47,9 +68,9 @@ M: more-completions article-content
: $apropos ( str -- ) : $apropos ( str -- )
first first
[ words-matching "Words" (apropos) ] [ dup words-matching word-result (apropos) ]
[ vocabs-matching "Vocabularies" (apropos) ] [ dup vocabs-matching vocabulary-result (apropos) ]
[ articles-matching "Help articles" (apropos) ] [ dup articles-matching article-result (apropos) ]
tri 3array print-element ; tri 3array print-element ;
TUPLE: apropos search ; TUPLE: apropos search ;
@ -61,8 +82,6 @@ M: apropos valid-article? drop t ;
M: apropos article-title M: apropos article-title
search>> "Search results for “" "”" surround ; search>> "Search results for “" "”" surround ;
M: apropos article-name article-title ;
M: apropos article-content M: apropos article-content
search>> 1array \ $apropos prefix ; search>> 1array \ $apropos prefix ;

View File

@ -39,19 +39,20 @@ SYMBOL: article-xref
article-xref [ H{ } clone ] initialize article-xref [ H{ } clone ] initialize
GENERIC: valid-article? ( topic -- ? ) GENERIC: valid-article? ( topic -- ? )
GENERIC: article-name ( topic -- string )
GENERIC: article-title ( topic -- string ) GENERIC: article-title ( topic -- string )
GENERIC: article-name ( topic -- string )
GENERIC: article-content ( topic -- content ) GENERIC: article-content ( topic -- content )
GENERIC: article-parent ( topic -- parent ) GENERIC: article-parent ( topic -- parent )
GENERIC: set-article-parent ( parent topic -- ) GENERIC: set-article-parent ( parent topic -- )
M: object article-name article-title ;
TUPLE: article title content loc ; TUPLE: article title content loc ;
: <article> ( title content -- article ) : <article> ( title content -- article )
f \ article boa ; f \ article boa ;
M: article valid-article? drop t ; M: article valid-article? drop t ;
M: article article-name title>> ;
M: article article-title title>> ; M: article article-title title>> ;
M: article article-content content>> ; M: article article-content content>> ;
@ -64,14 +65,12 @@ M: no-article summary
articles get ?at [ no-article ] unless ; articles get ?at [ no-article ] unless ;
M: object valid-article? articles get key? ; M: object valid-article? articles get key? ;
M: object article-name article article-name ;
M: object article-title article article-title ; M: object article-title article article-title ;
M: object article-content article article-content ; M: object article-content article article-content ;
M: object article-parent article-xref get at ; M: object article-parent article-xref get at ;
M: object set-article-parent article-xref get set-at ; M: object set-article-parent article-xref get set-at ;
M: link valid-article? name>> valid-article? ; M: link valid-article? name>> valid-article? ;
M: link article-name name>> article-name ;
M: link article-title name>> article-title ; M: link article-title name>> article-title ;
M: link article-content name>> article-content ; M: link article-content name>> article-content ;
M: link article-parent name>> article-parent ; M: link article-parent name>> article-parent ;
@ -79,7 +78,6 @@ M: link set-article-parent name>> set-article-parent ;
! Special case: f help ! Special case: f help
M: f valid-article? drop t ; 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-title drop \ f article-title ;
M: f article-content drop \ f article-content ; M: f article-content drop \ f article-content ;
M: f article-parent drop \ f article-parent ; M: f article-parent drop \ f article-parent ;