FUEL: cool breadcrumb navigation for help pages

extra/fuel/fuel.factor

@@ -108,7 +108,7 @@ PRIVATE>
 
 ! Help support
 
-: fuel-get-article ( name -- ) lookup-article fuel-eval-set-result ;
+: fuel-get-article ( name -- ) fuel.help:get-article fuel-eval-set-result ;
 
 : fuel-get-article-title ( name -- )
     articles get at [ article-title ] [ f ] if* fuel-eval-set-result ;

extra/fuel/help/help-docs.factor

@@ -1,6 +1,10 @@
 USING: fuel.help.private help.markup help.syntax strings ;
 IN: fuel.help
 
+HELP:  get-article
+{ $values { "name" string } { "str" string } }
+{ $description "If an article and a vocab share name, we render the vocab instead." } ;
+
 HELP: find-word
 { $values { "name" string } { "word/f" "word or f" } }
 { $description "Prefer to use search which takes the execution context into account. If that fails, fall back on a search of all words." } ;

extra/fuel/help/help-tests.factor

@@ -1,6 +1,7 @@
 ! Copyright (C) 2009 Jose Antonio Ortega Ruiz.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: fuel.help.private help help.topics sequences tools.test ;
+USING: fuel.help fuel.help.private help help.topics sequences
+tools.test ;
 IN: fuel.help.tests
 
 {
@@ -22,3 +23,8 @@ IN: fuel.help.tests
 } [
     "help.handbook" vocab-describe-words
 ] unit-test
+
+{ f t } [
+    "io" vocab-help-article?
+    "help.lint" vocab-help-article?
+] unit-test

extra/fuel/help/help.factor

@@ -3,10 +3,24 @@
 USING: accessors arrays assocs combinators combinators.short-circuit
 fry help help.crossref help.markup help.markup.private help.topics
 help.vocabs io io.streams.string kernel make namespaces parser
-prettyprint see sequences summary vocabs vocabs.hierarchy
+prettyprint see sequences splitting summary vocabs vocabs.hierarchy
 vocabs.metadata vocabs.parser words ;
 IN: fuel.help
 
+SYMBOLS: $doc-path $next-link $prev-link $fuel-nav-crumbs ;
+
+: common-crumbs ( -- crumbs )
+    { "handbook" "vocab-index" } [ dup article-title \ article 3array ] map ;
+
+: vocab-own-crumbs ( vocab -- crumbs )
+    "." split unclip [
+        [ CHAR: . suffix ] dip append
+    ] accumulate swap suffix
+    [ dup "." split last \ vocab 3array ] map ;
+
+: vocab-crumbs ( vocab -- crumbs )
+    vocab-own-crumbs common-crumbs prepend ;
+
 <PRIVATE
 
 : find-word ( name -- word/f )
@@ -26,8 +40,6 @@ IN: fuel.help
 : parent-topics ( word -- seq )
     help-path [ dup article-title swap 2array ] map ; inline
 
-SYMBOLS: $doc-path $next-link $prev-link ;
-
 : next/prev-link ( link link-symbol -- 3arr )
     swap [ name>> ] [ [ link-long-text ] with-string-writer ] bi 3array ;
 
