Merge branch 'master' of git://factorcode.org/git/factor

basis/db/errors/errors.factor

@@ -1,18 +1,54 @@
 ! Copyright (C) 2008 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel ;
+USING: accessors kernel continuations fry words ;
 IN: db.errors
 
 ERROR: db-error ;
-ERROR: sql-error ;
+ERROR: sql-error location ;
 
-ERROR: table-exists ;
 ERROR: bad-schema ;
 
-ERROR: sql-syntax-error error ;
+ERROR: sql-unknown-error < sql-error message ;
+: <sql-unknown-error> ( message -- error )
+    \ sql-unknown-error new
+        swap >>message ;
 
-ERROR: sql-table-exists table ;
-C: <sql-table-exists> sql-table-exists
+ERROR: sql-table-exists < sql-error table ;
+: <sql-table-exists> ( table -- error )
+    \ sql-table-exists new
+        swap >>table ;
 
-ERROR: sql-table-missing table ;
-C: <sql-table-missing> sql-table-missing
+ERROR: sql-table-missing < sql-error table ;
+: <sql-table-missing> ( table -- error )
+    \ sql-table-missing new
+        swap >>table ;
+
+ERROR: sql-syntax-error < sql-error message ;
+: <sql-syntax-error> ( message -- error )
+    \ sql-syntax-error new
+        swap >>message ;
+
+ERROR: sql-function-exists < sql-error message ;
+: <sql-function-exists> ( message -- error )
+    \ sql-function-exists new
+        swap >>message ;
+
+ERROR: sql-function-missing < sql-error message ;
+: <sql-function-missing> ( message -- error )
+    \ sql-function-missing new
+        swap >>message ;
+
+: ignore-error ( quot word -- )
+    '[ dup _ execute [ drop ] [ rethrow ] if ] recover ; inline
+
+: ignore-table-exists ( quot -- )
+    \ sql-table-exists? ignore-error ; inline
+
+: ignore-table-missing ( quot -- )
+    \ sql-table-missing? ignore-error ; inline
+
+: ignore-function-exists ( quot -- )
+    \ sql-function-exists? ignore-error ; inline
+
+: ignore-function-missing ( quot -- )
+    \ sql-function-missing? ignore-error ; inline

basis/db/errors/postgresql/postgresql-tests.factor

@@ -1,4 +1,32 @@
 ! Copyright (C) 2009 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: tools.test db.errors.postgresql ;
+USING: accessors combinators.short-circuit db db.errors
+db.errors.postgresql db.postgresql io.files.unique kernel namespaces
+tools.test db.tester continuations ;
 IN: db.errors.postgresql.tests
+
+postgresql-test-db [
+
+    [ "drop table foo;" sql-command ] ignore-errors
+    [ "drop table ship;" sql-command ] ignore-errors
+
+    [
+        "insert into foo (id) values('1');" sql-command
+    ] [
+        { [ sql-table-missing? ] [ table>> "foo" = ] } 1&&
+    ] must-fail-with
+
+    [
+        "create table ship(id integer);" sql-command
+        "create table ship(id integer);" sql-command
+    ] [
+        { [ sql-table-exists? ] [ table>> "ship" = ] } 1&&
+    ] must-fail-with
+    
+    [
+        "create table foo(id) lol;" sql-command
+    ] [
+        sql-syntax-error?
+    ] must-fail-with
+
+] with-db

basis/db/errors/postgresql/postgresql.factor

@@ -1,4 +1,53 @@
 ! Copyright (C) 2009 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: ;
+USING: kernel db.errors peg.ebnf strings sequences math
+combinators.short-circuit accessors math.parser quoting ;
 IN: db.errors.postgresql
