Clean up pprint-use and related code to use manifests

diff --git a/basis/prettyprint/prettyprint-docs.factor b/basis/prettyprint/prettyprint-docs.factor
index 1af921d4f3dd20fe2dcb90bfee456f3ad1110c67..fbbece46028ae2bb7f9b991bd9a15fd03f035d66 100644 (file)
--- a/basis/prettyprint/prettyprint-docs.factor
+++ b/basis/prettyprint/prettyprint-docs.factor
@@ -161,10 +161,6 @@ $nl
 
 ABOUT: "prettyprint"
 
-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 } "." } ;
-
 HELP: pprint
 { $values { "obj" object } }
 { $description "Prettyprints an object to " { $link output-stream } ". Output is influenced by many variables; see " { $link "prettyprint-variables" } "." }
@@ -225,8 +221,3 @@ HELP: .r
 
 HELP: .s
 { $description "Displays the contents of the data stack, with the top of the stack printed first." } ;
-
-HELP: in.
-{ $values { "vocab" "a vocabulary specifier" } }
-{ $description "Prettyprints a " { $snippet "IN:" } " declaration." }
-$prettyprinting-note ;
\ No newline at end of file

diff --git a/basis/prettyprint/prettyprint.factor b/basis/prettyprint/prettyprint.factor
index 2286417dd1d71aef5a6fa12ec0228e9e12319d30..99913a803abaaa5788df469c15b6c38743759458 100644 (file)
--- a/basis/prettyprint/prettyprint.factor
+++ b/basis/prettyprint/prettyprint.factor
@@ -4,78 +4,16 @@ USING: arrays accessors assocs colors combinators grouping io
 io.streams.string io.styles kernel make math math.parser namespaces
 parser prettyprint.backend prettyprint.config prettyprint.custom
 prettyprint.sections quotations sequences sorting strings vocabs
-vocabs.parser words sets ;
+vocabs.prettyprint words sets ;
 IN: prettyprint
 
-<PRIVATE
-
-: 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 <object
-        call
-        pprinter-block
-        pprinter-in get
-        pprinter-use get keys
-    ] with-scope ; inline
-
-: with-pprint ( obj quot -- )
-    make-pprint 2drop do-pprint ; inline
-
-: pprint-vocab ( vocab -- )
-    dup vocab present-text ;
-
-: write-in ( vocab -- )
-    [ \ IN: pprint-word pprint-vocab ] with-pprint ;
-
-: in. ( vocab -- )
-    [ write-in ] when* ;
-
-: use. ( seq -- )
-    [
-        natural-sort [
-            \ USING: pprint-word
-            [ pprint-vocab ] each
-            \ ; pprint-word
-        ] with-pprint
-    ] unless-empty ;
-
-: use/in. ( in use -- )
-    over "syntax" 2array diff
-    [ nip use. ]
-    [ empty? not and [ nl ] when ]
-    [ drop in. ]
-    2tri ;
-
-: vocab-names ( words -- vocabs )
-    dictionary get
-    [ [ words>> eq? nip ] with assoc-find 2drop ] curry map sift ;
-
-: prelude. ( -- )
-    in get use get vocab-names prune in get ".private" append swap remove use/in. ;
-
-[
-    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 } } } [ prelude. ] with-nesting
-    nl nl
-] print-use-hook set-global
-
-PRIVATE>
-
 : with-use ( obj quot -- )
-    make-pprint [ use/in. ] [ empty? not or [ nl ] when ] 2bi
+    make-pprint (pprint-manifest
+    [ pprint-manifest) ] [ [ drop nl ] unless-empty ] bi
     do-pprint ; inline
 
 : with-in ( obj quot -- )
-    make-pprint drop [ write-in bl ] when* do-pprint ; inline
+    make-pprint current-vocab>> [ pprint-in bl ] when* do-pprint ; inline
 
 : pprint ( obj -- ) [ pprint* ] with-pprint ;
 

diff --git a/basis/prettyprint/sections/sections.factor b/basis/prettyprint/sections/sections.factor
index f72c4265335bcc772431e0095d5a1dcc14f3f1c3..b4eb40757d7d974bab75d85a201a38fe70f7564e 100644 (file)
--- a/basis/prettyprint/sections/sections.factor
+++ b/basis/prettyprint/sections/sections.factor
@@ -1,9 +1,9 @@
-! Copyright (C) 2003, 2008 Slava Pestov.
+! Copyright (C) 2003, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: arrays generic hashtables io kernel math assocs
 namespaces make sequences strings io.styles vectors words
 prettyprint.config splitting classes continuations
-accessors sets ;
+accessors sets vocabs.parser combinators vocabs ;
 IN: prettyprint.sections
 
 ! State
