Various help system refactorings

library/bootstrap/boot-stage1.factor

@@ -101,7 +101,6 @@ sequences vectors words ;
         "/library/help/stylesheet.factor"
         "/library/help/topics.factor"
         "/library/help/markup.factor"
-        "/library/help/crossref.factor"
         "/library/help/help.factor"
         "/library/help/porter-stemmer.factor"
         "/library/help/search.factor"
@@ -247,7 +246,6 @@ sequences vectors words ;
         "/library/generic/slots.facts"
         "/library/generic/standard-combination.facts"
         "/library/generic/tuple.facts"
-        "/library/help/crossref.facts"
         "/library/help/help.facts"
         "/library/help/markup.facts"
         "/library/help/search.facts"

library/help/crossref.factor

@@ -1,66 +0,0 @@
-! Copyright (C) 2006 Slava Pestov.
-! See http://factorcode.org/license.txt for BSD license.
-IN: help
-USING: arrays generic graphs hashtables io kernel
-namespaces sequences strings words ;
-
-: all-articles ( -- seq )
-    articles get hash-keys all-words append ;
-
-GENERIC: elements* ( elt-type element -- )
-
-M: simple-element elements* [ elements* ] each-with ;
-
-M: object elements* 2drop ;
-
-M: array elements*
-    [ [ elements* ] each-with ] 2keep
-    [ first eq? ] keep swap [ , ] [ drop ] if ;
-
-: elements ( elt-type element -- seq ) [ elements* ] { } make ;
-
-: collect-elements ( element seq -- elements )
-    [
-        [
-            swap elements [
-                1 swap tail [ dup set ] each
-            ] each
-        ] each-with
-    ] make-hash hash-keys ;
-
-SYMBOL: parent-graph
-
-DEFER: $subsection
-
-: children ( article -- seq )
-    article-content { $subsection } collect-elements ;
-
-: parents ( article -- seq )
-    dup link? [ link-name ] when parent-graph get in-edges ;
-
-: (where) ( article -- )
-    dup , parents [ word? not ] subset dup empty?
-    [ drop ] [ [ (where) ] each ] if ;
-
-: where ( article -- seq )
-    [ (where) ] { } make 1 swap tail prune ;
-
-: $where ( article -- )
-    where dup empty? [
-        drop
-    ] [
-        [
-            where-style [
-                "Parent topics: " write $links
-            ] with-style
-        ] ($block)
-    ] if ;
-
-: xref-article ( article -- )
-    [ children ] parent-graph get add-vertex ;
-
-: unxref-article ( article -- )
-    [ children ] parent-graph get remove-vertex ;
-
-: xref-articles ( -- )
-    all-articles [ children ] parent-graph get build-graph ;

library/help/crossref.facts

@@ -1,46 +0,0 @@
-IN: help
-
-HELP: all-articles "( -- seq )"
-{ $values { "seq" "a sequence" } }
-{ $description "Outputs a sequence of all help article names, and all words with documentation." } ;
-
-HELP: elements "( elt-type element -- seq )"
-{ $values { "elt-type" "a word" } { "element" "a markup element" } { "seq" "a new sequence" } }
-{ $description "Outputs a sequence of all elements of type " { $snippet "elt-type" } " found by traversing " { $snippet "element" } "." } ;
-
-HELP: collect-elements "( element seq -- )"
-{ $values { "element" "a markup element" } { "seq" "a sequence of words" } { "elements" "a new sequence" } }
-{ $description "Collects the arguments of all sub-elements of " { $snippet "element" } " whose markup element type occurs in " { $snippet "seq" } "." }
-{ $notes "Used to implement " { $link children } "." } ;
-
-HELP: parent-graph f
-{ $description "Variable. A graph whose vertices are help articles and edges are subsections. See " { $link "graphs" } "." }
-{ $see-also children parents xref-articles } ;
-
-HELP: children "( topic -- seq )"
-{ $values { "topic" "an article name or a word" } { "seq" "a new sequence" } }
-{ $description "Outputs a sequence of all subsections of " { $snippet "topic" } "." } ;
-
-HELP: parents "( topic -- seq )"
-{ $values { "topic" "an article name or a word" } { "seq" "a new sequence" } }
-{ $description "Outputs a sequence of all help articles which contain " { $snippet "topic" } " as a subsection." } ;
-
-HELP: where "( topic -- seq )"
-{ $values { "topic" "an article name or a word" } { "seq" "a new sequence" } }
-{ $description "Outputs a sequence of all help articles which contain " { $snippet "topic" } " as a subsection, traversing all the way up to the root." }
-{ $examples
-    { $example "\"sequences\" where ." "{ \"collections\" \"handbook\" }" }
-} ;
-
-HELP: xref-article "( topic -- )"
-{ $values { "topic" "an article name or a word" } }
-{ $description "Adds an article to the " { $link parent-graph } " graph." }
-$low-level-note ;
-
-HELP: unxref-article "( topic -- )"
-{ $values { "topic" "an article name or a word" } }
-{ $description "Removes an article to the " { $link parent-graph } " graph." }
-$low-level-note ;
-
-HELP: xref-articles "( -- )"
-{ $description "Update the " { $link parent-graph } ". Usually this is done automatically." } ;

