! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
+
USING: accessors alien arrays assocs byte-arrays calendar
-classes classes.error combinators combinators.short-circuit fry
-hashtables help.markup 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 urls vocabs
-vocabs.loader vocabs.metadata words words.symbol ;
+classes classes.error combinators combinators.short-circuit
+continuations hashtables help.markup 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 urls vocabs vocabs.loader vocabs.metadata words
+words.symbol ;
IN: tools.scaffold
SYMBOL: developer-name
trim-tail-separators vocab-roots get member? ;
: ensure-vocab-exists ( string -- string )
- dup loaded-vocab-names member? [ no-vocab ] unless ;
+ dup lookup-vocab [ no-vocab ] unless ;
-: check-root ( string -- string )
+: check-vocab-root ( string -- string )
dup vocab-root? [ not-a-vocab-root ] unless ;
-: check-vocab-root/vocab ( vocab-root string -- vocab-root string )
- [ check-root ] [ check-vocab-name ] bi* ;
-
-: check-vocab-exists ( string -- string )
- dup vocab-exists? [ vocab-must-not-exist ] when ;
+: check-vocab-root/name ( vocab-root string -- vocab-root string )
+ [ check-vocab-root ] [ check-vocab-name ] bi* ;
: replace-vocab-separators ( vocab -- path )
- path-separator first CHAR: . associate substitute ; inline
+ path-separator first CHAR: . associate substitute ;
: vocab-root/vocab>path ( vocab-root vocab -- path )
- check-vocab-root/vocab
+ check-vocab-root/name
[ ] [ replace-vocab-separators ] bi* append-path ;
: vocab>path ( vocab -- path )
: scaffold-directory ( vocab-root vocab -- )
vocab-root/vocab>path
- dup exists? [ directory-exists ] [ make-directories ] if ;
+ dup file-exists? [ directory-exists ] [ make-directories ] if ;
: not-scaffolding ( path -- path )
"Not creating scaffolding for " write dup <pathname> . ;
"Creating scaffolding for " write dup <pathname> . ;
: scaffolding? ( path -- path ? )
- dup exists? [ not-scaffolding f ] [ scaffolding t ] if ;
+ dup file-exists? [ not-scaffolding f ] [ scaffolding t ] if ;
: scaffold-copyright ( -- )
"! Copyright (C) " write now year>> number>string write
{ "vocab-root" "a vocabulary root string" }
{ "c-ptr" c-ptr }
{ "sequence" sequence }
+ { "slice" slice }
+ { "from" integer }
+ { "to" integer }
+ { "i" integer }
+ { "n" integer }
{ "seq" sequence }
{ "exemplar" object }
{ "assoc" assoc }
M: string add-using drop ;
-M: object add-using ( object -- )
+M: object add-using
vocabulary>> using get [ adjoin ] [ drop ] if* ;
: ($values.) ( array -- )
[ unparse write bl ]
[ [ pprint ] [ add-using ] bi ] bi*
] [
- drop unparse write bl null pprint
- null add-using
+ drop unparse write bl object pprint
+ object add-using
] if
" }" write
] interleave
[ HS{ } clone using ] dip with-variable ; inline
: link-vocab ( vocab -- )
+ ".private" ?tail drop
check-vocab
"Edit documentation: " write
"-docs.factor" vocab/suffix>path <pathname> . ;
: scaffold-platforms ( vocab platforms -- )
[ "platforms.txt" ] dip scaffold-metadata ;
-: scaffold-vocab ( vocab-root string -- )
- check-vocab-exists {
+: delete-from-root-cache ( string -- )
+ root-cache get delete-at ;
+
+: scaffold-vocab-in ( vocab-root string -- )
+ dup delete-from-root-cache
+ {
[ scaffold-directory ]
[ scaffold-main ]
[ nip require ]
[ nip scaffold-authors ]
} 2cleave ;
-: scaffold-core ( string -- ) "resource:core" swap scaffold-vocab ;
+: scaffold-core ( string -- )
+ "resource:core" swap scaffold-vocab-in ;
+
+: scaffold-basis ( string -- )
+ "resource:basis" swap scaffold-vocab-in ;
-: scaffold-basis ( string -- ) "resource:basis" swap scaffold-vocab ;
+: scaffold-extra ( string -- )
+ "resource:extra" swap scaffold-vocab-in ;
-: scaffold-extra ( string -- ) "resource:extra" swap scaffold-vocab ;
+: scaffold-work ( string -- )
+ "resource:work" swap scaffold-vocab-in ;
-: scaffold-work ( string -- ) "resource:work" swap scaffold-vocab ;
+: scaffold-vocab ( string -- )
+ "Choose a vocabulary root:" vocab-roots get
+ '[ [ "Use " prepend ] keep ] { } map>assoc throw-restarts
+ swap scaffold-vocab-in ;
<PRIVATE
SYMBOL: nested-examples
: example-using ( using -- )
- " " join "example-using" [
+ join-words "example-using" [
nested-examples get 4 0 ? CHAR: \s <string> "example-indent" [
"${example-indent}\"Example:\"
${example-indent}{ $example \"USING: ${example-using} ;\"
[ touch-file ]
[ "Click to edit: " write <pathname> . ] bi ;
+: scaffold-rc ( path -- )
+ home prepend-path scaffold-file ;
+
: scaffold-factor-boot-rc ( -- )
- "~/.factor-boot-rc" scaffold-file ;
+ ".factor-boot-rc" scaffold-rc ;
: scaffold-factor-rc ( -- )
- "~/.factor-rc" scaffold-file ;
+ ".factor-rc" scaffold-rc ;
: scaffold-mason-rc ( -- )
- "~/.factor-mason-rc" scaffold-file ;
+ ".factor-mason-rc" scaffold-rc ;
: scaffold-factor-roots ( -- )
- "~/.factor-roots" scaffold-file ;
+ ".factor-roots" scaffold-rc ;
HOOK: scaffold-emacs os ( -- )
-M: unix scaffold-emacs ( -- ) "~/.emacs" scaffold-file ;
+M: unix scaffold-emacs ".emacs" scaffold-rc ;