@@ -19,8 +19,16 @@ TUPLE: pprinter last-newline line-count indent ;
 
 : <pprinter> ( -- pprinter ) 0 1 0 pprinter boa ;
 
+: (record-vocab) ( vocab -- )
+    dup pprinter-in get dup [ vocab-name ] when =
+    [ drop ] [ pprinter-use get conjoin ] if ;
+
 : record-vocab ( word -- )
-    vocabulary>> [ pprinter-use get conjoin ] when* ;
+    vocabulary>> {
+        { f [ ] }
+        { "syntax" [ ] }
+        [ (record-vocab) ]
+    } case ;
 
 ! Utility words
 : line-limit? ( -- ? )
@@ -327,7 +335,14 @@ M: block long-section ( block -- )
         ] each
     ] if-nonempty ;
 
-: make-pprint ( obj quot -- block in use )
+: pprinter-manifest ( -- manifest )
+    <manifest>
+    [ [ pprinter-use get keys >vector ] dip (>>search-vocabs) ]
+    [ [ pprinter-in get ] dip (>>current-vocab) ]
+    [ ]
+    tri ;
+
+: make-pprint ( obj quot -- block manifest )
     [
         0 position set
         H{ } clone pprinter-use set
@@ -336,9 +351,8 @@ M: block long-section ( block -- )
         over <object
         call
         pprinter-block
-        pprinter-in get
-        pprinter-use get keys
+        pprinter-manifest
     ] with-scope ; inline
 
 : with-pprint ( obj quot -- )
-    make-pprint 2drop do-pprint ; inline
\ No newline at end of file
+    make-pprint drop do-pprint ; inline
\ No newline at end of file

diff --git a/basis/see/see-docs.factor b/basis/see/see-docs.factor
index 2423950d8631b358eaedde7eeee163e775f936a9..1674c9a747f5b3300853077616204d05cb8a6e32 100644 (file)
--- a/basis/see/see-docs.factor
+++ b/basis/see/see-docs.factor
@@ -1,6 +1,6 @@
+USING: help.markup help.syntax strings definitions generic words classes ;
+FROM: prettyprint.sections => with-pprint ;
 IN: see
-USING: help.markup help.syntax strings prettyprint.private
-definitions generic words classes ;
 
 HELP: synopsis
 { $values { "defspec" "a definition specifier" } { "str" string } }

diff --git a/basis/see/see.factor b/basis/see/see.factor
index 37153b522903cc86fe3a21ab01142ab59fd81e94..d2515a2e81acafa55c817d4edd755e060b1ec805 100644 (file)
--- a/basis/see/see.factor
+++ b/basis/see/see.factor
@@ -7,7 +7,7 @@ generic.single generic.standard generic.hook io io.pathnames
 io.streams.string io.styles kernel make namespaces prettyprint
 prettyprint.backend prettyprint.config prettyprint.custom
 prettyprint.sections sequences sets sorting strings summary words
-words.symbol words.constant words.alias ;
+words.symbol words.constant words.alias vocabs ;
 IN: see
 
 GENERIC: synopsis* ( defspec -- )
@@ -44,7 +44,7 @@ M: word print-stack-effect? drop t ;
 <PRIVATE
 
 : seeing-word ( word -- )
-    vocabulary>> pprinter-in set ;
+    vocabulary>> vocab pprinter-in set ;
 
 : word-synopsis ( word -- )
     {

diff --git a/basis/vocabs/prettyprint/prettyprint.factor b/basis/vocabs/prettyprint/prettyprint.factor
index 2ada653af1444141b837ef139d167bb39ceceee0..0e150ef07a7d1e38949202bc5a60cf43ddb1fb81 100644 (file)
--- a/basis/vocabs/prettyprint/prettyprint.factor
+++ b/basis/vocabs/prettyprint/prettyprint.factor
@@ -64,15 +64,20 @@ M: rename pprint-qualified ( rename -- )
 
 PRIVATE>
 
-: pprint-manifest ( manifest -- )
+: (pprint-manifest ( manifest -- quots )
     [
         [ search-vocabs>> [ '[ _ pprint-using ] , ] unless-empty ]
         [ qualified-vocabs>> [ extra-words? not ] filter [ '[ _ pprint-qualified ] , ] each ]
         [ current-vocab>> [ '[ _ pprint-in ] , ] when* ]
         tri
-    ] { } make
+    ] { } make ;
+
+: pprint-manifest) ( quots -- )
     [ nl ] [ call( -- ) ] interleave ;
 
+: pprint-manifest ( manifest -- )
+    (pprint-manifest pprint-manifest) ;
+
 [
     nl
     { { font-style bold } { font-name "sans-serif" } } [