tools.scaffold: change scaffold-vocab to scaffold-vocab-in.

Adding scaffold-vocab to find an appropriate parent vocabulary's root to
create the new vocabulary in.

diff --git a/basis/tools/scaffold/scaffold-docs.factor b/basis/tools/scaffold/scaffold-docs.factor
index 2667d6b5db071fc3a5d95af1619b941a298ac3b0..c691b10fccf9b1067782d5eea7971183693503a6 100644 (file)
--- a/basis/tools/scaffold/scaffold-docs.factor
+++ b/basis/tools/scaffold/scaffold-docs.factor
@@ -95,11 +95,15 @@ HELP: scaffold-tests
 }
 { $description "Takes an existing vocabulary and creates an empty tests file help for each word. This word only works if no tests file yet exists." } ;
 
-HELP: scaffold-vocab
+HELP: scaffold-vocab-in
 { $values
     { "vocab-root" "a vocabulary root string" } { "string" string } }
 { $description "Creates a directory in the given root for a new vocabulary and adds a main .factor file and an authors.txt file." } ;
 
+HELP: scaffold-vocab
+{ $values { "string" string } }
+{ $description "Searches parent vocabularies for an appropriate root to create a new vocabulary and adds a main .factor file and an authors.txt file." } ;
+
 HELP: scaffold-emacs
 { $description "Touches the .emacs file in your home directory and provides a clickable link to open it in an editor." } ;
 

diff --git a/basis/tools/scaffold/scaffold.factor b/basis/tools/scaffold/scaffold.factor
index 214bfeb7c723d76f28bc0532384705702bb22d07..3e909098656fe45074ab3d2bf656d47c544b0d79 100644 (file)
--- a/basis/tools/scaffold/scaffold.factor
+++ b/basis/tools/scaffold/scaffold.factor
@@ -1,12 +1,13 @@
 ! 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
+classes classes.error combinators combinators.short-circuit
 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 ;
+math math.parser math.ranges 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
@@ -24,17 +25,17 @@ ERROR: vocab-must-not-exist string ;
 : ensure-vocab-exists ( string -- string )
     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-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 ;
 
 : 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 )
@@ -287,7 +288,7 @@ PRIVATE>
 : delete-from-root-cache ( string -- )
     root-cache get delete-at ;
 
-: scaffold-vocab ( vocab-root string -- )
+: scaffold-vocab-in ( vocab-root string -- )
     dup delete-from-root-cache
     {
         [ scaffold-directory ]
@@ -296,13 +297,28 @@ PRIVATE>
         [ 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  ;
+
+<PRIVATE
+
+: find-vocab-root-for  ( string -- vocab-root/f )
+    "." split dup length [1,b) [ head "." join ] with map
+    [ find-vocab-root ] map-find-last drop ;
+
+PRIVATE>
 
-: scaffold-work ( string -- ) "resource:work" swap scaffold-vocab ;
+: scaffold-vocab ( string -- )
+    [ find-vocab-root-for ] [ scaffold-vocab-in ] bi ;
 
 <PRIVATE