+
+EBNF: parse-postgresql-sql-error
+
+Error = "ERROR:" [ ]+
+
+TableError =
+    Error ("relation "|"table ")(!(" already exists").)+:table " already exists"
+        => [[ table >string unquote <sql-table-exists> ]]
+    | Error ("relation "|"table ")(!(" does not exist").)+:table " does not exist"
+        => [[ table >string unquote <sql-table-missing> ]]
+
+FunctionError =
+    Error "function" (!(" already exists").)+:table " already exists"
+        => [[ table >string <sql-function-exists> ]]
+    | Error "function" (!(" does not exist").)+:table " does not exist"
+        => [[ table >string <sql-function-missing> ]]
+
+SyntaxError =
+    Error "syntax error at end of input":error
+        => [[ error >string <sql-syntax-error> ]]
+    | Error "syntax error at or near " .+:syntaxerror
+        => [[ syntaxerror >string unquote <sql-syntax-error> ]]
+
+UnknownError = .* => [[ >string <sql-unknown-error> ]]
+
+PostgresqlSqlError = (TableError | FunctionError | SyntaxError | UnknownError) 
+
+;EBNF
+
+
+ERROR: parse-postgresql-location column line text ;
+C: <parse-postgresql-location> parse-postgresql-location
+
+EBNF: parse-postgresql-line-error
+
+Line = "LINE " [0-9]+:line ": " .+:sql
+    => [[ f line >string string>number sql >string <parse-postgresql-location> ]] 
+
+;EBNF
+
+:: set-caret-position ( error caret-line -- error )
+    caret-line length
+    error line>> number>string length "LINE : " length +
+    - [ error ] dip >>column ;
+
+: postgresql-location ( line column -- obj )
+    [ parse-postgresql-line-error ] dip
+    set-caret-position ;

basis/db/postgresql/postgresql-tests.factor

@@ -1,15 +1,8 @@
 USING: kernel db.postgresql alien continuations io classes
 prettyprint sequences namespaces tools.test db db.private
-db.tuples db.types unicode.case accessors system ;
+db.tuples db.types unicode.case accessors system db.tester ;
 IN: db.postgresql.tests
 
