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
|
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 ;
|
||||||
|
|
||||||
|
|
|
@ -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 ;
|
||||||
|
|
Loading…
Reference in New Issue