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

refactor tools.scaffold -- scaffold-help -> scaffold-docs, it takes a vocab name now

db4
sheeple 2009-02-22 00:19:10 -06:00
parent 785d7ac9af
commit 405b3dc1ad
1 changed files with 80 additions and 66 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -32,10 +32,37 @@ ERROR: no-vocab vocab ;
: check-root ( string -- string ) : check-root ( string -- string )
dup vocab-root? [ not-a-vocab-root ] unless ; dup vocab-root? [ not-a-vocab-root ] unless ;
: check-vocab ( vocab -- vocab )
dup find-vocab-root [ no-vocab ] unless ;
: check-vocab-root/vocab ( vocab-root string -- vocab-root string )
[ check-root ] [ check-vocab-name ] bi* ;
: replace-vocab-separators ( vocab -- path )
path-separator first CHAR: . associate substitute ; inline
: vocab-root/vocab>path ( vocab-root vocab -- path )
check-vocab-root/vocab
[ ] [ replace-vocab-separators ] bi* append-path ;
: vocab>path ( vocab -- path )
check-vocab
[ find-vocab-root ] keep vocab-root/vocab>path ;
: vocab-root/vocab/file>path ( vocab-root vocab file -- path )
[ vocab-root/vocab>path ] dip append-path ;
: vocab-root/vocab/suffix>path ( vocab-root vocab suffix -- path )
[ vocab-root/vocab>path dup file-name append-path ] dip append ;
: vocab/suffix>path ( vocab suffix -- path )
[ vocab>path dup file-name append-path ] dip append ;
: directory-exists ( path -- ) : directory-exists ( path -- )
"Not creating a directory, it already exists: " write print ; "Not creating a directory, it already exists: " write print ;
: scaffold-directory ( path -- ) : scaffold-directory ( vocab-root vocab -- )
vocab-root/vocab>path
dup exists? [ directory-exists ] [ make-directories ] if ; dup exists? [ directory-exists ] [ make-directories ] if ;
: not-scaffolding ( path -- path ) : not-scaffolding ( path -- path )
@ -44,11 +71,7 @@ ERROR: no-vocab vocab ;
: scaffolding ( path -- path ) : scaffolding ( path -- path )
"Creating scaffolding for " write dup <pathname> . ; "Creating scaffolding for " write dup <pathname> . ;
: (scaffold-path) ( path string -- path ) : scaffolding? ( path -- path ? )
[ dup file-name ] dip append append-path ;
: scaffold-path ( path string -- path ? )
(scaffold-path)
dup exists? [ not-scaffolding f ] [ scaffolding t ] if ; dup exists? [ not-scaffolding f ] [ scaffolding t ] if ;
: scaffold-copyright ( -- ) : scaffold-copyright ( -- )
@ -63,33 +86,21 @@ ERROR: no-vocab vocab ;
"IN: " write print "IN: " write print
] with-string-writer ; ] with-string-writer ;
: set-scaffold-main-file ( path vocab -- ) : set-scaffold-main-file ( vocab path -- )
main-file-string swap utf8 set-file-contents ; [ main-file-string ] dip utf8 set-file-contents ;
: scaffold-main ( path vocab -- ) : scaffold-main ( vocab-root vocab -- )
[ ".factor" scaffold-path ] dip tuck ".factor" vocab-root/vocab/suffix>path scaffolding? [
swap [ set-scaffold-main-file ] [ 2drop ] if ; set-scaffold-main-file
: tests-file-string ( vocab -- string )
[
scaffold-copyright
"USING: tools.test " write dup write " ;" print
"IN: " write write ".tests" print
] with-string-writer ;
: set-scaffold-tests-file ( path vocab -- )
tests-file-string swap utf8 set-file-contents ;
: scaffold-tests ( path vocab -- )
[ "-tests.factor" scaffold-path ] dip
swap [ set-scaffold-tests-file ] [ 2drop ] if ;
: scaffold-authors ( path -- )
"authors.txt" append-path dup exists? [
not-scaffolding drop
] [ ] [
scaffolding 2drop
developer-name get swap utf8 set-file-contents ] if ;
: scaffold-authors ( vocab-root vocab -- )
"authors.txt" vocab-root/vocab/file>path scaffolding? [
[ developer-name get ] dip utf8 set-file-contents
] [
drop
] if ; ] if ;
: lookup-type ( string -- object/string ? ) : lookup-type ( string -- object/string ? )
@ -155,11 +166,11 @@ ERROR: no-vocab vocab ;
drop drop
"{ $description \"\" } ;" print ; "{ $description \"\" } ;" print ;
: help-header. ( word -- ) : docs-header. ( word -- )
"HELP: " write name>> print ; "HELP: " write name>> print ;
: (help.) ( word -- ) : (docs.) ( word -- )
[ help-header. ] [ $values. ] [ $description. ] tri ; [ docs-header. ] [ $values. ] [ $description. ] tri ;
: interesting-words ( vocab -- array ) : interesting-words ( vocab -- array )
words words
@ -167,9 +178,9 @@ ERROR: no-vocab vocab ;
natural-sort ; natural-sort ;
: interesting-words. ( vocab -- ) : interesting-words. ( vocab -- )
interesting-words [ (help.) nl ] each ; interesting-words [ (docs.) nl ] each ;
: help-file-string ( vocab -- str2 ) : docs-file-string ( vocab -- str2 )
[ [
{ {
[ "IN: " write print nl ] [ "IN: " write print nl ]
@ -190,61 +201,64 @@ ERROR: no-vocab vocab ;
[ bl write ] each [ bl write ] each
" ;" print ; " ;" print ;
: set-scaffold-help-file ( path vocab -- ) : set-scaffold-docs-file ( vocab path -- )
swap utf8 <file-writer> [ utf8 <file-writer> [
scaffold-copyright scaffold-copyright
[ help-file-string ] [ write-using ] bi [ docs-file-string ] [ write-using ] bi
write write
] with-output-stream ; ] with-output-stream ;
: check-scaffold ( vocab-root string -- vocab-root string )
[ check-root ] [ check-vocab-name ] bi* ;
: vocab>scaffold-path ( vocab-root string -- path )
path-separator first CHAR: . associate substitute
append-path ;
: prepare-scaffold ( vocab-root string -- string path )
check-scaffold [ vocab>scaffold-path ] keep ;
: with-scaffold ( quot -- ) : with-scaffold ( quot -- )
[ H{ } clone using ] dip with-variable ; inline [ H{ } clone using ] dip with-variable ; inline
: check-vocab ( vocab -- vocab )
dup find-vocab-root [ no-vocab ] unless ;
PRIVATE> PRIVATE>
: link-vocab ( vocab -- ) : link-vocab ( vocab -- )
check-vocab check-vocab
"Edit documentation: " write "Edit documentation: " write
[ find-vocab-root ] "-docs.factor" vocab/suffix>path <pathname> . ;
[ vocab>scaffold-path ] bi
"-docs.factor" (scaffold-path) <pathname> . ;
: help. ( word -- ) : docs. ( word -- )
[ (help.) ] [ nl vocabulary>> link-vocab ] bi ; [ (docs.) ] [ nl vocabulary>> link-vocab ] bi ;
: scaffold-help ( string -- ) : scaffold-docs ( vocab -- )
[ [
[ find-vocab-root ] [ check-vocab ] bi dup "-docs.factor" vocab/suffix>path scaffolding? [
prepare-scaffold set-scaffold-docs-file
[ "-docs.factor" scaffold-path ] dip ] [
swap [ set-scaffold-help-file ] [ 2drop ] if 2drop
] if
] with-scaffold ; ] with-scaffold ;
: scaffold-undocumented ( string -- ) : scaffold-undocumented ( string -- )
[ interesting-words. ] [ link-vocab ] bi ; [ interesting-words. ] [ link-vocab ] bi ;
: scaffold-vocab ( vocab-root string -- ) : scaffold-vocab ( vocab-root vocab -- )
prepare-scaffold
{ {
[ drop scaffold-directory ] [ scaffold-directory ]
[ scaffold-main ] [ scaffold-main ]
[ drop scaffold-authors ] [ scaffold-authors ]
[ nip require ] [ nip require ]
} 2cleave ; } 2cleave ;
: tests-file-string ( vocab -- string )
[
scaffold-copyright
"USING: tools.test " write dup write " ;" print
"IN: " write write ".tests" print
] with-string-writer ;
: set-scaffold-tests-file ( vocab path -- )
[ tests-file-string ] dip utf8 set-file-contents ;
: scaffold-tests ( vocab -- )
dup "-tests.factor" vocab/suffix>path
scaffolding? [
set-scaffold-tests-file
] [
2drop
] if ;
SYMBOL: examples-flag SYMBOL: examples-flag
: example ( -- ) : example ( -- )