-: postgresql-test-db ( -- postgresql-db )
-    <postgresql-db>
-        "localhost" >>host
-        "postgres" >>username
-        "thepasswordistrust" >>password
-        "factor-test" >>database ;
-
 os windows? cpu x86.64? and [
     [ ] [ postgresql-test-db [ ] with-db ] unit-test
 

basis/db/postgresql/postgresql.factor

@@ -6,7 +6,7 @@ sequences debugger db db.postgresql.lib db.postgresql.ffi
 db.tuples db.types tools.annotations math.ranges
 combinators classes locals words tools.walker db.private
 nmake accessors random db.queries destructors db.tuples.private
-db.postgresql ;
+db.postgresql db.errors.postgresql splitting ;
 IN: db.postgresql
 
 TUPLE: postgresql-db host port pgopts pgtty database username password ;
@@ -282,4 +282,12 @@ M: postgresql-db-connection compound ( string object -- string' )
     } case ;
 
 M: postgresql-db-connection parse-db-error
-    ;
+    "\n" split dup length {
+        { 1 [ first parse-postgresql-sql-error ] }
+        { 3 [
+                first3
+                [ parse-postgresql-sql-error ] 2dip
+                postgresql-location >>location
+        ] }
+    } case ;
+

basis/db/sqlite/lib/lib.factor

@@ -11,12 +11,17 @@ IN: db.sqlite.lib
 ERROR: sqlite-error < db-error n string ;
 ERROR: sqlite-sql-error < sql-error n string ;
 
+: <sqlite-sql-error> ( n string -- error )
+    \ sqlite-sql-error new
+        swap >>string
+        swap >>n ;
+
 : throw-sqlite-error ( n -- * )
     dup sqlite-error-messages nth sqlite-error ;
 
 : sqlite-statement-error ( -- * )
     SQLITE_ERROR
-    db-connection get handle>> sqlite3_errmsg sqlite-sql-error ;
+    db-connection get handle>> sqlite3_errmsg <sqlite-sql-error> throw ;
 
 : sqlite-check-result ( n -- )
     {

basis/db/tester/tester.factor

@@ -2,9 +2,42 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: concurrency.combinators db.pools db.sqlite db.tuples
 db.types kernel math random threads tools.test db sequences
-io prettyprint ;
+io prettyprint db.postgresql db.sqlite accessors io.files.temp
+namespaces fry system ;
 IN: db.tester
 
+: postgresql-test-db ( -- postgresql-db )
+    <postgresql-db>
+        "localhost" >>host
+        "postgres" >>username
+        "thepasswordistrust" >>password
+        "factor-test" >>database ;
+
+: sqlite-test-db ( -- sqlite-db )
+    "tuples-test.db" temp-file <sqlite-db> ;
+
+
+! These words leak resources, but are useful for interactivel testing
+: set-sqlite-db ( -- )
+    sqlite-db db-open db-connection set ;
+
+: set-postgresql-db ( -- )
+    postgresql-db db-open db-connection set ;
+
+
+: test-sqlite ( quot -- )
+    '[
+        [ ] [ sqlite-test-db _ with-db ] unit-test
+    ] call ; inline
+
+: test-postgresql ( quot -- )
+    '[
+        os windows? cpu x86.64? and [
+            [ ] [ postgresql-test-db _ with-db ] unit-test
+        ] unless
+    ] call ; inline
+
+
 TUPLE: test-1 id a b c ;
 
 test-1 "TEST1" {
@@ -23,9 +56,6 @@ test-2 "TEST2" {
    { "z" "Z" { VARCHAR 256 } +not-null+ }
 } define-persistent
 
-: sqlite-test-db ( -- db ) "test.db" <sqlite-db> ;
-: test-db ( -- db ) "test.db" <sqlite-db> ;
-
 : db-tester ( test-db -- )
     [
         [

basis/db/tuples/tuples-tests.factor

@@ -4,40 +4,10 @@ USING: io.files io.files.temp kernel tools.test db db.tuples classes
 db.types continuations namespaces math math.ranges
 prettyprint calendar sequences db.sqlite math.intervals
 db.postgresql accessors random math.bitwise system
-math.ranges strings urls fry db.tuples.private db.private ;
+math.ranges strings urls fry db.tuples.private db.private
+db.tester ;
 IN: db.tuples.tests
 
-: sqlite-db ( -- sqlite-db )
-    "tuples-test.db" temp-file <sqlite-db> ;
-
-: test-sqlite ( quot -- )
-    '[
-        [ ] [
-            "tuples-test.db" temp-file <sqlite-db> _ with-db
-        ] unit-test
-    ] call ; inline
-
-: postgresql-db ( -- postgresql-db )
-    <postgresql-db>
-        "localhost" >>host
-        "postgres" >>username
-        "thepasswordistrust" >>password
-        "factor-test" >>database ;
-
-: test-postgresql ( quot -- )
-    '[
-        os windows? cpu x86.64? and [
-            [ ] [ postgresql-db _ with-db ] unit-test
-        ] unless
-    ] call ; inline
-
-! These words leak resources, but are useful for interactivel testing 
-: sqlite-test-db ( -- )
-    sqlite-db db-open db-connection set ;
-
-: postgresql-test-db ( -- )
-    postgresql-db db-open db-connection set ;
-
 TUPLE: person the-id the-name the-number the-real
 ts date time blob factor-blob url ;
 

basis/db/tuples/tuples.factor

@@ -4,7 +4,7 @@ USING: arrays assocs classes db kernel namespaces
 classes.tuple words sequences slots math accessors
 math.parser io prettyprint db.types continuations
 destructors mirrors sets db.types db.private fry
-combinators.short-circuit ;
+combinators.short-circuit db.errors ;
 IN: db.tuples
 
 HOOK: create-sql-statement db-connection ( class -- object )
@@ -118,13 +118,15 @@ ERROR: no-defined-persistent object ;
     ensure-defined-persistent
     [
         '[
-            _ drop-sql-statement [ execute-statement ] with-disposals
-        ] ignore-errors
+            [
+                _ drop-sql-statement [ execute-statement ] with-disposals
+            ] ignore-table-missing
+        ] ignore-function-missing
     ] [ create-table ] bi ;
 
 : ensure-table ( class -- )
     ensure-defined-persistent
-    '[ _ create-table ] ignore-errors ;
+    '[ [ _ create-table ] ignore-table-exists ] ignore-function-exists ;
 
 : ensure-tables ( classes -- ) [ ensure-table ] each ;
 

basis/mime/multipart/multipart.factor

@@ -3,7 +3,8 @@
 USING: multiline kernel sequences io splitting fry namespaces
 http.parsers hashtables assocs combinators ascii io.files.unique
 accessors io.encodings.binary io.files byte-arrays math
-io.streams.string combinators.short-circuit strings math.order ;
+io.streams.string combinators.short-circuit strings math.order
+quoting ;
 IN: mime.multipart
 
 CONSTANT: buffer-size 65536
@@ -75,18 +76,6 @@ ERROR: end-of-stream multipart ;
 : empty-name? ( string -- ? )
     { "''" "\"\"" "" f } member? ;
 
