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

db4
Doug Coleman 2008-11-22 09:24:52 -06:00
commit 78ee86ee39
13 changed files with 280 additions and 419 deletions

View File

@ -19,7 +19,7 @@ GENERIC: word-help* ( word -- content )
{ { "object" object } { "?" "a boolean" } } $values { { "object" object } { "?" "a boolean" } } $values
[ [
"Tests if the object is an instance of the " , "Tests if the object is an instance of the " ,
first "predicating" word-prop \ $link swap 2array , first "predicating" word-prop <$link> ,
" class." , " class." ,
] { } make $description ; ] { } make $description ;
@ -58,15 +58,36 @@ M: word article-title
append append
] if ; ] 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 ; ] { } 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 article-parent "help-parent" word-prop ;
M: word set-article-parent swap "help-parent" set-word-prop ; M: word set-article-parent swap "help-parent" set-word-prop ;

View File

@ -285,11 +285,16 @@ M: f ($instance)
: $see ( element -- ) first [ see ] ($see) ; : $see ( element -- ) first [ see ] ($see) ;
: $see-methods ( element -- ) first [ see-methods ] ($see) ;
: $synopsis ( element -- ) first [ synopsis write ] ($see) ; : $synopsis ( element -- ) first [ synopsis write ] ($see) ;
: $definition ( element -- ) : $definition ( element -- )
"Definition" $heading $see ; "Definition" $heading $see ;
: $methods ( element -- )
"Methods" $heading $see-methods ;
: $value ( object -- ) : $value ( object -- )
"Variable value" $heading "Variable value" $heading
"Current value in global namespace:" print-element "Current value in global namespace:" print-element
@ -348,3 +353,6 @@ M: array elements*
] each ] each
] curry each ] curry each
] H{ } make-assoc keys ; ] H{ } make-assoc keys ;
: <$link> ( topic -- element )
\ $link swap 2array ;

View File

@ -289,14 +289,18 @@ SYMBOL: in-lambda?
\ ] (parse-lambda) <lambda> ; \ ] (parse-lambda) <lambda> ;
: parse-binding ( -- pair/f ) : 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-bindings) ( -- )
parse-binding [ parse-binding [

View File

@ -44,7 +44,7 @@ IN: prettyprint
] with-pprint nl ] with-pprint nl
] unless-empty ; ] unless-empty ;
: vocabs. ( in use -- ) : use/in. ( in use -- )
dupd remove [ { "syntax" "scratchpad" } member? not ] filter dupd remove [ { "syntax" "scratchpad" } member? not ] filter
use. in. ; use. in. ;
@ -53,7 +53,7 @@ IN: prettyprint
[ [ words>> eq? nip ] with assoc-find 2drop ] curry map sift ; [ [ words>> eq? nip ] with assoc-find 2drop ] curry map sift ;
: prelude. ( -- ) : prelude. ( -- )
in get use get vocab-names vocabs. ; in get use get vocab-names use/in. ;
[ [
nl nl
@ -65,7 +65,7 @@ IN: prettyprint
] print-use-hook set-global ] print-use-hook set-global
: with-use ( obj quot -- ) : with-use ( obj quot -- )
make-pprint vocabs. do-pprint ; inline make-pprint use/in. do-pprint ; inline
: with-in ( obj quot -- ) : with-in ( obj quot -- )
make-pprint drop [ write-in bl ] when* do-pprint ; inline make-pprint drop [ write-in bl ] when* do-pprint ; inline

View File

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

View File

@ -1,7 +1,13 @@
USING: help.markup help.syntax io strings ; USING: help.markup help.syntax io strings ;
IN: tools.vocabs.browser IN: tools.vocabs.browser
ARTICLE: "vocab-tags" "Vocabulary tags"
{ $all-tags } ;
ARTICLE: "vocab-authors" "Vocabulary authors"
{ $all-authors } ;
ARTICLE: "vocab-index" "Vocabulary index" ARTICLE: "vocab-index" "Vocabulary index"
{ $tags } { $subsection "vocab-tags" }
{ $authors } { $subsection "vocab-authors" }
{ $describe-vocab "" } ; { $describe-vocab "" } ;

View File

