1 ! Copyright (C) 2005, 2008 Slava Pestov.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors arrays io io.styles kernel namespaces make
4 parser prettyprint sequences words assocs definitions generic
5 quotations effects slots continuations classes.tuple debugger
6 combinators vocabs help.stylesheet help.topics help.crossref
7 help.markup sorting classes vocabs.loader ;
10 GENERIC: word-help* ( word -- content )
12 : word-help ( word -- content )
13 dup "help" word-prop [ ] [
15 [ swap 2array 1array ] [ 2drop f ] if
18 : $predicate ( element -- )
19 { { "object" object } { "?" "a boolean" } } $values
21 "Tests if the object is an instance of the " ,
22 first "predicating" word-prop <$link> ,
24 ] { } make $description ;
26 M: word word-help* drop f ;
28 M: predicate word-help* drop \ $predicate ;
30 : all-articles ( -- seq )
32 all-words [ word-help ] filter append ;
34 : orphan-articles ( -- seq )
36 [ article-parent not ] filter ;
39 all-articles [ xref-article ] each ;
41 : error? ( word -- ? )
42 \ $error-description swap word-help elements empty? not ;
44 : sort-articles ( seq -- newseq )
45 [ dup article-title ] { } map>assoc sort-values keys ;
47 : all-errors ( -- seq )
48 all-words [ error? ] filter sort-articles ;
50 M: word article-name name>> ;
53 dup [ parsing-word? ] [ symbol? ] bi or [
57 [ stack-effect [ effect>string " " prepend ] [ "" ] if* ] bi
63 : (word-help) ( word -- element )
66 [ \ $vocabulary swap 2array , ]
68 [ \ $related swap 2array , ]
69 [ get-global [ \ $value swap 2array , ] when* ]
70 [ \ $definition swap 2array , ]
74 M: word article-content (word-help) ;
78 : word-with-methods ( word -- elements )
81 [ \ $methods swap 2array , ]
87 M: generic article-content word-with-methods ;
89 M: class article-content word-with-methods ;
91 M: word article-parent "help-parent" word-prop ;
93 M: word set-article-parent swap "help-parent" set-word-prop ;
95 : $doc-path ( article -- )
99 "Parent topics: " write $links
104 : $title ( topic -- )
108 dup article-title swap >link write-object
113 : print-topic ( topic -- )
114 last-element off dup $title
115 article-content print-content nl ;
119 help-hook global [ [ print-topic ] or ] change-at
127 "No such vocabulary: " prepend throw
132 "The " write vocab-name write
133 " vocabulary does not define a main help article." print
134 "To define one, refer to \\ ABOUT: help" print
137 : ($index) ( articles -- )
138 sort-articles [ \ $subsection swap 2array ] map print-element ;
140 : $index ( element -- )
141 first call [ ($index) ] unless-empty ;
143 : $about ( element -- )
144 first vocab-help [ 1array $subsection ] when* ;
146 : :help-debugger ( -- )
148 "Debugger commands:" print
150 ":s - data stack at error time" print
151 ":r - retain stack at error time" print
152 ":c - call stack at error time" print
153 ":edit - jump to source location (parse errors only)" print
155 ":get ( var -- value ) accesses variables at time of the error" print
156 ":vars - list all variables at error time" print ;
158 : (:help) ( error -- )
159 error-help [ help ] [ "No help for this error. " print ] if*
165 : remove-article ( name -- )
166 dup articles get key? [
168 dup articles get delete-at
171 : add-article ( article name -- )
172 [ remove-article ] keep
173 [ articles get set-at ] keep
176 : remove-word-help ( word -- )
177 dup word-help [ dup unxref-article ] when
178 f "help" set-word-prop ;
180 : set-word-help ( content word -- )
181 [ remove-word-help ] keep
182 [ swap "help" set-word-prop ] keep