Merge branch 'master' of git://factorcode.org/git/factor

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
+<PRIVATE
+
+: (word-help) ( word -- element )
     [
-        \ $vocabulary over 2array ,
+        {
-        dup word-help %
+            [ \ $vocabulary swap 2array , ]
-        \ $related over 2array ,
+            [ word-help % ]
-        dup get-global [ \ $value swap 2array , ] when*
+            [ \ $related swap 2array , ]
-        \ $definition swap 2array ,
+            [ get-global [ \ $value swap 2array , ] when* ]
+            [ \ $definition swap 2array , ]
+        } cleave
     ] { } make ;
 
+M: word article-content (word-help) ;
+
+<PRIVATE
+
+: word-with-methods ( word -- elements )
+    [
+        [ (word-help) % ]
+        [ \ $methods swap 2array , ]
+        bi
+    ] { } make ;
+
+PRIVATE>
+
+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 ;

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 ;

basis/locals/locals.factor

@@ -289,14 +289,18 @@ SYMBOL: in-lambda?
     \ ] (parse-lambda) <lambda> ;
 
 : parse-binding ( -- pair/f )
-    scan dup "|" = [
+    scan {
-        drop f
+        { [ dup "|" = ] [ drop f ] }
-    ] [
+        { [ dup "!" = ] [ drop lexer get next-line parse-binding ] }
-        scan {
+        { [ t ]
-            { "[" [ \ ] parse-until >quotation ] }
+          [
-            { "[|" [ parse-lambda ] }
+              scan {
-        } case 2array
+                  { "["  [ \ ] parse-until >quotation ] }
-    ] if ;
+                  { "[|" [ parse-lambda ] }
+              } case 2array
+          ]
+        }
+    } cond ;
 
 : (parse-bindings) ( -- )
     parse-binding [

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

basis/tools/vocabs/browser/authors.txt

@@ -1 +1,2 @@
 Slava Pestov
+Eduardo Cavazos

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 }
+{ $subsection "vocab-tags" }
-{ $authors }
+{ $subsection "vocab-authors" }
 { $describe-vocab "" } ;

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
+USING: accessors arrays assocs classes classes.builtin
-tools.vocabs io io.files io.styles help.markup help.stylesheet
+classes.intersection classes.mixin classes.predicate
-sequences assocs help.topics namespaces prettyprint words
+classes.singleton classes.tuple classes.union combinators
-sorting definitions arrays summary sets generic ;
+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
+        [ [ write-status ] with-cell ]
-        dup [ ($link) ] with-cell
+        [ [ ($link) ] with-cell ]
-        [ vocab-summary write ] 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 ] [
-            drop
+            [ root-heading. ]
-        ] [
+            [
-            swap root-heading.
+                standard-table-style [
-            standard-table-style [
+                    vocab-headings. [ vocab. ] each
-                vocab-headings. [ vocab. ] each
+                ] ($grid)
-            ] ($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> vocab-tag
 
-: tags. ( seq -- ) [ <vocab-tag> ] map $links ;
+: $tags ( seq -- ) [ <vocab-tag> ] map $links ;
-
-: describe-tags ( vocab -- )
-    vocab-tags f like [
-        "Tags" $heading tags.
-    ] when* ;
 
 TUPLE: vocab-author name ;
 
@@ -70,20 +63,18 @@ INSTANCE: vocab-author topic
 
 C: <vocab-author> vocab-author
 
-: authors. ( seq -- ) [ <vocab-author> ] map $links ;
+: $authors ( seq -- ) [ <vocab-author> ] map $links ;
-
-: describe-authors ( vocab -- )
-    vocab-authors f like [
-        "Authors" $heading authors.
-    ] when* ;
 
 : describe-help ( vocab -- )
-    vocab-help [
+    [
-        "Documentation" $heading ($link)
+        dup vocab-help
-    ] when* ;
+        [ "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 [ <pathname> ] map [
@@ -95,50 +86,167 @@ C: <vocab-author> 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 )
+: words. ( vocab -- )
-    >r dup vocab-name swap words [ generic? not ] filter r> map
+    last-element off
-    [ [ word? ] filter [ vocabulary>> ] map ] gather natural-sort
+    vocab-name describe-words ;
-    remove sift ; inline
 
-: vocab-uses ( vocab -- vocabs ) [ uses ] vocab-xref ;
+: describe-metadata ( vocab -- )
-
+    [
-: vocab-usage ( vocab -- vocabs ) [ usage ] vocab-xref ;
+        [ vocab-tags [ "Tags:" swap \ $tags prefix 2array , ] unless-empty ]
-
+        [ vocab-authors [ "Authors:" swap \ $authors prefix 2array , ] unless-empty ]
-: describe-uses ( vocab -- )
+        bi
-    vocab-uses [
+    ] { } make
-        "Uses" $heading
+    [ "Meta-data" $heading $table ] unless-empty ;
-        $vocab-links
-    ] unless-empty ;
-
-: describe-usage ( vocab -- )
-    vocab-usage [
-        "Used by" $heading
-        $vocab-links
-    ] unless-empty ;
 
 : $describe-vocab ( element -- )
-    first
+    first {
-    dup describe-children
+        [ describe-help ]
-    dup find-vocab-root [
+        [ describe-metadata ]
-        dup describe-summary
+        [ describe-words ]
-        dup describe-tags
+        [ describe-files ]
-        dup describe-authors
+        [ describe-children ]
-        dup describe-files
+    } cleave ;
-    ] when
-    dup vocab [
-        dup describe-help
-        dup describe-words
-        dup describe-uses
-        dup describe-usage
-    ] when drop ;
 
 : keyed-vocabs ( str quot -- seq )
     all-vocabs [
@@ -154,16 +262,16 @@ C: <vocab-author> 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 -- )
+: $all-tags ( element -- )
-    drop "Tags" $heading all-tags tags. ;
+    drop "Tags" $heading all-tags $tags ;
 
-: $authors ( element -- )
+: $all-authors ( element -- )
-    drop "Authors" $heading all-authors authors. ;
+    drop "Authors" $heading all-authors $authors ;
 
 INSTANCE: vocab topic
 

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 ;

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*

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 ] }

basis/ui/gadgets/worlds/worlds.factor

@@ -117,12 +117,14 @@ PREDICATE: specific-drag < drag #>> ;
     clone f >># button-gesture ;
 
 M: world handle-gesture ( gesture gadget -- ? )
-    {
+    2dup call-next-method [
-        { [ over specific-button-up? ] [ drop generalize-gesture t ] }
+        {
-        { [ over specific-button-down? ] [ drop generalize-gesture t ] }
+            { [ over specific-button-up? ] [ drop generalize-gesture f ] }
-        { [ over specific-drag? ] [ drop generalize-gesture t ] }
+            { [ over specific-button-down? ] [ drop generalize-gesture f ] }
-        [ call-next-method ]
+            { [ over specific-drag? ] [ drop generalize-gesture f ] }
-    } cond ;
+            [ 2drop t ]
+        } cond
+    ] [ 2drop f ] if ;
 
 : close-global ( world global -- )
     dup get-global find-world rot eq?

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" } }
+{ $values { "gesture" "a gesture" } { "gadget" gadget } }
-{ $description "Calls " { $link handle-gesture } " on every parent of " { $snippet "gadget" } ". Outputs " { $link f } " if some parent handled the gesture, else outputs " { $link t } "." } ;
+{ $description "Calls " { $link handle-gesture } " on every parent of " { $snippet "gadget" } "." } ;
 
 HELP: user-input
 { $values { "string" string } { "gadget" gadget } }

unfinished/vocab-browser/vocab-browser.factor

@@ -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"           } ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-