Help pages now have next/prev links

basis/help/crossref/crossref-tests.factor

@@ -13,7 +13,7 @@ io.streams.string continuations debugger compiler.units eval ;
 
 [ t ] [
     "foo" article-children
-    "foo" "help.crossref.tests" lookup 1array sequence=
+    "foo" "help.crossref.tests" lookup >link 1array sequence=
 ] unit-test
 
 [ "foo" ] [ "foo" "help.crossref.tests" lookup article-parent ] unit-test

basis/help/crossref/crossref.factor

@@ -1,17 +1,19 @@
-! Copyright (C) 2005, 2007 Slava Pestov.
+! Copyright (C) 2005, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: arrays definitions generic assocs
+USING: arrays definitions generic assocs math fry
 io kernel namespaces prettyprint prettyprint.sections
 sequences words summary classes help.topics help.markup ;
 IN: help.crossref
 
+: article-links ( topic elements -- seq )
+    [ article-content ] dip
+    collect-elements [ >link ] map ;
+
 : article-children ( topic -- seq )
-    article-content { $subsection } collect-elements ;
+    { $subsection } article-links ;
 
 M: link uses
-    article-content
+    { $subsection $link $see-also } article-links ;
-    { $subsection $link $see-also }
-    collect-elements [ \ f or ] map ;
 
 : help-path ( topic -- seq )
     [ article-parent ] follow rest ;
@@ -24,3 +26,13 @@ M: link uses
 
 : unxref-article ( topic -- )
     >link unxref ;
+
+: prev/next-article ( article n -- article' )
+    [ dup article-parent dup ] dip
+    '[ article-children [ index _ + ] keep ?nth ]
+    [ 2drop f ]
+    if ;
+
+: prev-article ( article -- prev ) -1 prev/next-article ;
+
+: next-article ( article -- next ) 1 prev/next-article ;

basis/help/help.factor

@@ -93,28 +93,32 @@ M: word article-parent "help-parent" word-prop ;
 
 M: word set-article-parent swap "help-parent" set-word-prop ;
 
-: $doc-path ( article -- )
+: ($title) ( topic -- )
-    help-path [
+    [ [ article-title ] [ >link ] bi write-object ] ($block) ;
-        [
+
-            help-path-style get [
+: $navigation-row ( content element label -- )
-                "Parent topics: " write $links
+    [ prefix 1array ] dip prefix , ;
-            ] with-style
+
-        ] ($block)
+: $navigation-table ( topic -- )
-    ] unless-empty ;
+    [
+        [ help-path [ \ $links "Up:" $navigation-row ] unless-empty ]
+        [ prev-article [ 1array \ $long-link "Prev:" $navigation-row ] when* ]
+        [ next-article [ 1array \ $long-link "Next:" $navigation-row ] when* ]
+        tri
+    ] { } make [ $table ] unless-empty ;
 
 : $title ( topic -- )
     title-style get [
         title-style get [
-            dup [
+            [ ($title) ]
-                dup article-title swap >link write-object
+            [ help-path-style get [ $navigation-table ] with-style ] bi
-            ] ($block) $doc-path
         ] with-nesting
     ] with-style nl ;
 
 : print-topic ( topic -- )
     >link
-    last-element off dup $title
+    last-element off
-    article-content print-content nl ;
+    [ $title ] [ article-content print-content nl ] bi ;
 
 SYMBOL: help-hook
 
@@ -125,12 +129,8 @@ help-hook global [ [ print-topic ] or ] change-at
 
 : about ( vocab -- )
     dup require
-    dup vocab [ ] [
+    dup vocab [ ] [ no-vocab ] ?if
-        "No such vocabulary: " prepend throw
+    dup vocab-help [ help ] [
-    ] ?if
-    dup vocab-help [
-        help
-    ] [
         "The " write vocab-name write
         " vocabulary does not define a main help article." print
         "To define one, refer to \\ ABOUT: help" print

basis/help/markup/markup.factor

@@ -2,8 +2,8 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors arrays definitions generic io kernel assocs
 hashtables namespaces make parser prettyprint sequences strings
-io.styles vectors words math sorting splitting classes slots
+io.styles vectors words math sorting splitting classes slots fry
-vocabs help.stylesheet help.topics vocabs.loader quotations ;
+sets vocabs help.stylesheet help.topics vocabs.loader quotations ;
 IN: help.markup
 
 ! Simple markup language.
@@ -157,6 +157,9 @@ ALIAS: $slot $snippet
 : ($long-link) ( object -- )
     [ article-title ] [ >link ] bi write-link ;
 
+: $long-link ( object -- )
+    first ($long-link) ;
+
 : ($subsection) ( element quot -- )
     [
         subsection-style get [
@@ -201,7 +204,7 @@ ALIAS: $slot $snippet
     "See also" $heading $links ;
 
 : related-words ( seq -- )
-    dup [ "related" set-word-prop ] curry each ;
+    dup '[ _ "related" set-word-prop ] each ;
 
 : $related ( element -- )
     first dup "related" word-prop remove
@@ -335,7 +338,8 @@ M: f ($instance)
 
 GENERIC: elements* ( elt-type element -- )
 
-M: simple-element elements* [ elements* ] with each ;
+M: simple-element elements*
+    [ elements* ] with each ;
 
 M: object elements* 2drop ;
 
@@ -346,13 +350,7 @@ M: array elements*
 : elements ( elt-type element -- seq ) [ elements* ] { } make ;
 
 : collect-elements ( element seq -- elements )
-    [
+    swap '[ _ elements [ rest ] map concat ] map concat prune ;
-        swap [
-            elements [
-                rest [ dup set ] each
-            ] each
-        ] curry each
-    ] H{ } make-assoc keys ;
 
 : <$link> ( topic -- element )
     1array \ $link prefix ;

basis/help/topics/topics.factor

@@ -15,6 +15,7 @@ GENERIC: >link ( obj -- obj )
 M: link >link ;
 M: vocab-spec >link ;
 M: object >link link boa ;
+M: f >link drop \ f >link ;
 
 PREDICATE: word-link < link name>> word? ;
 
@@ -73,4 +74,4 @@ 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 ;
-M: f set-article-parent drop \ f set-article-parent ;
+M: f set-article-parent drop \ f set-article-parent ;