tools.scaffold: don't use sequences.extras.

[factor.git] / basis / tools / scaffold / scaffold.factor

diff --git a/basis/tools/scaffold/scaffold.factor b/basis/tools/scaffold/scaffold.factor
index 3e909098656fe45074ab3d2bf656d47c544b0d79..0b9e1e8085cb117048371bedac91c5a30b086b73 100644 (file)
--- a/basis/tools/scaffold/scaffold.factor
+++ b/basis/tools/scaffold/scaffold.factor
@@ -1,13 +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
-hashtables help.markup interpolate io io.directories
-io.encodings.utf8 io.files io.pathnames io.streams.string kernel
-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 ;
+continuations eval 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
@@ -58,7 +58,7 @@ ERROR: vocab-must-not-exist string ;
 
 : 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> . ;
@@ -67,7 +67,7 @@ ERROR: vocab-must-not-exist string ;
     "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
@@ -126,6 +126,11 @@ ERROR: vocab-must-not-exist string ;
         { "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 }
@@ -156,8 +161,8 @@ M: object add-using
                 [ 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
@@ -251,6 +256,7 @@ M: object add-using
     [ HS{ } clone using ] dip with-variable ; inline
 
 : link-vocab ( vocab -- )
+    ".private" ?tail drop
     check-vocab
     "Edit documentation: " write
     "-docs.factor" vocab/suffix>path <pathname> . ;
@@ -309,16 +315,10 @@ PRIVATE>
 : 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-vocab ( string -- )
-    [ find-vocab-root-for ] [ scaffold-vocab-in ] bi ;
+    "Choose a vocabulary root:" vocab-roots get
+    '[ [ "Use " prepend ] keep ] { } map>assoc throw-restarts
+    swap scaffold-vocab-in ;
 
 <PRIVATE
 
@@ -346,7 +346,7 @@ 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} ;\"
@@ -378,7 +378,7 @@ ${example-indent}}
     [ "Click to edit: " write <pathname> . ] bi ;
 
 : scaffold-rc ( path -- )
-    [ home ] dip append-path scaffold-file ;
+    home prepend-path scaffold-file ;
 
 : scaffold-factor-boot-rc ( -- )
     ".factor-boot-rc" scaffold-rc ;
@@ -392,6 +392,21 @@ ${example-indent}}
 : scaffold-factor-roots ( -- )
     ".factor-roots" scaffold-rc ;
 
+: make-unit-test ( answer code -- str )
+    [ split-lines [ "    " prepend ] map "\n" join ] bi@
+    [ "{\n" "\n}" surround ] [ "[\n" "\n] unit-test\n" surround ] bi*
+    " " glue ;
+
+: scaffold-unit-test ( -- str/f )
+    read-contents dup "" = [
+        drop f
+    ] [
+        [ eval( -- x ) unparse ] keep make-unit-test
+    ] if ;
+
+: scaffold-unit-tests ( -- str )
+    [ scaffold-unit-test dup ] [ ] produce nip "\n\n" join ;
+
 HOOK: scaffold-emacs os ( -- )
 
 M: unix scaffold-emacs ".emacs" scaffold-rc ;