@@ -35,7 +47,7 @@ SYMBOLS: $doc-path $next-link $prev-link ;
     \ article swap dup article-title swap
     [
         {
-            [ \ $vocabulary swap vocabulary>> 2array , ]
+            [ vocabulary>> vocab-crumbs \ $fuel-nav-crumbs prefix , ]
             [
                 >link
                 [ prev-article [ \ $prev-link next/prev-link , ] when* ]
@@ -82,6 +94,7 @@ SYMBOL: describe-words
     dup require \ article swap dup >vocab-link
     [
         {
+            [ name>> vocab-crumbs but-last \ $fuel-nav-crumbs prefix , ]
             [ vocab-authors [ \ $authors prefix , ] when* ]
             [ vocab-tags [ \ $tags prefix , ] when* ]
             [ summary [ { $heading "Summary" } swap 2array , ] when* ]
@@ -120,3 +133,9 @@ PRIVATE>
 
 : format-index ( seq -- seq )
     [ [ >link name>> ] [ article-title ] bi 2array \ $subsection prefix ] map ;
+
+: vocab-help-article?  ( name -- ? )
+    dup lookup-vocab [ help>> = ] [ drop f ] if* ;
+
+: get-article ( name -- str )
+    dup vocab-help-article? [ vocab-help ] [ lookup-article ] if ;

misc/fuel/fuel-markup.el

@@ -94,7 +94,10 @@
             (button-get button 'markup-label)
             (button-get button 'markup-link-type)))))
 
-
+(defun fuel-markup--nav-crumbs (e)
+  (fuel-markup--links e " > ")
+  (newline))
+
 ;;; Markup printers:
 
 (defconst fuel-markup--printers
@@ -117,12 +120,13 @@
     ($errors . fuel-markup--errors)
     ($example . fuel-markup--example)
     ($examples . fuel-markup--examples)
+    ($fuel-nav-crumbs . fuel-markup--nav-crumbs)
     ($heading . fuel-markup--heading)
     ($index . fuel-markup--index)
     ($instance . fuel-markup--instance)
     ($io-error . fuel-markup--io-error)
     ($link . fuel-markup--link)
-    ($links . fuel-markup--links)
+    ($links . (lambda (e) (fuel-markup--links e ", ")))
     ($list . fuel-markup--list)
     ($low-level-note . fuel-markup--low-level-note)
     ($markup-example . fuel-markup--markup-example)
@@ -166,7 +170,6 @@
     ($vocab-link . fuel-markup--vocab-link)
     ($vocab-links . fuel-markup--vocab-links)
     ($vocab-subsection . fuel-markup--vocab-subsection)
-    ($vocabulary . fuel-markup--vocabulary)
     ($warning . fuel-markup--warning)
     (article . fuel-markup--article)
     (describe-words . fuel-markup--describe-words)
@@ -227,7 +230,7 @@
 (defun fuel-markup--article (e)
   (setq fuel-markup--maybe-nl nil)
   (insert (fuel-markup--put-face (cadr e) 'fuel-font-lock-markup-title))
-  (newline 2)
+  (newline 1)
   (fuel-markup--print (car (cddr e))))
 
 (defun fuel-markup--heading (e)
@@ -338,11 +341,20 @@
                     link)))
     (fuel-markup--insert-button label link type)))
 
-(defun fuel-markup--links (e)
-  (dolist (link (cdr e))
-    (fuel-markup--link (list '$link link))
-    (insert ", "))
-  (delete-char -2))
+(defun fuel-markup--links (e sep)
+  "Inserts a sequence of links. Used for rendering see also lists
+and breadcrumb navigation. The items in e can either be strings
+or lists."
+  (let ((links (cdr e)))
+    (when links
+      (dolist (link links)
+        (message (format "link %s" link))
+        (fuel-markup--link
+         (if (listp link)
+             (cons '$link link)
+           (list '$link link)))
+        (insert sep))
+      (delete-char (- (length sep))))))
 
 (defun fuel-markup--index-quotation (q)
   (cond ((null q) nil)
@@ -386,11 +398,6 @@
          (res (fuel-eval--retort-result (fuel-eval--send/wait cmd))))
     (when res (fuel-markup--print res))))
 
-(defun fuel-markup--vocabulary (e)
-  (fuel-markup--insert-heading "Vocabulary: " t)
-  (fuel-markup--vocab-link (cons '$vocab-link (cdr e)))
-  (newline))
-
 (defun fuel-markup--parse-classes ()
   (let ((elems))
     (while (looking-at ".+ classes$")
@@ -584,11 +591,11 @@ the 'words.' word emits."
 
 (defun fuel-markup--see-also (e)
   (fuel-markup--insert-heading "See also")
-  (fuel-markup--links (cons '$links (cdr e))))
+  (fuel-markup--links (cons '$links (cdr e)) ", "))
 
 (defun fuel-markup--related (e)
   (fuel-markup--insert-heading "See also")
-  (fuel-markup--links (cons '$links (cadr e))))
+  (fuel-markup--links (cons '$links (cadr e)) ", "))
 
 (defun fuel-markup--shuffle (e)
   (insert "\nShuffle word. Re-arranges the stack "