1 ! Copyright (C) 2007, 2008 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 definitions effects fry generic help help.markup help.stylesheet
7 help.topics io io.files io.pathnames io.styles kernel macros
8 make namespaces prettyprint sequences sets sorting summary
9 tools.vocabs vocabs vocabs.loader words ;
10 IN: tools.vocabs.browser
12 : vocab-status-string ( vocab -- string )
14 { [ dup not ] [ drop "" ] }
15 { [ dup vocab-main ] [ drop "[Runnable]" ] }
19 : write-status ( vocab -- )
20 vocab vocab-status-string write ;
24 [ [ write-status ] with-cell ]
25 [ [ ($link) ] with-cell ]
26 [ [ vocab-summary write ] with-cell ] tri
29 : vocab-headings. ( -- )
31 [ "State" write ] with-cell
32 [ "Vocabulary" write ] with-cell
33 [ "Summary" write ] with-cell
36 : root-heading. ( root -- )
37 [ "Children from " prepend ] [ "Children" ] if*
40 : $vocabs ( assoc -- )
45 standard-table-style [
46 vocab-headings. [ vocab. ] each
52 TUPLE: vocab-tag name ;
54 INSTANCE: vocab-tag topic
56 C: <vocab-tag> vocab-tag
58 : $tags ( seq -- ) [ <vocab-tag> ] map $links ;
60 TUPLE: vocab-author name ;
62 INSTANCE: vocab-author topic
64 C: <vocab-author> vocab-author
66 : $authors ( seq -- ) [ <vocab-author> ] map $links ;
68 : describe-help ( vocab -- )
71 [ "Documentation" $heading ($link) ]
72 [ "Summary" $heading vocab-summary print-element ]
76 : describe-children ( vocab -- )
77 vocab-name all-child-vocabs $vocabs ;
79 : describe-files ( vocab -- )
80 vocab-files [ <pathname> ] map [
91 : describe-tuple-classes ( classes -- )
93 "Tuple classes" $subheading
96 [ superclass <$link> ]
97 [ "slots" word-prop [ name>> ] map " " join \ $snippet swap 2array ]
100 { { $strong "Class" } { $strong "Superclass" } { $strong "Slots" } } prefix
104 : describe-predicate-classes ( classes -- )
106 "Predicate classes" $subheading
109 [ superclass <$link> ]
112 { { $strong "Class" } { $strong "Superclass" } } prefix
116 : (describe-classes) ( classes heading -- )
119 [ <$link> 1array ] map $table
122 : describe-builtin-classes ( classes -- )
123 "Builtin classes" (describe-classes) ;
125 : describe-singleton-classes ( classes -- )
126 "Singleton classes" (describe-classes) ;
128 : describe-mixin-classes ( classes -- )
129 "Mixin classes" (describe-classes) ;
131 : describe-union-classes ( classes -- )
132 "Union classes" (describe-classes) ;
134 : describe-intersection-classes ( classes -- )
135 "Intersection classes" (describe-classes) ;
137 : describe-classes ( classes -- )
138 [ builtin-class? ] partition
139 [ tuple-class? ] partition
140 [ singleton-class? ] partition
141 [ predicate-class? ] partition
142 [ mixin-class? ] partition
143 [ union-class? ] partition
144 [ intersection-class? ] filter
146 [ describe-builtin-classes ]
147 [ describe-tuple-classes ]
148 [ describe-singleton-classes ]
149 [ describe-predicate-classes ]
150 [ describe-mixin-classes ]
151 [ describe-union-classes ]
152 [ describe-intersection-classes ]
155 : word-syntax ( word -- string/f )
156 \ $syntax swap word-help elements dup length 1 =
157 [ first second ] [ drop f ] if ;
159 : describe-parsing ( words -- )
161 "Parsing words" $subheading
164 [ word-syntax dup [ \ $snippet swap 2array ] when ]
167 { { $strong "Word" } { $strong "Syntax" } } prefix
171 : (describe-words) ( words heading -- )
176 [ stack-effect dup [ effect>string \ $snippet swap 2array ] when ]
179 { { $strong "Word" } { $strong "Stack effect" } } prefix
183 : describe-generics ( words -- )
184 "Generic words" (describe-words) ;
186 : describe-macros ( words -- )
187 "Macro words" (describe-words) ;
189 : describe-primitives ( words -- )
190 "Primitives" (describe-words) ;
192 : describe-compounds ( words -- )
193 "Ordinary words" (describe-words) ;
195 : describe-predicates ( words -- )
196 "Class predicate words" (describe-words) ;
198 : describe-symbols ( words -- )
200 "Symbol words" $subheading
201 [ <$link> 1array ] map $table
204 : describe-words ( vocab -- )
209 [ [ class? ] filter describe-classes ]
211 [ [ class? ] [ symbol? ] bi and not ] filter
212 [ parsing-word? ] partition
213 [ generic? ] partition
215 [ symbol? ] partition
216 [ primitive? ] partition
217 [ predicate? ] partition swap
220 [ describe-generics ]
223 [ describe-primitives ]
224 [ describe-compounds ]
225 [ describe-predicates ]
230 : words. ( vocab -- )
232 vocab-name describe-words ;
234 : describe-metadata ( vocab -- )
236 [ vocab-tags [ "Tags:" swap \ $tags prefix 2array , ] unless-empty ]
237 [ vocab-authors [ "Authors:" swap \ $authors prefix 2array , ] unless-empty ]
240 [ "Meta-data" $heading $table ] unless-empty ;
242 : $describe-vocab ( element -- )
245 [ describe-metadata ]
248 [ describe-children ]
251 : keyed-vocabs ( str quot -- seq )
254 [ [ 2dup ] dip swap call member? ] filter
256 ] assoc-map 2nip ; inline
258 : tagged ( tag -- assoc )
259 [ vocab-tags ] keyed-vocabs ;
261 : authored ( author -- assoc )
262 [ vocab-authors ] keyed-vocabs ;
264 : $tagged-vocabs ( element -- )
265 first tagged $vocabs ;
267 : $authored-vocabs ( element -- )
268 first authored $vocabs ;
270 : $all-tags ( element -- )
271 drop "Tags" $heading all-tags $tags ;
273 : $all-authors ( element -- )
274 drop "Authors" $heading all-authors $authors ;
276 INSTANCE: vocab topic
278 INSTANCE: vocab-link topic
280 M: vocab-spec article-title vocab-name " vocabulary" append ;
282 M: vocab-spec article-name vocab-name ;
284 M: vocab-spec article-content
285 vocab-name \ $describe-vocab swap 2array ;
287 M: vocab-spec article-parent drop "vocab-index" ;
291 M: vocab-tag article-title
292 name>> "Vocabularies tagged ``" "''" surround ;
294 M: vocab-tag article-name name>> ;
296 M: vocab-tag article-content
297 \ $tagged-vocabs swap name>> 2array ;
299 M: vocab-tag article-parent drop "vocab-index" ;
301 M: vocab-tag summary article-title ;
303 M: vocab-author >link ;
305 M: vocab-author article-title
306 name>> "Vocabularies by " prepend ;
308 M: vocab-author article-name name>> ;
310 M: vocab-author article-content
311 \ $authored-vocabs swap name>> 2array ;
313 M: vocab-author article-parent drop "vocab-index" ;
315 M: vocab-author summary article-title ;