From dd824bf0e5465e149cedf03cfd1392f1292a50e1 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Thu, 8 Sep 2011 18:18:47 -0700
Subject: [PATCH] Display articles in history better. Fixes issue #29. Define a
 default method on article-name to call article-title.

---
 basis/help/apropos/apropos.factor | 55 +++++++++++++++++++++----------
 basis/help/topics/topics.factor   |  8 ++---
 2 files changed, 40 insertions(+), 23 deletions(-)

diff --git a/basis/help/apropos/apropos.factor b/basis/help/apropos/apropos.factor
index 0d40122088..a5b09188ba 100644
--- a/basis/help/apropos/apropos.factor
+++ b/basis/help/apropos/apropos.factor
@@ -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 ;
 
diff --git a/basis/help/topics/topics.factor b/basis/help/topics/topics.factor
index ea39818485..d12138ea3e 100644
--- a/basis/help/topics/topics.factor
+++ b/basis/help/topics/topics.factor
@@ -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 ;