minor prettyprint improvements

library/platform/native/boot-stage2.factor

@@ -78,6 +78,7 @@ USE: stdio
     "/library/presentation.factor"
     "/library/vocabulary-style.factor"
     "/library/syntax/prettyprint.factor"
+    "/library/syntax/see.factor"
     "/library/platform/native/debugger.factor"
     "/library/tools/debugger.factor"
     "/library/platform/native/init.factor"

library/syntax/parse-syntax.factor

@@ -193,11 +193,17 @@ IN: syntax
     parsing
 
 ! Comments
-: ( ")" until parsed-stack-effect ; parsing
+: (
+    #! Stack comment.
+    ")" until parsed-stack-effect ; parsing
 
-: ! until-eol drop ; parsing
+: !
+    #! EOL comment.
+    until-eol drop ; parsing
 
-: #! until-eol parsed-documentation ; parsing
+: #!
+    #! Documentation comment.
+    until-eol parsed-documentation ; parsing
 
 ! Reading numbers in other bases
 

library/syntax/prettyprint.factor

@@ -81,6 +81,40 @@ DEFER: prettyprint*
         dup prettyprint-newline
     ] unless ;
 
+: word-link ( word -- link )
+    [
+        "vocabularies'" ,
+        dup word-vocabulary ,
+        "'" ,
+        word-name ,
+    ] make-string ;
+
+: word-actions ( -- list )
+    [
+        [ "Describe" | "describe-path"  ]
+        [ "Push"     | "lookup"         ]
+        [ "Execute"  | "lookup execute" ]
+        [ "jEdit"    | "lookup jedit"   ]
+        [ "Usages"   | "lookup usages." ]
+    ] ;
+
+: word-attrs ( word -- attrs )
+    #! Words without a vocabulary do not get a link or an action
+    #! popup.
+    dup word-vocabulary [
+        word-link [ "object-link" swons ] keep
+        word-actions <actions> "actions" swons
+        t "underline" swons
+        3list
+    ] [
+        drop [ ]
+    ] ifte ;
+
+: prettyprint-word ( word -- )
+    dup word-name
+    swap dup word-attrs swap word-style append
+    write-attr ;
+
 : prettyprint-[ ( indent -- indent )
         \ [ prettyprint-word <prettyprint ;
 
@@ -95,7 +129,8 @@ DEFER: prettyprint*
             prettyprint-list
         ] [
             [
-                "|" write prettyprint-space prettyprint-element
+                \ | prettyprint-word
+                prettyprint-space prettyprint-element
             ] when*
         ] ifte
     ] when* ;
@@ -133,52 +168,12 @@ DEFER: prettyprint*
         swap prettyprint-{{ swap prettyprint-list prettyprint-}}
     ] ifte ;
 
-: trim-newline ( str -- str )
-    dup ends-with-newline? dup [ nip ] [ drop ] ifte ;
-
-: prettyprint-comment ( comment -- )
-    trim-newline "comments" style write-attr ;
-
-: word-link ( word -- link )
-    [
-        "vocabularies'" ,
-        dup word-vocabulary ,
-        "'" ,
-        word-name ,
-    ] make-string ;
-
-: word-actions ( -- list )
-    [
-        [ "Describe" | "describe-path"  ]
-        [ "Push"     | "lookup"         ]
-        [ "Execute"  | "lookup execute" ]
-        [ "jEdit"    | "lookup jedit"   ]
-        [ "Usages"   | "lookup usages." ]
-    ] ;
-
-: word-attrs ( word -- attrs )
-    #! Words without a vocabulary do not get a link or an action
-    #! popup.
-    dup word-vocabulary [
-        word-link [ "object-link" swons ] keep
-        word-actions <actions> "actions" swons
-        t "underline" swons
-        3list
-    ] [
-        drop [ ]
-    ] ifte ;
-
-: prettyprint-word ( word -- )
-    dup word-name
-    swap dup word-attrs swap word-style append
-    write-attr ;
-
 : prettyprint-object ( indent obj -- indent )
     unparse write ;
 
 : prettyprint* ( indent obj -- indent )
     over prettyprint-limit >= [
-        unparse write
+        prettyprint-object
     ] [
         [
             [ f =        ] [ prettyprint-object ]
@@ -196,28 +191,6 @@ DEFER: prettyprint*
 : vocab-link ( vocab -- link )
     "vocabularies'" swap cat2 ;
 
-: vocab-attrs ( word -- attrs )
-    vocab-link "object-link" default-style acons ;
-
-: prettyprint-vocab ( vocab -- )
-    dup vocab-attrs write-attr ;
-
-: prettyprint-IN: ( indent word -- )
-    \ IN: prettyprint-word prettyprint-space
-    word-vocabulary prettyprint-vocab prettyprint-newline ;
-
-: prettyprint-: ( indent -- indent )
-    \ : prettyprint-word prettyprint-space
-    tab-size + ;
-
-: prettyprint-; ( indent -- indent )
-    \ ; prettyprint-word
-    tab-size - ;
-
-: prettyprint-plist ( word -- )
-    dup "parsing" word-property [ " parsing" write ] when
-    "inline" word-property [ " inline" write ] when ;
-
 : . ( obj -- )
     [
         "prettyprint-single-line" on
@@ -242,49 +215,3 @@ DEFER: prettyprint*
 : .b >bin print ;
 : .o >oct print ;
 : .h >hex print ;
-
-: stack-effect. ( word -- )
-    stack-effect [
-        " " write
-        [ CHAR: ( , , CHAR: ) , ] make-string prettyprint-comment
-    ] when* ;
-
-: documentation. ( indent word -- indent )
-    documentation [
-        "\n" split [
-            "#!" swap cat2 prettyprint-comment
-            dup prettyprint-newline
-        ] each
-    ] when* ;
-
-: prettyprint-docs ( indent word -- indent )
-    [
-        stack-effect. dup prettyprint-newline
-    ] keep documentation. ;
-
-: see-compound ( word -- )
-    0 swap
-    [ dupd prettyprint-IN: prettyprint-: ] keep
-    [ prettyprint-word ] keep
-    [ prettyprint-docs ] keep
-    [ word-parameter prettyprint-list prettyprint-; ] keep
-    prettyprint-plist prettyprint-newline ;
-
-: see-primitive ( word -- )
-    "PRIMITIVE: " write dup unparse write stack-effect. terpri ;
-
-: see-symbol ( word -- )
-    "SYMBOL: " write . ;
-
-: see-undefined ( word -- )
-    drop "Not defined" print ;
-
-: see ( name -- )
-    #! Show a word definition.
-    [
-        [ compound? ] [ see-compound ]
-        [ symbol? ] [ see-symbol ]
-        [ primitive? ] [ see-primitive ]
-        [ word? ] [ see-undefined ]
-        [ drop t ] [ "Not a word: " write . ]
-    ] cond ;

library/syntax/see.factor

@@ -0,0 +1,117 @@
+! :folding=indent:collapseFolds=1:
+
+! $Id$
+!
+! Copyright (C) 2003, 2004 Slava Pestov.
+! 
+! Redistribution and use in source and binary forms, with or without
+! modification, are permitted provided that the following conditions are met:
+! 
+! 1. Redistributions of source code must retain the above copyright notice,
+!    this list of conditions and the following disclaimer.
+! 
+! 2. Redistributions in binary form must reproduce the above copyright notice,
+!    this list of conditions and the following disclaimer in the documentation
+!    and/or other materials provided with the distribution.
+! 
+! THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
+! INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
+! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
+! DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+! PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
+! OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
+! WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
+! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
+! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+IN: prettyprint
+USE: combinators
+USE: lists
+USE: math
+USE: stack
+USE: stdio
+USE: strings
+USE: presentation
+USE: unparser
+USE: words
+
+! Prettyprinting words
+: vocab-attrs ( word -- attrs )
+    vocab-link "object-link" default-style acons ;
+
+: prettyprint-vocab ( vocab -- )
+    dup vocab-attrs write-attr ;
+
+: prettyprint-IN: ( indent word -- )
+    \ IN: prettyprint-word prettyprint-space
+    word-vocabulary prettyprint-vocab prettyprint-newline ;
+
+: prettyprint-: ( indent -- indent )
+    \ : prettyprint-word prettyprint-space
+    tab-size + ;
+
+: prettyprint-; ( indent -- indent )
+    \ ; prettyprint-word
+    tab-size - ;
+
+: prettyprint-prop ( word prop -- )
+    tuck word-name word-property [
+        prettyprint-space prettyprint-word
+    ] [
+        drop
+    ] ifte ;
+
+: prettyprint-plist ( word -- )
+    dup
+    \ parsing prettyprint-prop
+    \ inline prettyprint-prop ;
+
+: prettyprint-comment ( comment -- )
+    "comments" style write-attr ;
+
+: stack-effect. ( word -- )
+    stack-effect [
+        " " write
+        [ CHAR: ( , , CHAR: ) , ] make-string prettyprint-comment
+    ] when* ;
+
+: documentation. ( indent word -- indent )
+    documentation [
+        "\n" split [
+            "#!" swap cat2 prettyprint-comment
+            dup prettyprint-newline
+        ] each
+    ] when* ;
+
+: prettyprint-docs ( indent word -- indent )
+    [
+        stack-effect. dup prettyprint-newline
+    ] keep documentation. ;
+
+: see-compound ( word -- )
+    0 swap
+    [ dupd prettyprint-IN: prettyprint-: ] keep
+    [ prettyprint-word ] keep
+    [ prettyprint-docs ] keep
+    [ word-parameter prettyprint-list prettyprint-; ] keep
+    prettyprint-plist prettyprint-newline ;
+
+: see-primitive ( word -- )
+    "PRIMITIVE: " write dup unparse write stack-effect. terpri ;
+
+: see-symbol ( word -- )
+    \ SYMBOL: prettyprint-word . ;
+
+: see-undefined ( word -- )
+    drop "Not defined" print ;
+
+: see ( name -- )
+    #! Show a word definition.
+    [
+        [ compound? ] [ see-compound ]
+        [ symbol? ] [ see-symbol ]
+        [ primitive? ] [ see-primitive ]
+        [ word? ] [ see-undefined ]
+        [ drop t ] [ "Not a word: " write . ]
+    ] cond ;

library/vocabulary-style.factor

@@ -115,3 +115,6 @@ USE: words
     [ "ansi-fg" | "3" ]
     [ "fg" | [ 2 185 2 ] ]
 ] "vectors" set-vocab-style
+[
+    [ "fg" | [ 128 128 128 ] ]
+] "syntax" set-vocab-style