diff --git a/basis/prettyprint/sections/sections-docs.factor b/basis/prettyprint/sections/sections-docs.factor index ce7430d040..f0d369297c 100644 --- a/basis/prettyprint/sections/sections-docs.factor +++ b/basis/prettyprint/sections/sections-docs.factor @@ -1,6 +1,6 @@ USING: prettyprint io kernel help.markup help.syntax prettyprint.config words hashtables math -strings definitions ; +strings definitions quotations ; IN: prettyprint.sections HELP: position @@ -13,7 +13,6 @@ HELP: line-limit? { $values { "?" "a boolean" } } { $description "Tests if the line number limit has been reached, and thus if prettyprinting should stop." } ; - HELP: do-indent { $description "Outputs the current indent nesting to " { $link output-stream } "." } ; @@ -211,3 +210,7 @@ $prettyprinting-note ; HELP: do-pprint { $values { "block" block } } { $description "Recursively output all children of the given block. The continuation is restored and output terminates if the line length is exceeded; this test is performed in " { $link fresh-line } "." } ; + +HELP: with-pprint +{ $values { "obj" object } { "quot" quotation } } +{ $description "Sets up the prettyprinter and calls the quotation in a new scope. The quotation should add sections to the top-level block. When the quotation returns, the top-level block is printed to " { $link output-stream } "." } ; diff --git a/basis/prettyprint/sections/sections.factor b/basis/prettyprint/sections/sections.factor index faa254be69..f72c426533 100644 --- a/basis/prettyprint/sections/sections.factor +++ b/basis/prettyprint/sections/sections.factor @@ -326,3 +326,19 @@ M: block long-section ( block -- ) ] each ] each ] if-nonempty ; + +: make-pprint ( obj quot -- block in use ) + [ + 0 position set + H{ } clone pprinter-use set + V{ } clone recursion-check set + V{ } clone pprinter-stack set + over > "> ; + +[ +<" USING: kernel namespaces syntax vocabs.parser +vocabs.prettyprint ;"> +] +[ [ manifest-test-1 eval( -- ) ] with-string-writer ] unit-test + +: manifest-test-2 ( -- string ) + <" USING: kernel namespaces vocabs.parser vocabs.prettyprint ; + IN: vocabs.prettyprint.tests + + << manifest get pprint-manifest >> "> ; + +[ +<" USING: kernel namespaces syntax vocabs.parser +vocabs.prettyprint ; +IN: vocabs.prettyprint.tests"> +] +[ [ manifest-test-2 eval( -- ) ] with-string-writer ] unit-test + +: manifest-test-3 ( -- string ) + <" USING: kernel namespaces vocabs.parser vocabs.prettyprint ; + FROM: math => + - ; + QUALIFIED: system + QUALIFIED-WITH: assocs a + EXCLUDE: parser => run-file ; + IN: vocabs.prettyprint.tests + + << manifest get pprint-manifest >> "> ; + +[ +<" USING: kernel namespaces syntax vocabs.parser +vocabs.prettyprint ; +FROM: math => + - ; +QUALIFIED: system +QUALIFIED-WITH: assocs a +EXCLUDE: parser => run-file ; +IN: vocabs.prettyprint.tests"> +] +[ [ manifest-test-3 eval( -- ) ] with-string-writer ] unit-test \ No newline at end of file diff --git a/basis/vocabs/prettyprint/prettyprint.factor b/basis/vocabs/prettyprint/prettyprint.factor new file mode 100644 index 0000000000..d491acd33b --- /dev/null +++ b/basis/vocabs/prettyprint/prettyprint.factor @@ -0,0 +1,86 @@ +! Copyright (C) 2009 Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +USING: accessors kernel sorting sequences vocabs io io.styles arrays assocs +namespaces sets parser colors prettyprint.backend prettyprint.sections +vocabs.parser make fry math.order ; +IN: vocabs.prettyprint + +: pprint-vocab ( vocab -- ) + [ vocab-name ] [ vocab ] bi present-text ; + +: pprint-in ( vocab -- ) + [ \ IN: pprint-word pprint-vocab ] with-pprint ; + +> vocab-name ] [ prefix>> ] bi = [ + \ QUALIFIED: pprint-word + vocab>> pprint-vocab + ] [ + \ QUALIFIED-WITH: pprint-word + [ vocab>> pprint-vocab ] [ prefix>> text ] bi + ] if + ] with-pprint ; + +M: from pprint-qualified ( from -- ) + [ + \ FROM: pprint-word + [ vocab>> pprint-vocab "=>" text ] + [ names>> [ text ] each ] bi + \ ; pprint-word + ] with-pprint ; + +M: exclude pprint-qualified ( exclude -- ) + [ + \ EXCLUDE: pprint-word + [ vocab>> pprint-vocab "=>" text ] + [ names>> [ text ] each ] bi + \ ; pprint-word + ] with-pprint ; + +M: rename pprint-qualified ( rename -- ) + [ + \ RENAME: pprint-word + [ word>> text ] + [ vocab>> text "=>" text ] + [ words>> >alist first first text ] + tri + ] with-pprint ; + +PRIVATE> + +: pprint-manifest ( manifest -- ) + [ + [ search-vocabs>> [ '[ _ pprint-using ] , ] unless-empty ] + [ qualified-vocabs>> [ extra-words? not ] filter [ '[ _ pprint-qualified ] , ] each ] + [ current-vocab>> [ '[ _ pprint-in ] , ] when* ] + tri + ] { } make + [ nl ] [ call( -- ) ] interleave ; + +[ + nl + { { font-style bold } { font-name "sans-serif" } } [ + "Restarts were invoked adding vocabularies to the search path." print + "To avoid doing this in the future, add the following USING:" print + "and IN: forms at the top of the source file:" print nl + ] with-style + { { page-color T{ rgba f 0.8 0.8 0.8 1.0 } } } + [ manifest get pprint-manifest ] with-nesting + nl nl +] print-use-hook set-global \ No newline at end of file diff --git a/core/vocabs/parser/parser.factor b/core/vocabs/parser/parser.factor index f6c14cead9..c76890e845 100644 --- a/core/vocabs/parser/parser.factor +++ b/core/vocabs/parser/parser.factor @@ -26,6 +26,10 @@ M: manifest clone [ clone ] change-qualified-vocabs [ clone ] change-extra-words ; +TUPLE: extra-words words ; + +C: extra-words + extra-words - : (use-words) ( assoc -- extra-words seq ) manifest get qualified-vocabs>> ;