Various help system refactorings
slava
parent
f3d93496b7
commit
f18c2c7cec
|
|
@ -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"
|
||||
|
|
|
|||
|
|
@ -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 ;
|
||||
|
|
@ -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." } ;
|
||||
|
|
@ -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 [
|
||||
|
|
|
|||
|
|
@ -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 } "." }
|
||||
|
|
|
|||
|
|
@ -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 [
|
||||
|
|
|
|||
|
|
@ -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 -- )
|
||||
<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 ;
|
||||
|
|
|
|||
|
|
@ -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." } ;
|
||||
|
|
|
|||
Loading…
Reference in New Issue