1 ! Copyright (C) 2007, 2010 Slava Pestov.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors arrays assocs classes classes.builtin
4 classes.intersection classes.mixin classes.predicate
5 classes.singleton classes.tuple classes.union combinators
6 effects fry generic help help.markup help.stylesheet
7 help.topics io io.pathnames io.styles kernel macros make
8 namespaces sequences sorting summary vocabs vocabs.files
9 vocabs.hierarchy vocabs.loader vocabs.metadata words
14 [ require ] [ lookup-vocab help ] bi ;
16 : vocab-row ( vocab -- row )
17 [ <$pretty-link> ] [ vocab-summary ] bi 2array ;
19 : vocab-headings ( -- headings )
21 { $strong "Vocabulary" }
25 : root-heading ( root -- )
26 [ "Children from " prepend ] [ "Children" ] if*
30 convert-prefixes [ vocab-row ] map vocab-headings prefix $table ;
32 : $vocab-roots ( assoc -- )
34 [ drop ] [ [ root-heading ] [ $vocabs ] bi* ] if-empty
37 TUPLE: vocab-tag name ;
39 INSTANCE: vocab-tag topic
41 C: <vocab-tag> vocab-tag
43 : $tags ( seq -- ) [ <vocab-tag> ] map $links ;
45 TUPLE: vocab-author name ;
47 INSTANCE: vocab-author topic
49 C: <vocab-author> vocab-author
51 : $authors ( seq -- ) [ <vocab-author> ] map $links ;
53 : describe-help ( vocab -- )
56 [ "Documentation" $heading ($link) ]
57 [ "Summary" $heading vocab-summary print-element ]
61 : describe-children ( vocab -- )
62 vocab-name disk-vocabs-for-prefix
68 [ nl ] [ [ string>> ] keep write-object ] interleave
72 : describe-files ( vocab -- )
73 vocab-files [ <pathname> ] map [
80 : describe-tuple-classes ( classes -- )
82 "Tuple classes" $subheading
85 [ superclass-of <$pretty-link> ]
86 [ "slots" word-prop [ name>> ] map " " join <$snippet> ]
89 { { $strong "Class" } { $strong "Superclass" } { $strong "Slots" } } prefix
93 : describe-predicate-classes ( classes -- )
95 "Predicate classes" $subheading
98 [ superclass-of <$pretty-link> ]
101 { { $strong "Class" } { $strong "Superclass" } } prefix
105 : (describe-classes) ( classes heading -- )
108 [ <$pretty-link> 1array ] map $table
111 : describe-builtin-classes ( classes -- )
112 "Builtin classes" (describe-classes) ;
114 : describe-singleton-classes ( classes -- )
115 "Singleton classes" (describe-classes) ;
117 : describe-mixin-classes ( classes -- )
118 "Mixin classes" (describe-classes) ;
120 : describe-union-classes ( classes -- )
121 "Union classes" (describe-classes) ;
123 : describe-intersection-classes ( classes -- )
124 "Intersection classes" (describe-classes) ;
126 : describe-classes ( classes -- )
127 [ builtin-class? ] partition
128 [ tuple-class? ] partition
129 [ singleton-class? ] partition
130 [ predicate-class? ] partition
131 [ mixin-class? ] partition
132 [ union-class? ] partition
133 [ intersection-class? ] filter
135 [ describe-builtin-classes ]
136 [ describe-tuple-classes ]
137 [ describe-singleton-classes ]
138 [ describe-predicate-classes ]
139 [ describe-mixin-classes ]
140 [ describe-union-classes ]
141 [ describe-intersection-classes ]
144 : word-syntax ( word -- string/f )
145 \ $syntax swap word-help elements dup length 1 =
146 [ first second ] [ drop f ] if ;
148 : describe-parsing ( words -- )
150 "Parsing words" $subheading
153 [ word-syntax dup [ <$snippet> ] when ]
156 { { $strong "Word" } { $strong "Syntax" } } prefix
160 : word-row ( word -- element )
162 [ stack-effect dup [ effect>string <$snippet> ] when ]
165 : word-headings ( -- element )
166 { { $strong "Word" } { $strong "Stack effect" } } ;
168 : words-table ( words -- )
169 [ word-row ] map word-headings prefix $table ;
171 : (describe-words) ( words heading -- )
172 '[ _ $subheading words-table ] unless-empty ;
174 : describe-generics ( words -- )
175 "Generic words" (describe-words) ;
177 : describe-macros ( words -- )
178 "Macro words" (describe-words) ;
180 : describe-primitives ( words -- )
181 "Primitives" (describe-words) ;
183 : describe-compounds ( words -- )
184 "Ordinary words" (describe-words) ;
186 : describe-predicates ( words -- )
187 "Class predicate words" (describe-words) ;
189 : describe-symbols ( words -- )
191 "Symbol words" $subheading
192 [ <$pretty-link> 1array ] map $table
195 : $words ( words -- )
200 [ [ class? ] filter describe-classes ]
202 [ [ class? ] [ symbol? ] bi and ] reject
203 [ parsing-word? ] partition
204 [ generic? ] partition
206 [ symbol? ] partition
207 [ primitive? ] partition
208 [ predicate? ] partition swap
211 [ describe-generics ]
214 [ describe-primitives ]
215 [ describe-compounds ]
216 [ describe-predicates ]
221 : vocab-is-not-loaded ( vocab -- )
222 "Not loaded" $heading
223 "You must first load this vocabulary to browse its documentation and words."
224 print-element vocab-name "USE: " prepend 1array $code ;
226 : describe-words ( vocab -- )
228 { [ dup lookup-vocab ] [ vocab-words $words ] }
229 { [ dup find-vocab-root ] [ vocab-is-not-loaded ] }
233 : words. ( vocab -- )
235 [ require ] [ vocab-words $words ] bi nl ;
237 : describe-metadata ( vocab -- )
239 [ vocab-tags [ "Tags:" swap \ $tags prefix 2array , ] unless-empty ]
240 [ vocab-authors [ "Authors:" swap \ $authors prefix 2array , ] unless-empty ]
241 [ vocab-platforms [ "Platforms:" swap \ $links prefix 2array , ] unless-empty ]
244 [ "Meta-data" $heading $table ] unless-empty ;
246 : $vocab ( element -- )
249 [ describe-metadata ]
252 [ describe-children ]
255 : keyed-vocabs ( str quot -- seq )
256 [ all-disk-vocabs-recursive ] 2dip '[
257 [ _ swap @ member? ] filter no-prefixes
261 : tagged ( tag -- assoc )
262 [ vocab-tags ] keyed-vocabs ;
264 : authored ( author -- assoc )
265 [ vocab-authors ] keyed-vocabs ;
267 : $tagged-vocabs ( element -- )
268 first tagged $vocab-roots ;
270 : $authored-vocabs ( element -- )
271 first authored $vocab-roots ;
273 : $all-tags ( element -- )
274 drop "Tags" $heading all-tags $tags ;
276 : $all-authors ( element -- )
277 drop "Authors" $heading all-authors $authors ;
279 INSTANCE: vocab topic
281 INSTANCE: vocab-link topic
283 M: vocab-spec valid-article? drop t ;
285 M: vocab-spec article-title vocab-name " vocabulary" append ;
287 M: vocab-spec article-name vocab-name ;
289 M: vocab-spec article-content
290 vocab-name \ $vocab swap 2array ;
292 M: vocab-spec article-parent drop "vocab-index" ;
296 M: vocab-tag valid-article? drop t ;
298 M: vocab-tag article-title
299 name>> "Vocabularies tagged “" "”" surround ;
301 M: vocab-tag article-name name>> ;
303 M: vocab-tag article-content
304 \ $tagged-vocabs swap name>> 2array ;
306 M: vocab-tag article-parent drop "vocab-tags" ;
308 M: vocab-tag summary article-title ;
310 M: vocab-author >link ;
312 M: vocab-author valid-article? drop t ;
314 M: vocab-author article-title
315 name>> "Vocabularies by " prepend ;
317 M: vocab-author article-name name>> ;
319 M: vocab-author article-content
320 \ $authored-vocabs swap name>> 2array ;
322 M: vocab-author article-parent drop "vocab-authors" ;
324 M: vocab-author summary article-title ;