@ -1,9 +1,12 @@
! Copyright (C) 2007, 2008 Slava Pestov. ! Copyright (C) 2007, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! 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 IN: tools.vocabs.browser
: vocab-status-string ( vocab -- string ) : vocab-status-string ( vocab -- string )
@ -18,9 +21,9 @@ IN: tools.vocabs.browser
: vocab. ( vocab -- ) : 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 ; ] with-row ;
: vocab-headings. ( -- ) : vocab-headings. ( -- )
@ -34,35 +37,25 @@ IN: tools.vocabs.browser
[ "Children from " prepend ] [ "Children" ] if* [ "Children from " prepend ] [ "Children" ] if*
$heading ; $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 ] if-empty
] assoc-each ; ] assoc-each ;
: describe-summary ( vocab -- )
vocab-summary [
"Summary" $heading print-element
] when* ;
TUPLE: vocab-tag name ; TUPLE: vocab-tag name ;
INSTANCE: vocab-tag topic INSTANCE: vocab-tag topic
C: <vocab-tag> vocab-tag 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 ; TUPLE: vocab-author name ;
@ -70,20 +63,18 @@ INSTANCE: vocab-author topic
C: <vocab-author> vocab-author 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 -- ) : 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 -- ) : describe-children ( vocab -- )
vocab-name all-child-vocabs vocabs. ; vocab-name all-child-vocabs $vocabs ;
: describe-files ( vocab -- ) : describe-files ( vocab -- )
vocab-files [ <pathname> ] map [ vocab-files [ <pathname> ] map [
@ -95,50 +86,167 @@ C: <vocab-author> vocab-author
] with-nesting ] with-nesting
] with-style ] with-style
] ($block) ] ($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 -- ) : describe-words ( vocab -- )
words [ words [
"Words" $heading "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 ; ] 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 -- ) : $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 ) : keyed-vocabs ( str quot -- seq )
all-vocabs [ all-vocabs [
@ -154,16 +262,16 @@ C: <vocab-author> vocab-author
[ vocab-authors ] keyed-vocabs ; [ vocab-authors ] keyed-vocabs ;
: $tagged-vocabs ( element -- ) : $tagged-vocabs ( element -- )
first tagged vocabs. ; first tagged $vocabs ;
: $authored-vocabs ( element -- ) : $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 INSTANCE: vocab topic

View File

@ -4,9 +4,31 @@ USING: kernel io io.styles io.files io.encodings.utf8
vocabs.loader vocabs sequences namespaces make math.parser vocabs.loader vocabs sequences namespaces make math.parser
arrays hashtables assocs memoize summary sorting splitting arrays hashtables assocs memoize summary sorting splitting
combinators source-files debugger continuations compiler.errors 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 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 ) : vocab-tests-file ( vocab -- path )
dup "-tests.factor" vocab-dir+ vocab-append-path dup dup "-tests.factor" vocab-dir+ vocab-append-path dup
[ dup exists? [ drop f ] unless ] [ drop f ] if ; [ dup exists? [ drop f ] unless ] [ drop f ] if ;

View File

@ -8,7 +8,7 @@ IN: ui.commands
[ gesture>string , ] [ gesture>string , ]
[ [
[ command-name , ] [ command-name , ]
[ command-word \ $link swap 2array , ] [ command-word <$link> , ]
[ command-description , ] [ command-description , ]
tri tri
] bi* ] bi*

View File

@ -10,7 +10,6 @@ io.streams.nested assocs ui.gadgets.presentations
ui.gadgets.slots ui.gadgets.grids ui.gadgets.grid-lines ui.gadgets.slots ui.gadgets.grids ui.gadgets.grid-lines
classes.tuple models continuations destructors accessors classes.tuple models continuations destructors accessors
math.geometry.rect ; math.geometry.rect ;
IN: ui.gadgets.panes IN: ui.gadgets.panes
TUPLE: pane < pack TUPLE: pane < pack
@ -402,7 +401,7 @@ M: f sloppy-pick-up*
pane H{ pane H{
{ T{ button-down } [ begin-selection ] } { T{ button-down } [ begin-selection ] }
{ T{ button-down f { S+ } 1 } [ select-to-caret ] } { 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{ button-up } [ end-selection ] }
{ T{ drag } [ extend-selection ] } { T{ drag } [ extend-selection ] }
{ T{ copy-action } [ com-copy ] } { T{ copy-action } [ com-copy ] }

View File

@ -117,12 +117,14 @@ PREDICATE: specific-drag < drag #>> ;
clone f >># button-gesture ; clone f >># button-gesture ;
M: world handle-gesture ( gesture gadget -- ? ) 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 -- ) : close-global ( world global -- )
dup get-global find-world rot eq? dup get-global find-world rot eq?

View File

@ -18,8 +18,8 @@ $nl
{ propagate-gesture handle-gesture set-gestures } related-words { propagate-gesture handle-gesture set-gestures } related-words
HELP: propagate-gesture 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 HELP: user-input
{ $values { "string" string } { "gadget" gadget } } { $values { "string" string } { "gadget" gadget } }

View File

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