steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Minor improvements to tools.scaffold

db4
Slava Pestov 2008-09-24 19:05:03 -05:00
parent eae7e95d9b
commit 95bfec86e4
1 changed files with 14 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

35
basis/tools/scaffold/scaffold.factor
View File

@ -4,7 +4,7 @@ USING: assocs io.files hashtables kernel namespaces sequences
vocabs.loader io combinators io.encodings.utf8 calendar accessors vocabs.loader io combinators io.encodings.utf8 calendar accessors
math.parser io.streams.string ui.tools.operations quotations math.parser io.streams.string ui.tools.operations quotations
strings arrays prettyprint words vocabs sorting sets strings arrays prettyprint words vocabs sorting sets
classes math alien ; classes math alien urls splitting ascii ;
IN: tools.scaffold IN: tools.scaffold
SYMBOL: developer-name SYMBOL: developer-name
@ -89,17 +89,12 @@ ERROR: no-vocab vocab ;
] if ; ] if ;
: lookup-type ( string -- object/string ? ) : lookup-type ( string -- object/string ? )
"new" ?head drop [ [ CHAR: ' = ] [ digit? ] bi or ] trim-right
H{ H{
{ "object" object } { "obj" object } { "object" object } { "obj" object }
{ "obj1" object } { "obj2" object } { "quot" quotation }
{ "obj3" object } { "obj4" object } { "string" string }
{ "quot" quotation } { "quot1" quotation }
{ "quot2" quotation } { "quot3" quotation }
{ "quot'" quotation }
{ "string" string } { "string1" string }
{ "string2" string } { "string3" string }
{ "str" string } { "str" string }
{ "str1" string } { "str2" string } { "str3" string }
{ "hash" hashtable } { "hash" hashtable }
{ "hashtable" hashtable } { "hashtable" hashtable }
{ "?" "a boolean" } { "?" "a boolean" }
@ -111,16 +106,12 @@ ERROR: no-vocab vocab ;
{ "vocab" "a vocabulary specifier" } { "vocab" "a vocabulary specifier" }
{ "vocab-root" "a vocabulary root string" } { "vocab-root" "a vocabulary root string" }
{ "c-ptr" c-ptr } { "c-ptr" c-ptr }
{ "seq" sequence } { "seq1" sequence } { "seq2" sequence } { "seq" sequence }
{ "seq3" sequence } { "seq4" sequence } { "assoc" assoc }
{ "seq1'" sequence } { "seq2'" sequence }
{ "newseq" sequence }
{ "seq'" sequence }
{ "assoc" assoc } { "assoc1" assoc } { "assoc2" assoc }
{ "assoc3" assoc } { "newassoc" assoc }
{ "alist" "an array of key/value pairs" } { "alist" "an array of key/value pairs" }
{ "keys" sequence } { "values" sequence } { "keys" sequence } { "values" sequence }
{ "class" class } { "tuple" tuple } { "class" class } { "tuple" tuple }
{ "url" url }
} at* ; } at* ;
: add-using ( object -- ) : add-using ( object -- )
@ -158,7 +149,7 @@ ERROR: no-vocab vocab ;
"{ $description \"\" } ;" print ; "{ $description \"\" } ;" print ;
: help-header. ( word -- ) : help-header. ( word -- )
"HELP: " write . ; "HELP: " write name>> print ;
: (help.) ( word -- ) : (help.) ( word -- )
[ help-header. ] [ $values. ] [ $description. ] tri ; [ help-header. ] [ $values. ] [ $description. ] tri ;
@ -171,7 +162,7 @@ ERROR: no-vocab vocab ;
: interesting-words. ( vocab -- ) : interesting-words. ( vocab -- )
interesting-words [ (help.) nl ] each ; interesting-words [ (help.) nl ] each ;
: help-file-string ( str1 -- str2 ) : help-file-string ( vocab -- str2 )
[ [
{ {
[ "IN: " write print nl ] [ "IN: " write print nl ]
@ -185,16 +176,18 @@ ERROR: no-vocab vocab ;
} cleave } cleave
] with-string-writer ; ] with-string-writer ;
: write-using ( -- ) : write-using ( vocab -- )
"USING:" write "USING:" write
using get keys using get keys
{ "help.markup" "help.syntax" } append natural-sort { "help.markup" "help.syntax" } append natural-sort remove
[ bl write ] each [ bl write ] each
" ;" print ; " ;" print ;
: set-scaffold-help-file ( path vocab -- ) : set-scaffold-help-file ( path vocab -- )
swap utf8 <file-writer> [ swap utf8 <file-writer> [
scaffold-copyright help-file-string write-using write scaffold-copyright
[ help-file-string ] [ write-using ] bi
write
] with-output-stream ; ] with-output-stream ;
: check-scaffold ( vocab-root string -- vocab-root string ) : check-scaffold ( vocab-root string -- vocab-root string )