1 ! Copyright (C) 2005, 2010 Slava Pestov.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors arrays assocs classes classes.error combinators
4 combinators.short-circuit continuations debugger effects fry
5 generic help.crossref help.markup help.stylesheet help.topics io
6 io.styles kernel make namespaces prettyprint sequences sets
7 sorting vocabs words words.alias words.symbol ;
10 GENERIC: word-help* ( word -- content )
14 : inputs-and-outputs ( content word -- content' word )
15 over [ dup array? [ { $values } head? ] [ drop f ] if ] find drop [
16 '[ _ cut unclip rest ] dip [
17 stack-effect [ in>> ] [ out>> ] bi
18 [ [ dup pair? [ first ] when ] map ] bi@
19 [ '[ ?first _ member? ] filter ] bi-curry@
21 [ '[ @ _ prefix ] ] bi-curry@ bi* bi
28 : word-help ( word -- content )
29 [ dup "help" word-prop [ ] [ word-help* ] ?if ]
30 [ inputs-and-outputs drop ] bi ;
32 : effect-help ( effect -- content )
33 [ in>> ] [ out>> ] bi [
36 first2 dup effect? [ \ $quotation swap 2array ] when
39 ] if [ effect>string ] dip
41 ] bi@ \ $inputs \ $outputs [ prefix ] bi-curry@ bi* 2array ;
43 M: word word-help* stack-effect effect-help ;
45 : $predicate ( element -- )
46 { { "object" object } { "?" boolean } } $values
48 "Tests if the object is an instance of the " ,
49 first "predicating" word-prop <$link> ,
51 ] { } make $description ;
53 M: predicate word-help* \ $predicate swap 2array 1array ;
55 M: class word-help* drop f ;
60 "An alias for " , def>> first <$link> , "." ,
63 : all-articles ( -- seq )
65 all-words [ word-help ] filter append ;
67 : orphan-articles ( -- seq )
68 articles get keys [ article-parent ] reject
69 { "help.home" "handbook" } diff ;
72 all-articles [ xref-article ] each ;
74 : error? ( word -- ? )
77 [ \ $error-description swap word-help elements empty? not ]
80 : sort-articles ( seq -- newseq )
81 [ article-title ] zip-with sort-values keys ;
83 : all-errors ( -- seq )
84 all-words [ error? ] filter sort-articles ;
86 M: word valid-article? drop t ;
88 M: word article-name name>> ;
91 dup [ parsing-word? ] [ symbol? ] bi or [
95 [ stack-effect [ effect>string " " prepend ] [ "" ] if* ] bi
101 : (word-help) ( word -- element )
104 [ \ $vocabulary swap 2array , ]
106 [ \ $related swap 2array , ]
107 [ dup global at [ get-global \ $value swap 2array , ] [ drop ] if ]
108 [ \ $definition swap 2array , ]
112 M: word article-content (word-help) ;
114 : word-with-methods ( word -- elements )
117 [ \ $methods swap 2array , ]
123 M: generic article-content word-with-methods ;
125 M: class article-content word-with-methods ;
127 M: word article-parent "help-parent" word-prop ;
129 M: word set-article-parent swap "help-parent" set-word-prop ;
131 : ($title) ( topic -- )
132 [ [ article-title ] [ >link ] bi write-object ] ($block) ;
134 : ($navigation-table) ( element -- )
135 help-path-style get dup [
136 table-style [ $table ] with-variable
139 : ($navigation-path) ( topic -- )
140 help-path-style get [
141 help-path [ reverse $breadcrumbs ] unless-empty
144 : ($navigation-link) ( content element label -- )
145 [ prefix 1array ] dip prefix , ;
147 : ($navigation-links) ( topic -- )
149 [ prev-article [ 1array \ $long-link "Prev:" ($navigation-link) ] when* ]
150 [ next-article [ 1array \ $long-link "Next:" ($navigation-link) ] when* ]
152 ] { } make [ ($navigation-table) ] unless-empty ;
154 : $title ( topic -- )
157 [ ($navigation-path) ]
158 [ ($navigation-links) ] tri
161 : print-topic ( topic -- )
164 [ $title ($blank-line) ]
165 [ article-content print-content nl ] bi ;
169 help-hook [ [ print-topic ] ] initialize
172 help-hook get call( topic -- ) ;
174 : ($index) ( articles -- )
175 sort-articles [ \ $subsection swap 2array ] map print-element ;
177 : $index ( element -- )
178 first call( -- seq ) [ ($index) ] unless-empty ;
180 : $about ( element -- )
181 first vocab-help [ 1array $subsection ] when* ;
183 : :help-debugger ( -- )
185 "Debugger commands:" print
187 ":s - data stack at error time" print
188 ":r - retain stack at error time" print
189 ":c - call stack at error time" print
190 ":edit - jump to source location (parse errors only)" print
192 ":get ( var -- value ) accesses variables at time of the error" print
193 ":vars - list all variables at error time" print ;
195 : (:help) ( error -- )
196 error-help [ help ] [ "No help for this error. " print ] if*
202 : remove-article ( name -- )
203 articles get delete-at ;
205 : add-article ( article name -- )
206 [ articles get set-at ] keep xref-article ;
208 : remove-word-help ( word -- )
209 "help" remove-word-prop ;
211 : set-word-help ( content word -- )
212 [ swap "help" set-word-prop ] keep xref-article ;