-: quote? ( ch -- ? ) "'\"" member? ;
-
-: quoted? ( str -- ? )
-    {
-        [ length 1 > ]
-        [ first quote? ]
-        [ [ first ] [ peek ] bi = ]
-    } 1&& ;
-
-: unquote ( str -- newstr )
-    dup quoted? [ but-last-slice rest-slice >string ] when ;
-
 : save-uploaded-file ( multipart -- )
     dup filename>> empty-name? [
         drop

basis/quoting/authors.txt

@@ -0,0 +1 @@
+Doug Coleman

basis/quoting/quoting-docs.factor

@@ -0,0 +1,32 @@
+! Copyright (C) 2009 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: help.markup help.syntax strings ;
+IN: quoting
+
+HELP: quote?
+{ $values
+     { "ch" "a character" }
+     { "?" "a boolean" }
+}
+{ $description "Returns true if the character is a single or double quote." } ;
+
+HELP: quoted?
+{ $values
+     { "str" string }
+     { "?" "a boolean" }
+}
+{ $description "Returns true if a string is surrounded by matching single or double quotes as the first and last characters." } ;
+
+HELP: unquote
+{ $values
+     { "str" string }
+     { "newstr" string }
+}
+{ $description "Removes a pair of matching single or double quotes from a string." } ;
+
+ARTICLE: "quoting" "Quotation marks"
+"The " { $vocab-link "quoting" } " vocabulary is for removing quotes from a string." $nl
+"Removing quotes:"
+{ $subsection unquote } ;
+
+ABOUT: "quoting"

basis/quoting/quoting-tests.factor

@@ -0,0 +1,10 @@
+! Copyright (C) 2009 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: tools.test quoting ;
+IN: quoting.tests
+
+
+[ "abc" ] [ "'abc'" unquote ] unit-test
+[ "abc" ] [ "\"abc\"" unquote ] unit-test
+[ "'abc" ] [ "'abc" unquote ] unit-test
+[ "abc'" ] [ "abc'" unquote ] unit-test

basis/quoting/quoting.factor

@@ -0,0 +1,16 @@
+! Copyright (C) 2009 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: combinators.short-circuit kernel math sequences strings ;
+IN: quoting
+
+: quote? ( ch -- ? ) "'\"" member? ;
+
+: quoted? ( str -- ? )
+    {
+        [ length 1 > ]
+        [ first quote? ]
+        [ [ first ] [ peek ] bi = ]
+    } 1&& ;
+
+: unquote ( str -- newstr )
+    dup quoted? [ but-last-slice rest-slice >string ] when ;

basis/tools/scaffold/scaffold-docs.factor

@@ -1,6 +1,6 @@
 ! Copyright (C) 2008 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: help.markup help.syntax kernel strings words ;
+USING: help.markup help.syntax kernel strings words vocabs ;
 IN: tools.scaffold
 
 HELP: developer-name
@@ -13,7 +13,7 @@ HELP: help.
 { $description "Prints out scaffold help markup for a given word." } ;
 
 HELP: scaffold-help
-{ $values { "string" string } }
+{ $values { "vocab" vocab } }
 { $description "Takes an existing vocabulary and creates a help file with scaffolded help for each word. This word only works if no help file yet exists." } ;
 
 HELP: scaffold-undocumented
@@ -28,6 +28,21 @@ HELP: scaffold-vocab
      { "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, a tests 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." } ;
+
+HELP: scaffold-factor-boot-rc
+{ $description "Touches the .factor-boot-rc file in your home directory and provides a clickable link to open it in an editor." } ;
+
+HELP: scaffold-factor-rc
+{ $description "Touches the .factor-rc file in your home directory and provides a clickable link to open it in an editor." } ;
+
+HELP: scaffold-rc
+{ $values
+     { "path" "a pathname string" }
+}
+{ $description "Touches the given path in your home directory and provides a clickable link to open it in an editor." } ;
+
 HELP: using
 { $description "Stores the vocabularies that are pulled into the documentation file from looking up the stack effect types." } ;
 
@@ -40,7 +55,12 @@ ARTICLE: "tools.scaffold" "Scaffold tool"
 { $subsection scaffold-help }
 { $subsection scaffold-undocumented }
 { $subsection help. }
-"Types that are unrecognized by the scaffold generator will be of type " { $link null } ". The developer should change these to strings that describe the stack effect names instead."
+"Types that are unrecognized by the scaffold generator will be of type " { $link null } ". The developer should change these to strings that describe the stack effect names instead." $nl
+"Scaffolding a configuration file:"
+{ $subsection scaffold-rc }
+{ $subsection scaffold-factor-boot-rc }
+{ $subsection scaffold-factor-rc }
+{ $subsection scaffold-emacs }
 ;
 
 ABOUT: "tools.scaffold"

basis/tools/scaffold/scaffold.factor

@@ -5,7 +5,7 @@ io.encodings.utf8 hashtables kernel namespaces sequences
 vocabs.loader io combinators calendar accessors math.parser
 io.streams.string ui.tools.operations quotations strings arrays
 prettyprint words vocabs sorting sets classes math alien urls
-splitting ascii ;
+splitting ascii combinators.short-circuit ;
 IN: tools.scaffold
 
 SYMBOL: developer-name
@@ -18,37 +18,61 @@ ERROR: no-vocab vocab ;
 
 <PRIVATE
 
-: root? ( string -- ? ) vocab-roots get member? ;
+: vocab-root? ( string -- ? ) vocab-roots get member? ;
 
 : contains-dot? ( string -- ? ) ".." swap subseq? ;
 
 : contains-separator? ( string -- ? ) [ path-separator? ] any? ;
 
 : check-vocab-name ( string -- string )
-    dup contains-dot? [ vocab-name-contains-dot ] when
-    dup contains-separator? [ vocab-name-contains-separator ] when ;
+    [ ]
+    [ contains-dot? [ vocab-name-contains-dot ] when ]
+    [ contains-separator? [ vocab-name-contains-separator ] when ] tri ;
 
 : check-root ( string -- string )
-    dup 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 -- )
     "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 ;
 