library/help/markup.factor

@@ -12,6 +12,17 @@ IN: help
 
 ! Element types are words whose name begins with $.
 
+PREDICATE: array simple-element
+    dup empty? [ drop t ] [ first word? not ] if ;
+
+M: simple-element elements* [ elements* ] each-with ;
+
+M: object elements* 2drop ;
+
+M: array elements*
+    [ [ elements* ] each-with ] 2keep
+    [ first eq? ] keep swap [ , ] [ drop ] if ;
+
 SYMBOL: last-element
 SYMBOL: span
 SYMBOL: block
@@ -25,9 +36,6 @@ SYMBOL: table
     span last-element set
     call ; inline
 
-PREDICATE: array simple-element
-    dup empty? [ drop t ] [ first word? not ] if ;
-
 M: simple-element print-element [ print-element ] each ;
 M: string print-element [ write ] ($span) ;
 M: array print-element unclip execute ;
@@ -112,8 +120,6 @@ M: word print-element { } swap execute ;
     ] ($heading) ;
 
 ! Some links
-TUPLE: link name ;
-
 M: link article-title link-name article-title ;
 M: link article-content link-name article-content ;
 M: link summary "Link: " swap link-name append ;
@@ -140,6 +146,17 @@ M: link summary "Link: " swap link-name append ;
 : $see-also ( content -- )
     "See also" $heading $links ;
 
