1 ! Copyright (C) 2007, 2010 Slava Pestov.
2 ! See https://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 generic help help.markup help.stylesheet help.topics io
7 io.pathnames io.styles kernel macros make namespaces sequences
8 sorting splitting summary vocabs vocabs.files vocabs.hierarchy
9 vocabs.loader vocabs.metadata words words.symbol ;
13 [ require ] [ lookup-vocab help ] bi ;
15 : vocab-row ( vocab -- row )
16 [ <$pretty-link> ] [ vocab-summary ] bi 2array ;
18 : vocab-headings ( -- headings )
20 { $strong "Vocabulary" }
24 : root-heading ( root -- )
25 [ "Children from " prepend ] [ "Children" ] if*
29 : convert-prefixes ( seq -- seq' )
30 [ dup vocab-prefix? [ name>> <vocab-link> ] when ] map ;
34 convert-prefixes [ vocab-row ] map vocab-headings prefix $table ;
36 : $vocab-roots ( assoc -- )
38 [ drop ] [ [ root-heading ] [ $vocabs ] bi* ] if-empty
41 TUPLE: vocab-tag name ;
43 INSTANCE: vocab-tag topic
45 C: <vocab-tag> vocab-tag
47 : $tags ( seq -- ) [ <vocab-tag> ] map $links ;
49 TUPLE: vocab-author name ;
51 INSTANCE: vocab-author topic
53 C: <vocab-author> vocab-author
55 : $authors ( seq -- ) [ <vocab-author> ] map $links ;
57 : describe-help ( vocab -- )
60 [ "Documentation" $heading ($link) ]
61 [ "Summary" $heading vocab-summary print-element ]
65 : describe-children ( vocab -- )
66 vocab-name disk-vocabs-for-prefix
71 [ nl ] [ [ string>> ] keep write-object ] interleave
74 : describe-files ( vocab -- )
75 vocab-files [ <pathname> ] map [
82 : describe-metadata-files ( vocab -- )
83 vocab-metadata-files [ <pathname> ] map [
84 "Metadata files" $heading
90 : describe-tuple-classes ( classes -- )
92 "Tuple classes" $subheading
95 [ superclass-of <$pretty-link> ]
96 [ "slots" word-prop [ name>> ] map join-words <$snippet> ]
99 { { $strong "Class" } { $strong "Superclass" } { $strong "Slots" } } prefix
103 : describe-predicate-classes ( classes -- )
105 "Predicate classes" $subheading
108 [ superclass-of <$pretty-link> ]
111 { { $strong "Class" } { $strong "Superclass" } } prefix
115 : (describe-classes) ( classes heading -- )
118 [ <$pretty-link> 1array ] map $table
121 : describe-builtin-classes ( classes -- )
122 "Builtin classes" (describe-classes) ;
124 : describe-singleton-classes ( classes -- )
125 "Singleton classes" (describe-classes) ;
127 : describe-mixin-classes ( classes -- )
128 "Mixin classes" (describe-classes) ;
130 : describe-union-classes ( classes -- )
131 "Union classes" (describe-classes) ;
133 : describe-intersection-classes ( classes -- )
134 "Intersection classes" (describe-classes) ;
136 : describe-classes ( classes -- )
137 [ builtin-class? ] partition
138 [ tuple-class? ] partition
139 [ singleton-class? ] partition
140 [ predicate-class? ] partition
141 [ mixin-class? ] partition
142 [ union-class? ] partition
143 [ intersection-class? ] filter
145 [ describe-builtin-classes ]
146 [ describe-tuple-classes ]
147 [ describe-singleton-classes ]
148 [ describe-predicate-classes ]
149 [ describe-mixin-classes ]
150 [ describe-union-classes ]
151 [ describe-intersection-classes ]
154 : word-syntax ( word -- string/f )
155 \ $syntax swap word-help elements dup length 1 =
156 [ first second ] [ drop f ] if ;
158 : describe-parsing ( words -- )
160 "Parsing words" $subheading
163 [ word-syntax dup [ <$snippet> ] when ]
166 { { $strong "Word" } { $strong "Syntax" } } prefix
170 : word-row ( word -- element )
172 [ stack-effect dup [ effect>string <$snippet> ] when ]
175 : word-headings ( -- element )
176 { { $strong "Word" } { $strong "Stack effect" } } ;
178 : words-table ( words -- )
179 [ word-row ] map word-headings prefix $table ;
181 : (describe-words) ( words heading -- )
182 '[ _ $subheading words-table ] unless-empty ;
184 : describe-generics ( words -- )
185 "Generic words" (describe-words) ;
187 : describe-macros ( words -- )
188 "Macro words" (describe-words) ;
190 : describe-primitives ( words -- )
191 "Primitives" (describe-words) ;
193 : describe-compounds ( words -- )
194 "Ordinary words" (describe-words) ;
196 : describe-predicates ( words -- )
197 "Class predicate words" (describe-words) ;
199 : describe-symbols ( words -- )
201 "Symbol words" $subheading
202 [ <$pretty-link> 1array ] map $table
205 : $words ( words -- )
210 [ [ class? ] filter describe-classes ]
212 [ [ class? ] [ symbol? ] bi and ] reject
213 [ parsing-word? ] partition
214 [ generic? ] partition
216 [ symbol? ] partition
217 [ primitive? ] partition
218 [ predicate? ] partition swap
221 [ describe-generics ]
224 [ describe-primitives ]
225 [ describe-compounds ]
226 [ describe-predicates ]
231 : vocab-is-not-loaded ( vocab -- )
232 "Not loaded" $heading
233 "You must first load this vocabulary to browse its documentation and words."
234 print-element vocab-name "USE: " prepend 1array $code ;
236 : describe-words ( vocab -- )
238 { [ dup lookup-vocab ] [ vocab-words $words ] }
239 { [ dup find-vocab-root ] [ vocab-is-not-loaded ] }
243 : words. ( vocab -- )
245 [ require ] [ vocab-words $words ] bi nl ;
247 : describe-metadata ( vocab -- )
249 [ vocab-tags [ "Tags:" swap \ $tags prefix 2array , ] unless-empty ]
250 [ vocab-authors [ "Authors:" swap \ $authors prefix 2array , ] unless-empty ]
251 [ vocab-platforms [ "Platforms:" swap \ $links prefix 2array , ] unless-empty ]
254 [ "Metadata" $heading $table ] unless-empty ;
256 : $vocab ( element -- )
259 [ describe-metadata ]
262 [ describe-metadata-files ]
263 [ describe-children ]
266 : keyed-vocabs ( str quot -- seq )
267 [ all-disk-vocabs-recursive ] 2dip '[
268 [ _ swap @ member? ] filter no-prefixes
272 : tagged ( tag -- assoc )
273 [ vocab-tags ] keyed-vocabs ;
275 : authored ( author -- assoc )
276 [ vocab-authors ] keyed-vocabs ;
278 : $tagged-vocabs ( element -- )
279 first tagged $vocab-roots ;
281 : $authored-vocabs ( element -- )
282 first authored $vocab-roots ;
284 : $all-tags ( element -- )
285 drop "Tags" $heading all-tags $tags ;
287 : $all-authors ( element -- )
288 drop "Authors" $heading all-authors $authors ;
290 INSTANCE: vocab topic
292 INSTANCE: vocab-link topic
294 M: vocab-spec valid-article? drop t ;
296 M: vocab-spec article-title vocab-name " vocabulary" append ;
298 M: vocab-spec article-name vocab-name ;
300 M: vocab-spec article-content
301 vocab-name \ $vocab swap 2array ;
303 M: vocab-spec article-parent drop "vocab-index" ;
307 M: vocab-tag valid-article? drop t ;
309 M: vocab-tag article-title
310 name>> "Vocabularies tagged “" "”" surround ;
312 M: vocab-tag article-name name>> ;
314 M: vocab-tag article-content
315 \ $tagged-vocabs swap name>> 2array ;
317 M: vocab-tag article-parent drop "vocab-tags" ;
319 M: vocab-tag summary article-title ;
321 M: vocab-author >link ;
323 M: vocab-author valid-article? drop t ;
325 M: vocab-author article-title
326 name>> "Vocabularies by " prepend ;
328 M: vocab-author article-name name>> ;
330 M: vocab-author article-content
331 \ $authored-vocabs swap name>> 2array ;
333 M: vocab-author article-parent drop "vocab-authors" ;
335 M: vocab-author summary article-title ;