-: not-scaffolding ( path -- )
-    "Not creating scaffolding for " write <pathname> . ;
+: not-scaffolding ( path -- path )
+    "Not creating scaffolding for " write dup <pathname> . ;
 
-: scaffolding ( path -- )
-    "Creating scaffolding for " write <pathname> . ;
+: scaffolding ( path -- path )
+    "Creating scaffolding for " write dup <pathname> . ;
 
-: (scaffold-path) ( path string -- path )
-    dupd [ file-name ] dip append append-path ;
-
-: scaffold-path ( path string -- path ? )
-    (scaffold-path)
-    dup exists? [ dup not-scaffolding f ] [ dup scaffolding t ] if ;
+: scaffolding? ( path -- path ? )
+    dup exists? [ not-scaffolding f ] [ scaffolding t ] if ;
 
 : scaffold-copyright ( -- )
     "! Copyright (C) " write now year>> number>string write
@@ -62,37 +86,25 @@ ERROR: no-vocab vocab ;
         "IN: " write print
     ] with-string-writer ;
 
-: set-scaffold-main-file ( path vocab -- )
-    main-file-string swap utf8 set-file-contents ;
+: set-scaffold-main-file ( vocab path -- )
+    [ main-file-string ] dip utf8 set-file-contents ;
 
-: scaffold-main ( path vocab -- )
-    [ ".factor" scaffold-path ] dip
-    swap [ set-scaffold-main-file ] [ 2drop ] if ;
-
-: 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
+: scaffold-main ( vocab-root vocab -- )
+    tuck ".factor" vocab-root/vocab/suffix>path scaffolding? [
+        set-scaffold-main-file
     ] [
-        dup scaffolding
-        developer-name get swap utf8 set-file-contents
+        2drop
+    ] if ;
+
+: scaffold-authors ( vocab-root vocab -- )
+    "authors.txt" vocab-root/vocab/file>path scaffolding? [
+        [ developer-name get ] dip utf8 set-file-contents
+    ] [
+        drop
     ] if ;
 
 : lookup-type ( string -- object/string ? )
