From f18c2c7cec502476a4a3b845d17430b54369d5f0 Mon Sep 17 00:00:00 2001 From: slava Date: Thu, 22 Jun 2006 05:57:43 +0000 Subject: [PATCH] Various help system refactorings --- library/bootstrap/boot-stage1.factor | 2 - library/help/crossref.factor | 66 ---------------------------- library/help/crossref.facts | 46 ------------------- library/help/markup.factor | 27 +++++++++--- library/help/markup.facts | 7 --- library/help/search.factor | 3 ++ library/help/topics.factor | 50 +++++++++++++++++++-- library/help/topics.facts | 47 +++++++++++++++++++- 8 files changed, 118 insertions(+), 130 deletions(-) delete mode 100644 library/help/crossref.factor delete mode 100644 library/help/crossref.facts diff --git a/library/bootstrap/boot-stage1.factor b/library/bootstrap/boot-stage1.factor index 5586daf68f..684d20db34 100644 --- a/library/bootstrap/boot-stage1.factor +++ b/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" diff --git a/library/help/crossref.factor b/library/help/crossref.factor deleted file mode 100644 index 7f68d34d2d..0000000000 --- a/library/help/crossref.factor +++ /dev/null @@ -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 ; diff --git a/library/help/crossref.facts b/library/help/crossref.facts deleted file mode 100644 index 45066a3503..0000000000 --- a/library/help/crossref.facts +++ /dev/null @@ -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." } ; diff --git a/library/help/markup.factor b/library/help/markup.factor index 6fbbd3819b..f4a6fc16dc 100644 --- a/library/help/markup.factor +++ b/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 [ diff --git a/library/help/markup.facts b/library/help/markup.facts index de626606fc..e81e136b6d 100644 --- a/library/help/markup.facts +++ b/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 } "." } diff --git a/library/help/search.factor b/library/help/search.factor index 32266b2f04..58940590a4 100644 --- a/library/help/search.factor +++ b/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 [ diff --git a/library/help/topics.factor b/library/help/topics.factor index 5f35c0e422..008c4c589d 100644 --- a/library/help/topics.factor +++ b/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 -strings ; +USING: arrays errors graphs hashtables io kernel namespaces +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 -- )
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 ; diff --git a/library/help/topics.facts b/library/help/topics.facts index 2059b7d405..227d7dbd16 100644 --- a/library/help/topics.facts +++ b/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." } ;