diff --git a/basis/tools/scaffold/scaffold-docs.factor b/basis/tools/scaffold/scaffold-docs.factor index 271b74b9f7..c070e5ec71 100644 --- a/basis/tools/scaffold/scaffold-docs.factor +++ b/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 diff --git a/basis/tools/scaffold/scaffold.factor b/basis/tools/scaffold/scaffold.factor index b14437a62c..d95af0fd68 100644 --- a/basis/tools/scaffold/scaffold.factor +++ b/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 "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 . ] bi ;