From a4e77124af47ee07ed0594653ccd3a2b9f9c6a40 Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Wed, 3 Sep 2008 02:16:45 -0500 Subject: [PATCH 1/2] New vocabulary browser --- unfinished/vocab-browser/vocab-browser.factor | 271 ++++++++++++++++++ 1 file changed, 271 insertions(+) create mode 100644 unfinished/vocab-browser/vocab-browser.factor diff --git a/unfinished/vocab-browser/vocab-browser.factor b/unfinished/vocab-browser/vocab-browser.factor new file mode 100644 index 0000000000..c5203a4894 --- /dev/null +++ b/unfinished/vocab-browser/vocab-browser.factor @@ -0,0 +1,271 @@ + +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 + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: pprint-class ( class -- ) + [ + \ TUPLE: pprint-word dup pprint-word + dup superclass tuple eq? + [ "<" text dup superclass pprint-word ] unless + pprint-; + ] + with-pprint nl ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: 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 + ] + 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 + [ 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 ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +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" } ; \ No newline at end of file From a24645fbca6043ad93c000a8bbb52bf6c0c9cd43 Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Wed, 3 Sep 2008 02:17:28 -0500 Subject: [PATCH 2/2] obj.pring: Quick workaround for vocab-browser --- extra/obj/print/print.factor | 11 +++++++++++ 1 file changed, 11 insertions(+) diff --git a/extra/obj/print/print.factor b/extra/obj/print/print.factor index 066f24cb6a..000e161387 100644 --- a/extra/obj/print/print.factor +++ b/extra/obj/print/print.factor @@ -8,8 +8,19 @@ IN: obj.print : write-wrapped ( string -- ) H{ { wrap-margin 500 } } [ write ] with-nesting ; +! : print-elt ( val -- ) +! { +! { [ string? ] [ write-wrapped ] } +! { [ array? ] [ [ . ] each ] } +! { [ drop t ] [ . ] } +! } +! 1cond ; + +USING: accessors vocabs help.markup ; + : print-elt ( val -- ) { + { [ vocab? ] [ [ name>> ] [ ] bi write-object ] } { [ string? ] [ write-wrapped ] } { [ array? ] [ [ . ] each ] } { [ drop t ] [ . ] }