+: $where ( article -- )
+    where dup empty? [
+        drop
+    ] [
+        [
+            where-style [
+                "Parent topics: " write $links
+            ] with-style
+        ] ($block)
+    ] if ;
+
 : $table ( content -- )
     [
         table-style [

library/help/markup.facts

@@ -12,13 +12,6 @@ HELP: ($block) "( quot -- )"
 { $values { "quot" "a quotation" } }
 { $description "Prints a block markup element with newlines before and after." } ;
 
-HELP: $title "( element -- )"
-{ $values { "element" "a markup element" } }
-{ $description "Prints a markup element, usually a string, as a block with the " { $link title-style } "." }
-{ $examples
-    { $markup-example { $title "Fermat's Last Theorem" } }
-} ;
-
 HELP: $heading "( element -- )"
 { $values { "element" "a markup element" } }
 { $description "Prints a markup element, usually a string, as a block with the " { $link heading-style } "." }

library/help/search.factor

@@ -47,6 +47,9 @@ SYMBOL: term-index
     [ all-articles [ index-article ] each ] make-hash
     term-index set-global ;
 
+: add-article ( name title element -- )
+    (add-article) ;
+
 : search-help. ( phrase -- )
     "Search results for ``" write dup write "'':" print
     search-help [

library/help/topics.factor

@@ -1,8 +1,8 @@
 ! Copyright (C) 2005, 2006 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 IN: help
-USING: arrays errors hashtables io kernel namespaces sequences
+USING: arrays errors graphs hashtables io kernel namespaces
-strings ;
+sequences strings words ;
 
 ! Markup
 GENERIC: print-element
@@ -16,7 +16,7 @@ TUPLE: article title content ;
     dup articles get hash
     [ ] [ "No such article: " swap append throw ] ?if ;
 
-: add-article ( name title element -- )
+: (add-article) ( name title element -- )
     <article> swap articles get set-hash ;
 
 M: string article-title article article-title ;
@@ -25,3 +25,47 @@ M: string article-content article article-content ;
 ! Special case: f help
 M: f article-title drop \ f article-title ;
 M: f article-content drop \ f article-content ;
+
+TUPLE: link name ;
+
+: all-articles ( -- seq )
+    articles get hash-keys all-words append ;
+
+GENERIC: elements* ( elt-type element -- )
+
+: elements ( elt-type element -- seq ) [ elements* ] { } make ;
+
+: collect-elements ( element seq -- elements )
+    [
+        [
+            swap elements [
+                1 swap tail [ dup set ] each
+            ] each
+        ] each-with
+    ] make-hash hash-keys ;
+
+SYMBOL: parent-graph
+
+DEFER: $subsection
+
+: children ( article -- seq )
+    article-content { $subsection } collect-elements ;
+
+: parents ( article -- seq )
+    dup link? [ link-name ] when parent-graph get in-edges ;
+
+: (where) ( article -- )
+    dup , parents [ word? not ] subset dup empty?
+    [ drop ] [ [ (where) ] each ] if ;
+
+: where ( article -- seq )
+    [ (where) ] { } make 1 swap tail prune ;
+
+: xref-article ( article -- )
+    [ children ] parent-graph get add-vertex ;
+
+: unxref-article ( article -- )
+    [ children ] parent-graph get remove-vertex ;
+
+: xref-articles ( -- )
+    all-articles [ children ] parent-graph get build-graph ;

library/help/topics.facts

@@ -20,7 +20,52 @@ HELP: article-content "( topic -- element )"
 { $values { "topic" "an article name or a word" } { "element" "a markup element" } }
 { $description "Outputs the content of a specific help article." } ;
 
-HELP: add-article "( name title element -- )"
+HELP: (add-article) "( name title element -- )"
 { $values { "name" "a string" } { "title" "a string" } { "element" "a markup element" } }
 { $description "Adds a help article to the " { $link articles } " hashtable." }
 { $notes "This word is used to implement " { $link POSTPONE: ARTICLE: } "." } ;
+
+HELP: all-articles "( -- seq )"
+{ $values { "seq" "a sequence" } }
+{ $description "Outputs a sequence of all help article names, and all words with documentation." } ;
+
+HELP: elements "( elt-type element -- seq )"
+{ $values { "elt-type" "a word" } { "element" "a markup element" } { "seq" "a new sequence" } }
+{ $description "Outputs a sequence of all elements of type " { $snippet "elt-type" } " found by traversing " { $snippet "element" } "." } ;
+
+HELP: collect-elements "( element seq -- )"
+{ $values { "element" "a markup element" } { "seq" "a sequence of words" } { "elements" "a new sequence" } }
+{ $description "Collects the arguments of all sub-elements of " { $snippet "element" } " whose markup element type occurs in " { $snippet "seq" } "." }
+{ $notes "Used to implement " { $link children } "." } ;
+
+HELP: parent-graph f
+{ $description "Variable. A graph whose vertices are help articles and edges are subsections. See " { $link "graphs" } "." }
+{ $see-also children parents xref-articles } ;
+
+HELP: children "( topic -- seq )"
+{ $values { "topic" "an article name or a word" } { "seq" "a new sequence" } }
+{ $description "Outputs a sequence of all subsections of " { $snippet "topic" } "." } ;
+
+HELP: parents "( topic -- seq )"
+{ $values { "topic" "an article name or a word" } { "seq" "a new sequence" } }
+{ $description "Outputs a sequence of all help articles which contain " { $snippet "topic" } " as a subsection." } ;
+
+HELP: where "( topic -- seq )"
+{ $values { "topic" "an article name or a word" } { "seq" "a new sequence" } }
+{ $description "Outputs a sequence of all help articles which contain " { $snippet "topic" } " as a subsection, traversing all the way up to the root." }
+{ $examples
+    { $example "\"sequences\" where ." "{ \"collections\" \"handbook\" }" }
+} ;
+
+HELP: xref-article "( topic -- )"
+{ $values { "topic" "an article name or a word" } }
+{ $description "Adds an article to the " { $link parent-graph } " graph." }
+$low-level-note ;
+
+HELP: unxref-article "( topic -- )"
+{ $values { "topic" "an article name or a word" } }
+{ $description "Removes an article to the " { $link parent-graph } " graph." }
+$low-level-note ;
+
+HELP: xref-articles "( -- )"
+{ $description "Update the " { $link parent-graph } ". Usually this is done automatically." } ;