diff --git a/basis/help/help.factor b/basis/help/help.factor index f9775e2668..a3e3890687 100644 --- a/basis/help/help.factor +++ b/basis/help/help.factor @@ -19,7 +19,7 @@ GENERIC: word-help* ( word -- content ) { { "object" object } { "?" "a boolean" } } $values [ "Tests if the object is an instance of the " , - first "predicating" word-prop \ $link swap 2array , + first "predicating" word-prop <$link> , " class." , ] { } make $description ; @@ -58,15 +58,36 @@ M: word article-title append ] if ; -M: word article-content + + +M: generic article-content word-with-methods ; + +M: class article-content word-with-methods ; + M: word article-parent "help-parent" word-prop ; M: word set-article-parent swap "help-parent" set-word-prop ; diff --git a/basis/help/markup/markup.factor b/basis/help/markup/markup.factor index a307833338..899cad2404 100644 --- a/basis/help/markup/markup.factor +++ b/basis/help/markup/markup.factor @@ -285,11 +285,16 @@ M: f ($instance) : $see ( element -- ) first [ see ] ($see) ; +: $see-methods ( element -- ) first [ see-methods ] ($see) ; + : $synopsis ( element -- ) first [ synopsis write ] ($see) ; : $definition ( element -- ) "Definition" $heading $see ; +: $methods ( element -- ) + "Methods" $heading $see-methods ; + : $value ( object -- ) "Variable value" $heading "Current value in global namespace:" print-element @@ -348,3 +353,6 @@ M: array elements* ] each ] curry each ] H{ } make-assoc keys ; + +: <$link> ( topic -- element ) + \ $link swap 2array ; diff --git a/basis/locals/locals.factor b/basis/locals/locals.factor index 1e205e10b0..6e7f660a66 100644 --- a/basis/locals/locals.factor +++ b/basis/locals/locals.factor @@ -289,14 +289,18 @@ SYMBOL: in-lambda? \ ] (parse-lambda) ; : parse-binding ( -- pair/f ) - scan dup "|" = [ - drop f - ] [ - scan { - { "[" [ \ ] parse-until >quotation ] } - { "[|" [ parse-lambda ] } - } case 2array - ] if ; + scan { + { [ dup "|" = ] [ drop f ] } + { [ dup "!" = ] [ drop lexer get next-line parse-binding ] } + { [ t ] + [ + scan { + { "[" [ \ ] parse-until >quotation ] } + { "[|" [ parse-lambda ] } + } case 2array + ] + } + } cond ; : (parse-bindings) ( -- ) parse-binding [ diff --git a/basis/prettyprint/prettyprint.factor b/basis/prettyprint/prettyprint.factor index 1ecca0ec19..6dd7175db8 100644 --- a/basis/prettyprint/prettyprint.factor +++ b/basis/prettyprint/prettyprint.factor @@ -44,7 +44,7 @@ IN: prettyprint ] with-pprint nl ] unless-empty ; -: vocabs. ( in use -- ) +: use/in. ( in use -- ) dupd remove [ { "syntax" "scratchpad" } member? not ] filter use. in. ; @@ -53,7 +53,7 @@ IN: prettyprint [ [ words>> eq? nip ] with assoc-find 2drop ] curry map sift ; : prelude. ( -- ) - in get use get vocab-names vocabs. ; + in get use get vocab-names use/in. ; [ nl @@ -65,7 +65,7 @@ IN: prettyprint ] print-use-hook set-global : with-use ( obj quot -- ) - make-pprint vocabs. do-pprint ; inline + make-pprint use/in. do-pprint ; inline : with-in ( obj quot -- ) make-pprint drop [ write-in bl ] when* do-pprint ; inline diff --git a/basis/tools/vocabs/browser/authors.txt b/basis/tools/vocabs/browser/authors.txt index 1901f27a24..e1907c6d91 100755 --- a/basis/tools/vocabs/browser/authors.txt +++ b/basis/tools/vocabs/browser/authors.txt @@ -1 +1,2 @@ Slava Pestov +Eduardo Cavazos diff --git a/basis/tools/vocabs/browser/browser-docs.factor b/basis/tools/vocabs/browser/browser-docs.factor index 3765efb863..6c5fb596e8 100644 --- a/basis/tools/vocabs/browser/browser-docs.factor +++ b/basis/tools/vocabs/browser/browser-docs.factor @@ -1,7 +1,13 @@ USING: help.markup help.syntax io strings ; IN: tools.vocabs.browser +ARTICLE: "vocab-tags" "Vocabulary tags" +{ $all-tags } ; + +ARTICLE: "vocab-authors" "Vocabulary authors" +{ $all-authors } ; + ARTICLE: "vocab-index" "Vocabulary index" -{ $tags } -{ $authors } +{ $subsection "vocab-tags" } +{ $subsection "vocab-authors" } { $describe-vocab "" } ; diff --git a/basis/tools/vocabs/browser/browser.factor b/basis/tools/vocabs/browser/browser.factor index c3296df280..cfc541d9bc 100644 --- a/basis/tools/vocabs/browser/browser.factor +++ b/basis/tools/vocabs/browser/browser.factor @@ -1,9 +1,12 @@ ! Copyright (C) 2007, 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors kernel combinators vocabs vocabs.loader -tools.vocabs io io.files io.styles help.markup help.stylesheet -sequences assocs help.topics namespaces prettyprint words -sorting definitions arrays summary sets generic ; +USING: accessors arrays assocs classes classes.builtin +classes.intersection classes.mixin classes.predicate +classes.singleton classes.tuple classes.union combinators +definitions effects fry generic help help.markup +help.stylesheet help.topics io io.files io.styles kernel macros +make namespaces prettyprint sequences sets sorting summary +tools.vocabs vocabs vocabs.loader words ; IN: tools.vocabs.browser : vocab-status-string ( vocab -- string ) @@ -18,9 +21,9 @@ IN: tools.vocabs.browser : vocab. ( vocab -- ) [ - dup [ write-status ] with-cell - dup [ ($link) ] with-cell - [ vocab-summary write ] with-cell + [ [ write-status ] with-cell ] + [ [ ($link) ] with-cell ] + [ [ vocab-summary write ] with-cell ] tri ] with-row ; : vocab-headings. ( -- ) @@ -34,35 +37,25 @@ IN: tools.vocabs.browser [ "Children from " prepend ] [ "Children" ] if* $heading ; -: vocabs. ( assoc -- ) +: $vocabs ( assoc -- ) [ - [ - drop - ] [ - swap root-heading. - standard-table-style [ - vocab-headings. [ vocab. ] each - ] ($grid) + [ drop ] [ + [ root-heading. ] + [ + standard-table-style [ + vocab-headings. [ vocab. ] each + ] ($grid) + ] bi* ] if-empty ] assoc-each ; -: describe-summary ( vocab -- ) - vocab-summary [ - "Summary" $heading print-element - ] when* ; - TUPLE: vocab-tag name ; INSTANCE: vocab-tag topic C: vocab-tag -: tags. ( seq -- ) [ ] map $links ; - -: describe-tags ( vocab -- ) - vocab-tags f like [ - "Tags" $heading tags. - ] when* ; +: $tags ( seq -- ) [ ] map $links ; TUPLE: vocab-author name ; @@ -70,20 +63,18 @@ INSTANCE: vocab-author topic C: vocab-author -: authors. ( seq -- ) [ ] map $links ; - -: describe-authors ( vocab -- ) - vocab-authors f like [ - "Authors" $heading authors. - ] when* ; +: $authors ( seq -- ) [ ] map $links ; : describe-help ( vocab -- ) - vocab-help [ - "Documentation" $heading ($link) - ] when* ; + [ + dup vocab-help + [ "Documentation" $heading ($link) ] + [ "Summary" $heading vocab-summary print-element ] + ?if + ] unless-empty ; : describe-children ( vocab -- ) - vocab-name all-child-vocabs vocabs. ; + vocab-name all-child-vocabs $vocabs ; : describe-files ( vocab -- ) vocab-files [ ] map [ @@ -95,50 +86,167 @@ C: vocab-author ] with-nesting ] with-style ] ($block) - ] when* ; + ] unless-empty ; + +: describe-tuple-classes ( classes -- ) + [ + "Tuple classes" $subheading + [ + [ <$link> ] + [ superclass <$link> ] + [ "slots" word-prop [ name>> ] map " " join \ $snippet swap 2array ] + tri 3array + ] map + { { $strong "Class" } { $strong "Superclass" } { $strong "Slots" } } prefix + $table + ] unless-empty ; + +: describe-predicate-classes ( classes -- ) + [ + "Predicate classes" $subheading + [ + [ <$link> ] + [ superclass <$link> ] + bi 2array + ] map + { { $strong "Class" } { $strong "Superclass" } } prefix + $table + ] unless-empty ; + +: (describe-classes) ( classes heading -- ) + '[ + _ $subheading + [ <$link> 1array ] map $table + ] unless-empty ; + +: describe-builtin-classes ( classes -- ) + "Builtin classes" (describe-classes) ; + +: describe-singleton-classes ( classes -- ) + "Singleton classes" (describe-classes) ; + +: describe-mixin-classes ( classes -- ) + "Mixin classes" (describe-classes) ; + +: describe-union-classes ( classes -- ) + "Union classes" (describe-classes) ; + +: describe-intersection-classes ( classes -- ) + "Intersection classes" (describe-classes) ; + +: describe-classes ( classes -- ) + [ builtin-class? ] partition + [ tuple-class? ] partition + [ singleton-class? ] partition + [ predicate-class? ] partition + [ mixin-class? ] partition + [ union-class? ] partition + [ intersection-class? ] filter + { + [ describe-builtin-classes ] + [ describe-tuple-classes ] + [ describe-singleton-classes ] + [ describe-predicate-classes ] + [ describe-mixin-classes ] + [ describe-union-classes ] + [ describe-intersection-classes ] + } spread ; + +: word-syntax ( word -- string/f ) + \ $syntax swap word-help elements dup length 1 = + [ first second ] [ drop f ] if ; + +: describe-parsing ( words -- ) + [ + "Parsing words" $subheading + [ + [ <$link> ] + [ word-syntax dup [ \ $snippet swap 2array ] when ] + bi 2array + ] map + { { $strong "Word" } { $strong "Syntax" } } prefix + $table + ] unless-empty ; + +: (describe-words) ( words heading -- ) + '[ + _ $subheading + [ + [ <$link> ] + [ stack-effect dup [ effect>string \ $snippet swap 2array ] when ] + bi 2array + ] map + { { $strong "Word" } { $strong "Stack effect" } } prefix + $table + ] unless-empty ; + +: describe-generics ( words -- ) + "Generic words" (describe-words) ; + +: describe-macros ( words -- ) + "Macro words" (describe-words) ; + +: describe-primitives ( words -- ) + "Primitives" (describe-words) ; + +: describe-compounds ( words -- ) + "Ordinary words" (describe-words) ; + +: describe-predicates ( words -- ) + "Class predicate words" (describe-words) ; + +: describe-symbols ( words -- ) + [ + "Symbol words" $subheading + [ <$link> 1array ] map $table + ] unless-empty ; : describe-words ( vocab -- ) words [ "Words" $heading - natural-sort $links + + natural-sort + [ [ class? ] filter describe-classes ] + [ + [ [ class? ] [ symbol? ] bi and not ] filter + [ parsing-word? ] partition + [ generic? ] partition + [ macro? ] partition + [ symbol? ] partition + [ primitive? ] partition + [ predicate? ] partition swap + { + [ describe-parsing ] + [ describe-generics ] + [ describe-macros ] + [ describe-symbols ] + [ describe-primitives ] + [ describe-compounds ] + [ describe-predicates ] + } spread + ] bi ] unless-empty ; -: vocab-xref ( vocab quot -- vocabs ) - >r dup vocab-name swap words [ generic? not ] filter r> map - [ [ word? ] filter [ vocabulary>> ] map ] gather natural-sort - remove sift ; inline +: words. ( vocab -- ) + last-element off + vocab-name describe-words ; -: vocab-uses ( vocab -- vocabs ) [ uses ] vocab-xref ; - -: vocab-usage ( vocab -- vocabs ) [ usage ] vocab-xref ; - -: describe-uses ( vocab -- ) - vocab-uses [ - "Uses" $heading - $vocab-links - ] unless-empty ; - -: describe-usage ( vocab -- ) - vocab-usage [ - "Used by" $heading - $vocab-links - ] unless-empty ; +: describe-metadata ( vocab -- ) + [ + [ vocab-tags [ "Tags:" swap \ $tags prefix 2array , ] unless-empty ] + [ vocab-authors [ "Authors:" swap \ $authors prefix 2array , ] unless-empty ] + bi + ] { } make + [ "Meta-data" $heading $table ] unless-empty ; : $describe-vocab ( element -- ) - first - dup describe-children - dup find-vocab-root [ - dup describe-summary - dup describe-tags - dup describe-authors - dup describe-files - ] when - dup vocab [ - dup describe-help - dup describe-words - dup describe-uses - dup describe-usage - ] when drop ; + first { + [ describe-help ] + [ describe-metadata ] + [ describe-words ] + [ describe-files ] + [ describe-children ] + } cleave ; : keyed-vocabs ( str quot -- seq ) all-vocabs [ @@ -154,16 +262,16 @@ C: vocab-author [ vocab-authors ] keyed-vocabs ; : $tagged-vocabs ( element -- ) - first tagged vocabs. ; + first tagged $vocabs ; : $authored-vocabs ( element -- ) - first authored vocabs. ; + first authored $vocabs ; -: $tags ( element -- ) - drop "Tags" $heading all-tags tags. ; +: $all-tags ( element -- ) + drop "Tags" $heading all-tags $tags ; -: $authors ( element -- ) - drop "Authors" $heading all-authors authors. ; +: $all-authors ( element -- ) + drop "Authors" $heading all-authors $authors ; INSTANCE: vocab topic diff --git a/basis/tools/vocabs/vocabs.factor b/basis/tools/vocabs/vocabs.factor index b929c62e04..b492ef4da2 100644 --- a/basis/tools/vocabs/vocabs.factor +++ b/basis/tools/vocabs/vocabs.factor @@ -4,9 +4,31 @@ USING: kernel io io.styles io.files io.encodings.utf8 vocabs.loader vocabs sequences namespaces make math.parser arrays hashtables assocs memoize summary sorting splitting combinators source-files debugger continuations compiler.errors -init checksums checksums.crc32 sets accessors ; +init checksums checksums.crc32 sets accessors generic +definitions words ; IN: tools.vocabs +: vocab-xref ( vocab quot -- vocabs ) + [ [ vocab-name ] [ words [ generic? not ] filter ] bi ] dip map + [ + [ [ word? ] [ generic? not ] bi and ] filter [ + dup method-body? + [ "method-generic" word-prop ] when + vocabulary>> + ] map + ] gather natural-sort remove sift ; inline + +: vocabs. ( seq -- ) + [ dup >vocab-link write-object nl ] each ; + +: vocab-uses ( vocab -- vocabs ) [ uses ] vocab-xref ; + +: vocab-uses. ( vocab -- ) vocab-uses vocabs. ; + +: vocab-usage ( vocab -- vocabs ) [ usage ] vocab-xref ; + +: vocab-usage. ( vocab -- ) vocab-usage vocabs. ; + : vocab-tests-file ( vocab -- path ) dup "-tests.factor" vocab-dir+ vocab-append-path dup [ dup exists? [ drop f ] unless ] [ drop f ] if ; diff --git a/basis/ui/commands/commands-docs.factor b/basis/ui/commands/commands-docs.factor index 5f1ff6dabd..78b82a345c 100644 --- a/basis/ui/commands/commands-docs.factor +++ b/basis/ui/commands/commands-docs.factor @@ -8,7 +8,7 @@ IN: ui.commands [ gesture>string , ] [ [ command-name , ] - [ command-word \ $link swap 2array , ] + [ command-word <$link> , ] [ command-description , ] tri ] bi* diff --git a/basis/ui/gadgets/panes/panes.factor b/basis/ui/gadgets/panes/panes.factor index c1b3df3857..c612cbef0a 100644 --- a/basis/ui/gadgets/panes/panes.factor +++ b/basis/ui/gadgets/panes/panes.factor @@ -10,7 +10,6 @@ io.streams.nested assocs ui.gadgets.presentations ui.gadgets.slots ui.gadgets.grids ui.gadgets.grid-lines classes.tuple models continuations destructors accessors math.geometry.rect ; - IN: ui.gadgets.panes TUPLE: pane < pack @@ -402,7 +401,7 @@ M: f sloppy-pick-up* pane H{ { T{ button-down } [ begin-selection ] } { T{ button-down f { S+ } 1 } [ select-to-caret ] } - { T{ button-up f { S+ } 1 } [ drop ] } + { T{ button-up f { S+ } 1 } [ end-selection ] } { T{ button-up } [ end-selection ] } { T{ drag } [ extend-selection ] } { T{ copy-action } [ com-copy ] } diff --git a/basis/ui/gadgets/worlds/worlds.factor b/basis/ui/gadgets/worlds/worlds.factor index d9ed50c2ec..904a2a5bac 100644 --- a/basis/ui/gadgets/worlds/worlds.factor +++ b/basis/ui/gadgets/worlds/worlds.factor @@ -117,12 +117,14 @@ PREDICATE: specific-drag < drag #>> ; clone f >># button-gesture ; M: world handle-gesture ( gesture gadget -- ? ) - { - { [ over specific-button-up? ] [ drop generalize-gesture t ] } - { [ over specific-button-down? ] [ drop generalize-gesture t ] } - { [ over specific-drag? ] [ drop generalize-gesture t ] } - [ call-next-method ] - } cond ; + 2dup call-next-method [ + { + { [ over specific-button-up? ] [ drop generalize-gesture f ] } + { [ over specific-button-down? ] [ drop generalize-gesture f ] } + { [ over specific-drag? ] [ drop generalize-gesture f ] } + [ 2drop t ] + } cond + ] [ 2drop f ] if ; : close-global ( world global -- ) dup get-global find-world rot eq? diff --git a/basis/ui/gestures/gestures-docs.factor b/basis/ui/gestures/gestures-docs.factor index e94bcf6d93..b7c5c94c62 100644 --- a/basis/ui/gestures/gestures-docs.factor +++ b/basis/ui/gestures/gestures-docs.factor @@ -18,8 +18,8 @@ $nl { propagate-gesture handle-gesture set-gestures } related-words HELP: propagate-gesture -{ $values { "gesture" "a gesture" } { "gadget" gadget } { "?" "a boolean" } } -{ $description "Calls " { $link handle-gesture } " on every parent of " { $snippet "gadget" } ". Outputs " { $link f } " if some parent handled the gesture, else outputs " { $link t } "." } ; +{ $values { "gesture" "a gesture" } { "gadget" gadget } } +{ $description "Calls " { $link handle-gesture } " on every parent of " { $snippet "gadget" } "." } ; HELP: user-input { $values { "string" string } { "gadget" gadget } } diff --git a/unfinished/vocab-browser/vocab-browser.factor b/unfinished/vocab-browser/vocab-browser.factor deleted file mode 100644 index cec2dd21e7..0000000000 --- a/unfinished/vocab-browser/vocab-browser.factor +++ /dev/null @@ -1,310 +0,0 @@ - -USING: kernel words accessors - classes - classes.builtin - classes.tuple - classes.predicate - vocabs - arrays - sequences sorting - io help.markup - effects - generic - prettyprint - prettyprint.sections - prettyprint.backend - combinators.cleave - obj.print ; - -IN: vocab-browser - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: word-effect-as-string ( word -- string ) - stack-effect dup - [ effect>string ] - [ drop "" ] - if ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: print-vocabulary-summary ( vocabulary -- ) - - dup vocab words [ builtin-class? ] filter natural-sort - dup empty? - [ drop ] - [ - "Builtin Classes" $heading nl - print-seq - ] - if - - dup vocab words [ tuple-class? ] filter natural-sort - dup empty? - [ drop ] - [ - "Tuple Classes" $heading nl - [ - { [ ] [ superclass ] [ "slots" word-prop [ name>> ] map " " join ] } - 1arr - ] - map - { "CLASS" "PARENT" "SLOTS" } prefix - print-table - ] - if - - dup vocab words [ predicate-class? ] filter natural-sort - dup empty? - [ drop ] - [ - "Predicate Classes" $heading nl - ! [ pprint-class ] each - [ { [ ] [ superclass ] } 1arr ] map - { "CLASS" "SUPERCLASS" } prefix - print-table - ] - if - - dup vocab words [ class? not ] filter [ symbol? ] filter natural-sort - dup empty? - [ drop ] - [ - "Symbols" $heading nl - print-seq - ] - if - - dup vocab words [ generic? ] filter natural-sort - dup empty? - [ drop ] - [ - "Generic words" $heading nl - [ [ ] [ stack-effect effect>string ] bi 2array ] map - print-table - ] - if - - "Words" $heading nl - dup vocab words - [ predicate-class? not ] filter - [ builtin-class? not ] filter - [ tuple-class? not ] filter - [ generic? not ] filter - [ symbol? not ] filter - [ word? ] filter - natural-sort - [ [ ] [ word-effect-as-string ] bi 2array ] map - print-table - - drop ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -USING: vocabs.loader tools.vocabs.browser ; - -: $vocab-summary ( seq -- ) - first - dup vocab - [ - dup print-vocabulary-summary - dup describe-help - ! dup describe-uses - ! dup describe-usage - ] - when - dup find-vocab-root - [ - dup describe-summary - dup describe-tags - dup describe-authors - ! dup describe-files - ] - when - ! dup describe-children - drop ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -USING: assocs ui.tools.browser ui.operations io.styles ; - -! IN: tools.vocabs.browser - -! : $describe-vocab ( element -- ) $vocab-summary ; - -USING: tools.vocabs ; - -: print-vocabs ( -- ) - vocabs - [ { [ vocab ] [ vocab-summary ] } 1arr ] - map - print-table ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -! : $all-vocabs ( seq -- ) drop print-vocabs ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -USING: help.syntax help.topics ; - -! ARTICLE: "vocab-index" "Vocabulary Index" { $all-vocabs } ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -M: vocab-spec article-content ( vocab-spec -- content ) - { $vocab-summary } swap name>> suffix ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: loaded-and-unloaded-vocabs ( -- seq ) - "" all-child-vocabs values concat [ name>> ] map ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -! ARTICLE: "loaded-vocabs-index" "Loaded Vocabularies" { $loaded-vocabs } ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -USING: debugger ; - -TUPLE: load-this-vocab name ; - -! : do-load-vocab ( ltv -- ) -! dup name>> require -! name>> vocab com-follow ; - -: do-load-vocab ( ltv -- ) - [ - dup name>> require - name>> vocab com-follow - ] - curry - try ; - -[ load-this-vocab? ] \ do-load-vocab { { +primary+ t } } define-operation - -M: load-this-vocab pprint* ( obj -- ) - [ name>> "*" append ] [ ] bi write-object ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: vocab-or-loader ( name -- obj ) - dup vocab - [ vocab ] - [ load-this-vocab boa ] - if ; - -: vocab-summary-text ( vocab-name -- text ) - dup vocab-summary-path vocab-file-contents - dup empty? - [ drop "" ] - [ first ] - if ; - -! : vocab-table-entry ( vocab-name -- seq ) -! { [ vocab-or-loader ] [ vocab-summary ] } 1arr ; - -: vocab-table-entry ( vocab-name -- seq ) - { [ vocab-or-loader ] [ vocab-summary-text ] } 1arr ; - -: print-these-vocabs ( seq -- ) [ vocab-table-entry ] map print-table ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -! : vocab-list ( -- seq ) "" all-child-vocabs values concat [ name>> ] map ; - -: all-vocab-names ( -- seq ) - all-vocabs values concat [ name>> ] map natural-sort ; - -: loaded-vocab-names ( -- seq ) all-vocab-names [ vocab ] filter ; - -: unloaded-vocab-names ( -- seq ) all-vocab-names [ vocab not ] filter ; - -: root->names ( root -- seq ) all-vocabs at [ name>> ] map natural-sort ; - -: vocab-names-core ( -- seq ) "resource:core" root->names ; -: vocab-names-basis ( -- seq ) "resource:basis" root->names ; -: vocab-names-extra ( -- seq ) "resource:extra" root->names ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: $all-vocabs ( seq -- ) drop all-vocab-names print-these-vocabs ; -: $loaded-vocabs ( seq -- ) drop loaded-vocab-names print-these-vocabs ; -: $unloaded-vocabs ( seq -- ) drop unloaded-vocab-names print-these-vocabs ; - -: $vocabs-core ( seq -- ) drop vocab-names-core print-these-vocabs ; -: $vocabs-basis ( seq -- ) drop vocab-names-basis print-these-vocabs ; -: $vocabs-extra ( seq -- ) drop vocab-names-extra print-these-vocabs ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -! { "" } - -! all-child-vocabs values concat [ name>> ] map - -! : vocab-tree ( vocab -- seq ) -! dup -! all-child-vocabs values concat [ name>> ] map prune -! [ vocab-tree ] -! map -! concat -! swap prefix -! [ vocab-source-path ] filter ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -M: vocab-author pprint* ( vocab-author -- ) [ name>> ] [ ] bi write-object ; - -: $vocab-authors ( seq -- ) - drop all-authors [ vocab-author boa ] map print-seq ; - -ARTICLE: "vocab-authors" "Vocabulary Authors" { $vocab-authors } ; - -: vocabs-by-author ( author -- vocab-names ) - authored values concat [ name>> ] map ; - -: $vocabs-by-author ( seq -- ) - first name>> vocabs-by-author print-these-vocabs ; - -M: vocab-author article-content ( vocab-author -- content ) - { $vocabs-by-author } swap suffix ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -M: vocab-tag pprint* ( vocab-tag -- ) [ name>> ] [ ] bi write-object ; - -: print-vocab-tags ( -- ) all-tags [ vocab-tag boa ] map print-seq ; - -: $vocab-tags ( seq -- ) drop print-vocab-tags ; - -ARTICLE: "vocab-tags" "Vocabulary Tags" { $vocab-tags } ; - -: $vocabs-with-tag ( seq -- ) - first tagged values concat [ name>> ] map print-these-vocabs ; - -M: vocab-tag article-content ( vocab-tag -- content ) - name>> { $vocabs-with-tag } swap suffix ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -ARTICLE: "vocab-index-all" "All Vocabularies" { $all-vocabs } ; -ARTICLE: "vocab-index-loaded" "Loaded Vocabularies" { $loaded-vocabs } ; -ARTICLE: "vocab-index-unloaded" "Unloaded Vocabularies" { $loaded-vocabs } ; - -ARTICLE: "vocab-index-core" "Core Vocabularies" { $vocabs-core } ; -ARTICLE: "vocab-index-basis" "Basis Vocabularies" { $vocabs-basis } ; -ARTICLE: "vocab-index-extra" "Extra Vocabularies" { $vocabs-extra } ; - -ARTICLE: "vocab-indices" "Vocabulary Indices" - { $subsection "vocab-index-core" } - { $subsection "vocab-index-basis" } - { $subsection "vocab-index-extra" } - { $subsection "vocab-index-all" } - { $subsection "vocab-index-loaded" } - { $subsection "vocab-index-unloaded" } - { $subsection "vocab-authors" } - { $subsection "vocab-tags" } ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -