tools.scaffold: Make a better scaffold-examples word in hopes it will cause more examples to get written. Add more docs. Fix spacing bug in scaffold-undocumented.

basis/tools/scaffold/scaffold-docs.factor

@@ -21,7 +21,50 @@ HELP: scaffold-undocumented
     { "string" string } }
 { $description "Prints scaffolding documentation for undocumented words in a vocabulary except for automatically generated class predicates." } ;
 
-{ scaffold-docs scaffold-undocumented } related-words
+{ scaffold-docs scaffold-undocumented scaffold-examples } related-words
+
+HELP: scaffold-examples
+{ $values
+    { "word" word }
+}
+{ $description "Create some examples for a word with a using list that includes vocabularies the word is in and the " { $vocab-link "prettyprint" } " vocabulary. You are then expected to change the header " { $snippet "Example:" } " to something more descriptive." }
+{ $examples
+    "Create docs for the + word:"
+    { $example "USING: math tools.scaffold prettyprint ;"
+        "\\ + scaffold-examples"
+        """{ $examples
+    "Example:"
+    { $example "USING: math prettyprint ;"
+        ""
+        ""
+    }
+    "Example:"
+    { $example "USING: math prettyprint ;"
+        ""
+        ""
+    }
+}"""
+    }
+} ;
+
+HELP: scaffold-core
+{ $values
+    { "string" string }
+}
+{ $description "Create a placeholder vocabulary in the core vocabulary root." } ;
+
+HELP: scaffold-basis
+{ $values
+    { "string" string }
+}
+{ $description "Create a placeholder vocabulary in the basis vocabulary root." } ;
+
+HELP: scaffold-extra
+{ $values
+    { "string" string }
+}
+{ $description "Create a placeholder vocabulary in the extra vocabulary root." } ;
+
 
 HELP: scaffold-authors
 { $values
@@ -77,11 +120,13 @@ ARTICLE: "tools.scaffold" "Scaffold tool"
 "Scaffold setup:"
 { $subsections developer-name }
 "Generate new vocabs:"
-{ $subsections scaffold-vocab }
+{ $subsections scaffold-vocab scaffold-core scaffold-basis scaffold-extra }
 "Generate help scaffolding:"
 { $subsections
     scaffold-docs
     scaffold-undocumented
+    scaffold-examples
+    scaffold-n-examples
     help.
 }
 "Types that are unrecognized by the scaffold generator will be of type " { $link null } ". The developer should change these to strings that describe the stack effect names instead." $nl

basis/tools/scaffold/scaffold.factor

@@ -1,12 +1,12 @@
 ! Copyright (C) 2008 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: assocs io.files io.pathnames io.directories
-io.encodings.utf8 hashtables kernel namespaces sequences
-vocabs.loader vocabs.metadata io combinators calendar accessors
-math.parser io.streams.string ui.tools.operations quotations
-strings arrays prettyprint words vocabs sorting sets classes
-math alien urls splitting ascii combinators.short-circuit timers
-words.symbol system summary ;
+USING: accessors alien arrays assocs calendar classes
+combinators combinators.short-circuit fry hashtables interpolate
+io io.directories io.encodings.utf8 io.files io.pathnames
+io.streams.string kernel math math.parser namespaces prettyprint
+quotations sequences sets sorting splitting strings system
+timers unicode.categories urls vocabs vocabs.loader
+vocabs.metadata words words.symbol ;
 FROM: sets => members ;
 IN: tools.scaffold
 
@@ -144,23 +144,26 @@ ERROR: vocab-name-contains-dot path ;
 : add-using ( object -- )
     vocabulary>> using get [ adjoin ] [ drop ] if* ;
 
-: ($values.) ( array -- )
-    [ bl ] [
-        "{ " write
-        dup array? [ first ] when
-        dup lookup-type [
-            [ unparse write bl ]
-            [ [ pprint ] [ dup string? [ drop ] [ add-using ] if ] bi ] bi*
-        ] [
-            drop unparse write bl null pprint
-            null add-using
-        ] if
-        " }" write
-    ] interleave ;
-
 : 4bl ( -- )
     "    " write ; inline
 
+: ($values.) ( array -- )
+    [
+        4bl
+        [ bl ] [
+            "{ " write
+            dup array? [ first ] when
+            dup lookup-type [
+                [ unparse write bl ]
+                [ [ pprint ] [ dup string? [ drop ] [ add-using ] if ] bi ] bi*
+            ] [
+                drop unparse write bl null pprint
+                null add-using
+            ] if
+            " }" write
+        ] interleave
+    ] unless-empty ;
+
 : ?print-nl ( seq1 seq2 -- )
     [ empty? ] either? [ nl ] unless ;
 
@@ -172,9 +175,9 @@ ERROR: vocab-name-contains-dot path ;
         ] [
             [ members ] dip over diff
             "{ $values" print
-            [ drop 4bl ($values.) ]
+            [ drop ($values.) ]
             [ ?print-nl ]
-            [ nip 4bl ($values.) ] 2tri
+            [ nip ($values.) ] 2tri
             nl "}" print
         ] if
     ] when* ;
@@ -313,23 +316,36 @@ PRIVATE>
         2drop
     ] if ;
 
-SYMBOL: examples-flag
+SYMBOL: nested-examples
 
-: example ( -- )
-    {
-        "{ $example \"\" \"USING: prettyprint ;\""
-        "           \"\""
-        "           \"\""
-        "}"
-    } [ examples-flag get [ 4bl ] when print ] each ;
+: example-using ( using -- )
+    " " join "example-using" [
+        nested-examples get 4 0 ? CHAR: \s <string> "example-indent" [
+            """${example-indent}"Example:"
+${example-indent}{ $example "USING: ${example-using} ;"
+${example-indent}    ""
+${example-indent}    ""
+${example-indent}}
+"""
+            interpolate
+        ] with-variable
+    ] with-variable ;
 
-: examples ( n -- )
-    t \ examples-flag [
-        "{ $examples " print
-        [ example ] times
+: n-examples-using ( n using -- )
+    '[ _ example-using ] times ;
+
+: scaffold-n-examples ( n word -- )
+    vocabulary>> "prettyprint" 2array
+    [ t nested-examples ] 2dip
+    '[
+        "{ $examples" print
+        _ _ n-examples-using
         "}" print
     ] with-variable ;
 
+: scaffold-examples ( word -- )
+    2 swap scaffold-n-examples ;
+
 : touch. ( path -- )
     [ touch-file ]
     [ "Click to edit: " write <pathname> . ] bi ;