-    "new" ?head drop [ [ CHAR: ' = ] [ digit? ] bi or ] trim-tail
+    "new" ?head drop [ { [ CHAR: ' = ] [ digit? ] } 1|| ] trim-tail
     H{
         { "object" object } { "obj" object }
         { "quot" quotation }
@@ -134,6 +146,9 @@ ERROR: no-vocab vocab ;
         " }" write
     ] each ;
 
+: 4bl ( -- )
+    "    " write ; inline
+
 : $values. ( word -- )
     "declared-effect" word-prop [
         [ in>> ] [ out>> ] bi
@@ -141,8 +156,8 @@ ERROR: no-vocab vocab ;
             2drop
         ] [
             "{ $values" print
-            [ "    " write ($values.) ]
-            [ [ nl "    " write ($values.) ] unless-empty ] bi*
+            [ 4bl ($values.) ]
+            [ [ nl 4bl ($values.) ] unless-empty ] bi*
             nl "}" print
         ] if
     ] when* ;
@@ -151,21 +166,21 @@ ERROR: no-vocab vocab ;
     drop
     "{ $description \"\" } ;" print ;
 
-: help-header. ( word -- )
+: docs-header. ( word -- )
     "HELP: " write name>> print ;
 
 : (help.) ( word -- )
-    [ help-header. ] [ $values. ] [ $description. ] tri ;
+    [ docs-header. ] [ $values. ] [ $description. ] tri ;
 
 : interesting-words ( vocab -- array )
     words
-    [ [ "help" word-prop ] [ predicate? ] bi or not ] filter
+    [ { [ "help" word-prop ] [ predicate? ] } 1|| not ] filter
     natural-sort ;
 
 : interesting-words. ( vocab -- )
     interesting-words [ (help.) nl ] each ;
 
-: help-file-string ( vocab -- str2 )
+: docs-file-string ( vocab -- str2 )
     [
         {
             [ "IN: " write print nl ]
@@ -186,62 +201,68 @@ ERROR: no-vocab vocab ;
     [ bl write ] each
     " ;" print ;
 
-: set-scaffold-help-file ( path vocab -- )
-    swap utf8 <file-writer> [
+: set-scaffold-docs-file ( vocab path -- )
+    utf8 <file-writer> [
         scaffold-copyright
-        [ help-file-string ] [ write-using ] bi
+        [ docs-file-string ] [ write-using ] bi
         write
     ] 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 -- )
     [ H{ } clone using ] dip with-variable ; inline
 
-: check-vocab ( vocab -- vocab )
-    dup find-vocab-root [ no-vocab ] unless ;
-
-PRIVATE>
-
 : link-vocab ( vocab -- )
     check-vocab
     "Edit documentation: " write
-    [ find-vocab-root ]
-    [ vocab>scaffold-path ] bi
-    "-docs.factor" (scaffold-path) <pathname> . ;
+    "-docs.factor" vocab/suffix>path <pathname> . ;
+
+PRIVATE>
 
 : help. ( word -- )
     [ (help.) ] [ nl vocabulary>> link-vocab ] bi ;
 
-: scaffold-help ( string -- )
+: scaffold-help ( vocab -- )
     [
-        [ find-vocab-root ] [ check-vocab ] bi
-        prepare-scaffold
-        [ "-docs.factor" scaffold-path ] dip
-        swap [ set-scaffold-help-file ] [ 2drop ] if
+        dup "-docs.factor" vocab/suffix>path scaffolding? [
+            set-scaffold-docs-file
+        ] [
+            2drop
+        ] if
     ] with-scaffold ;
 
 : scaffold-undocumented ( string -- )
     [ interesting-words. ] [ link-vocab ] bi ;
 
 : scaffold-vocab ( vocab-root string -- )
-    prepare-scaffold
     {
-        [ drop scaffold-directory ]
+        [ scaffold-directory ]
         [ scaffold-main ]
-        [ scaffold-tests ]
-        [ drop scaffold-authors ]
+        [ scaffold-authors ]
         [ nip require ]
     } 2cleave ;
 
+<PRIVATE
+
+: 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 ;
+
+PRIVATE>
+
+: scaffold-tests ( vocab -- )
+    dup "-tests.factor" vocab/suffix>path
+    scaffolding? [
+        set-scaffold-tests-file
+    ] [
+        2drop
+    ] if ;
+
 SYMBOL: examples-flag
 
 : example ( -- )
@@ -250,7 +271,7 @@ SYMBOL: examples-flag
         "           \"\""
         "           \"\""
         "}"
-    } [ examples-flag get [ "    " write ] when print ] each ;
+    } [ examples-flag get [ 4bl ] when print ] each ;
 
 : examples ( n -- )
     t \ examples-flag [
@@ -260,10 +281,11 @@ SYMBOL: examples-flag
     ] with-variable ;
 
 : scaffold-rc ( path -- )
+    [ home ] dip append-path
     [ touch-file ] [ "Click to edit: " write <pathname> . ] bi ;
 
-: scaffold-factor-boot-rc ( -- )
-    home ".factor-boot-rc" append-path scaffold-rc ;
+: scaffold-factor-boot-rc ( -- ) ".factor-boot-rc" scaffold-rc ;
 
-: scaffold-factor-rc ( -- )
-    home ".factor-rc" append-path scaffold-rc ;
+: scaffold-factor-rc ( -- ) ".factor-rc" scaffold-rc ;
+
+: scaffold-emacs ( -- ) ".emacs" scaffold-rc ;