Merge branch 'master' of git://factorcode.org/git/factor
Doug Coleman
commit
78ee86ee39
|
|
@ -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 %
|
||||
\ $related over 2array ,
|
||||
dup get-global [ \ $value swap 2array , ] when*
|
||||
\ $definition swap 2array ,
|
||||
{
|
||||
[ \ $vocabulary swap 2array , ]
|
||||
[ word-help % ]
|
||||
[ \ $related 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 ;
|
||||
|
|
|
|||
|
|
@ -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 ;
|
||||
|
|
|
|||
|
|
@ -289,14 +289,18 @@ SYMBOL: in-lambda?
|
|||
\ ] (parse-lambda) <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 [
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -1 +1,2 @@
|
|||
Slava Pestov
|
||||
Eduardo Cavazos
|
||||
|
|
|
|||
|
|
@ -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 "" } ;
|
||||
|
|
|
|||
|
|
@ -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> vocab-tag
|
||||
|
||||
: tags. ( seq -- ) [ <vocab-tag> ] map $links ;
|
||||
|
||||
: describe-tags ( vocab -- )
|
||||
vocab-tags f like [
|
||||
"Tags" $heading tags.
|
||||
] when* ;
|
||||
: $tags ( seq -- ) [ <vocab-tag> ] map $links ;
|
||||
|
||||
TUPLE: vocab-author name ;
|
||||
|
||||
|
|
@ -70,20 +63,18 @@ INSTANCE: vocab-author topic
|
|||
|
||||
C: <vocab-author> vocab-author
|
||||
|
||||
: authors. ( seq -- ) [ <vocab-author> ] map $links ;
|
||||
|
||||
: describe-authors ( vocab -- )
|
||||
vocab-authors f like [
|
||||
"Authors" $heading authors.
|
||||
] when* ;
|
||||
: $authors ( seq -- ) [ <vocab-author> ] 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 [ <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 )
|
||||
>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-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
|
||||
|
||||
|
|
|
|||
|
|
@ -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 ;
|
||||
|
|
|
|||
|
|
@ -8,7 +8,7 @@ IN: ui.commands
|
|||
[ gesture>string , ]
|
||||
[
|
||||
[ command-name , ]
|
||||
[ command-word \ $link swap 2array , ]
|
||||
[ command-word <$link> , ]
|
||||
[ command-description , ]
|
||||
tri
|
||||
] bi*
|
||||
|
|
|
|||
|
|
@ -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 ] }
|
||||
|
|
|
|||
|
|
@ -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?
|
||||
|
|
|
|||
|
|
@ -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 } }
|
||||
|
|
|
|||
|
|
@ -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" } ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
Loading…
Reference in New Issue