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

Makefile

@@ -3,7 +3,7 @@ AR = ar
 LD = ld
 
 EXECUTABLE = factor
-CONSOLE_EXECUTABLE = factor_console
+CONSOLE_EXECUTABLE = factor-console
 VERSION = 0.92
 
 IMAGE = factor.image
@@ -140,15 +140,10 @@ zlib1.dll:
 winnt-x86-32: freetype6.dll zlib1.dll
 	$(MAKE) $(EXECUTABLE) CONFIG=vm/Config.windows.nt.x86.32
 	$(MAKE) $(CONSOLE_EXECUTABLE) CONFIG=vm/Config.windows.nt.x86.32
-	$(MAKE) winnt-finish
 
 winnt-x86-64:
 	$(MAKE) $(EXECUTABLE) CONFIG=vm/Config.windows.nt.x86.64
 	$(MAKE) $(CONSOLE_EXECUTABLE) CONFIG=vm/Config.windows.nt.x86.64
-	$(MAKE) winnt-finish
-
-winnt-finish:
-	cp misc/factor-cygwin.sh ./factor
 
 wince-arm:
 	$(MAKE) $(EXECUTABLE) CONFIG=vm/Config.windows.ce.arm
@@ -169,10 +164,10 @@ factor: $(DLL_OBJS) $(EXE_OBJS)
 	$(CC) $(LIBS) $(LIBPATH) -L. $(LINK_WITH_ENGINE) \
 		$(CFLAGS) -o $@$(EXE_SUFFIX)$(EXE_EXTENSION) $(EXE_OBJS)
 
-factor_console: $(DLL_OBJS) $(EXE_OBJS)
+factor-console: $(DLL_OBJS) $(EXE_OBJS)
 	$(LINKER) $(ENGINE) $(DLL_OBJS)
 	$(CC) $(LIBS) $(LIBPATH) -L. $(LINK_WITH_ENGINE) \
-		$(CFLAGS) $(CFLAGS_CONSOLE) -o $(EXECUTABLE)$(EXE_SUFFIX)$(CONSOLE_EXE_EXTENSION) $(EXE_OBJS)
+		$(CFLAGS) $(CFLAGS_CONSOLE) -o $@$(EXE_SUFFIX)$(EXE_EXTENSION) $(EXE_OBJS)
 
 clean:
 	rm -f vm/*.o

basis/base64/base64.factor

@@ -45,8 +45,8 @@ SYMBOL: column
     ] with each ; inline
 
 : encode-pad ( seq n -- )
-    [ 3 0 pad-right binary [ encode3 ] with-byte-writer ]
-    [ 1+ ] bi* head-slice 4 CHAR: = pad-right write-lines ; inline
+    [ 3 0 pad-tail binary [ encode3 ] with-byte-writer ]
+    [ 1+ ] bi* head-slice 4 CHAR: = pad-tail write-lines ; inline
 
 ERROR: malformed-base64 ;
 

basis/bootstrap/image/image.factor

@@ -351,7 +351,7 @@ M: wrapper '
     bootstrap-cell <groups> native> emit-seq ;
 
 : pad-bytes ( seq -- newseq )
-    dup length bootstrap-cell align 0 pad-right ;
+    dup length bootstrap-cell align 0 pad-tail ;
 
 : extended-part ( str -- str' )
     dup [ 128 < ] all? [ drop f ] [

basis/bootstrap/stage2.factor

@@ -13,7 +13,7 @@ SYMBOL: core-bootstrap-time
 SYMBOL: bootstrap-time
 
 : default-image-name ( -- string )
-    vm file-name os windows? [ "." split1 drop ] when
+    vm file-name os windows? [ "." split1-last drop ] when
     ".image" append resource-path ;
 
 : do-crossref ( -- )

basis/calendar/format/format.factor

@@ -5,11 +5,11 @@ sequences io accessors arrays io.streams.string splitting
 combinators accessors calendar calendar.format.macros present ;
 IN: calendar.format
 
-: pad-00 ( n -- str ) number>string 2 CHAR: 0 pad-left ;
+: pad-00 ( n -- str ) number>string 2 CHAR: 0 pad-head ;
 
-: pad-0000 ( n -- str ) number>string 4 CHAR: 0 pad-left ;
+: pad-0000 ( n -- str ) number>string 4 CHAR: 0 pad-head ;
 
-: pad-00000 ( n -- str ) number>string 5 CHAR: 0 pad-left ;
+: pad-00000 ( n -- str ) number>string 5 CHAR: 0 pad-head ;
 
 : write-00 ( n -- ) pad-00 write ;
 

basis/checksums/sha1/sha1.factor

@@ -128,7 +128,7 @@ M: sha1 checksum-stream ( stream -- sha1 )
     [ zip concat ] keep like ;
 
 : sha1-interleave ( string -- seq )
-    [ zero? ] trim-left
+    [ zero? ] trim-head
     dup length odd? [ rest ] when
     seq>2seq [ sha1 checksum-bytes ] bi@
     2seq>seq ;

basis/checksums/sha2/sha2.factor

@@ -62,7 +62,7 @@ SYMBOLS: vars M K H S0 S1 process-M word-size block-size ;
     [ + + w+ ] 2dip swap set-nth ; inline
 
 : prepare-message-schedule ( seq -- w-seq )
-    word-size get group [ be> ] map block-size get 0 pad-right
+    word-size get group [ be> ] map block-size get 0 pad-tail
     dup 16 64 dup <slice> [
         process-M-256
     ] with each ;

basis/compiler/cfg/linearization/linearization.factor

@@ -63,7 +63,7 @@ M: ##compare-float-branch linearize-insn
             ##box-float
             ##box-alien
         } memq?
-    ] contains? ;
+    ] any? ;
 
 : linearize-basic-block ( bb -- )
     [ number>> _label ]

basis/compiler/codegen/codegen.factor

@@ -400,7 +400,7 @@ M: no-such-symbol compiler-error-type
 
 : check-dlsym ( symbols dll -- )
     dup dll-valid? [
-        dupd '[ _ dlsym ] contains?
+        dupd '[ _ dlsym ] any?
         [ drop ] [ no-such-symbol ] if
     ] [
         dll-path no-such-library drop

basis/compiler/tests/stack-trace.factor

@@ -19,14 +19,14 @@ words splitting grouping sorting accessors ;
 
 : bleh ( seq -- seq' ) [ 3 + ] map [ 0 > ] filter ;
 
-: stack-trace-contains? ( word -- ? ) symbolic-stack-trace memq? ;
+: stack-trace-any? ( word -- ? ) symbolic-stack-trace memq? ;
 
 [ t ] [
-    [ { 1 "hi" } bleh ] ignore-errors \ + stack-trace-contains?
+    [ { 1 "hi" } bleh ] ignore-errors \ + stack-trace-any?
 ] unit-test
     
 [ t f ] [
     [ { "hi" } bleh ] ignore-errors
-    \ + stack-trace-contains?
-    \ > stack-trace-contains?
+    \ + stack-trace-any?
+    \ > stack-trace-any?
 ] unit-test

basis/compiler/tree/builder/builder-tests.factor

@@ -8,4 +8,4 @@ compiler.tree ;
 
 : inline-recursive ( -- ) inline-recursive ; inline recursive
 
-[ t ] [ \ inline-recursive build-tree-from-word [ #recursive? ] contains? nip ] unit-test
+[ t ] [ \ inline-recursive build-tree-from-word [ #recursive? ] any? nip ] unit-test

basis/compiler/tree/checker/checker.factor

@@ -175,7 +175,7 @@ M: #branch check-stack-flow*
     branch-out get [ ] find nip swap head* >vector datastack set ;
 
 M: #phi check-stack-flow*
-    branch-out get [ ] contains? [
+    branch-out get [ ] any? [
         [ check-phi-in ] [ set-phi-datastack ] [ check-out-d ] tri
     ] [ drop terminated? on ] if ;
 

basis/compiler/tree/cleanup/cleanup-tests.factor

@@ -498,7 +498,7 @@ cell-bits 32 = [
 
 [ t ] [
     [ { array-capacity } declare 1 fixnum+ ] cleaned-up-tree
-    [ { [ #call? ] [ node-input-infos second literal>> 1 = ] } 1&& ] contains?
+    [ { [ #call? ] [ node-input-infos second literal>> 1 = ] } 1&& ] any?
 ] unit-test
 
 [ ] [

basis/compiler/tree/combinators/combinators.factor

@@ -34,14 +34,14 @@ IN: compiler.tree.combinators
     dup dup '[
         _ keep swap [ drop t ] [
             dup #branch? [
-                children>> [ _ contains-node? ] contains?
+                children>> [ _ contains-node? ] any?
             ] [
                 dup #recursive? [
                     child>> _ contains-node?
                 ] [ drop f ] if
             ] if
         ] if
-    ] contains? ; inline recursive
+    ] any? ; inline recursive
 
 : select-children ( seq flags -- seq' )
     [ [ drop f ] unless ] 2map ;

basis/compiler/tree/dead-code/simple/simple.factor

@@ -79,7 +79,7 @@ M: #alien-indirect compute-live-values* nip look-at-inputs ;
     dup out-d>> drop-dead-values tuck in-d>> >>out-d drop ;
 
 : some-outputs-dead? ( #call -- ? )
-    out-d>> [ live-value? not ] contains? ;
+    out-d>> [ live-value? not ] any? ;
 
 : maybe-drop-dead-outputs ( node -- nodes )
     dup some-outputs-dead? [

basis/compiler/tree/normalization/normalization.factor

@@ -60,7 +60,7 @@ M: #branch normalize*
 : eliminate-phi-introductions ( introductions seq terminated -- seq' )
     [
         [ nip ] [
-            dup [ +bottom+ eq? ] trim-left
+            dup [ +bottom+ eq? ] trim-head
             [ [ length ] bi@ - tail* ] keep append
         ] if
     ] 3map ;

basis/compiler/tree/propagation/inlining/inlining.factor

@@ -124,7 +124,7 @@ DEFER: (flat-length)
         [ class-types length 1 = ]
         [ union-class? not ]
         bi and
-    ] contains? ;
+    ] any? ;
 
 : node-count-bias ( -- n )
     45 node-count get [-] 8 /i ;

basis/compiler/tree/tuple-unboxing/tuple-unboxing.factor

@@ -118,7 +118,7 @@ M: #return-recursive unbox-tuples*
 ! These nodes never participate in unboxing
 : assert-not-unboxed ( values -- )
     dup array?
-    [ [ unboxed-allocation ] contains? ] [ unboxed-allocation ] if
+    [ [ unboxed-allocation ] any? ] [ unboxed-allocation ] if
     [ "Unboxing wrong value" throw ] when ;
 
 M: #branch unbox-tuples* dup in-d>> assert-not-unboxed ;

basis/concurrency/mailboxes/mailboxes.factor

@@ -25,7 +25,7 @@ M: mailbox dispose* threads>> notify-all ;
 
 :: block-unless-pred ( mailbox timeout pred: ( message -- ? ) -- )
     mailbox check-disposed
-    mailbox data>> pred dlist-contains? [
+    mailbox data>> pred dlist-any? [
         mailbox timeout wait-for-mailbox
         mailbox timeout pred block-unless-pred
     ] unless ; inline recursive

basis/csv/csv.factor

@@ -71,7 +71,7 @@ DEFER: quoted-field ( -- endchar )
   delimiter swap with-variable ; inline
 
 : needs-escaping? ( cell -- ? )
-  [ [ "\n\"" member? ] [ delimiter get = ] bi or ] contains? ; inline ! "
+  [ [ "\n\"" member? ] [ delimiter get = ] bi or ] any? ; inline
 
 : escape-quotes ( cell -- cell' )
   [ [ dup , CHAR: " = [ CHAR: " , ] when ] each ] "" make ; inline

basis/db/db-docs.factor

@@ -244,13 +244,13 @@ ARTICLE: "db-protocol" "Low-level database protocol"
 ! { $subsection bind-tuple }
 
 ARTICLE: "db-lowlevel-tutorial" "Low-level database tutorial"
-"Although Factor makes integrating a database with its object system easy (see " { $vocab-link "db.tuples" } "), sometimes you may want to write SQL directly and get the results back as arrays of strings, for instance, when interfacing with a legacy database that doesn't easily map to " { $snippet "tuples" } "."
+"Although Factor makes integrating a database with its object system easy (see " { $vocab-link "db.tuples" } "), sometimes you may want to write SQL directly and get the results back as arrays of strings, for instance, when interfacing with a legacy database that doesn't easily map to " { $snippet "tuples" } "." $nl
 "Executing a SQL command:"
 { $subsection sql-command }
 "Executing a query directly:"
 { $subsection sql-query }
 "Here's an example usage where we'll make a book table, insert some objects, and query them." $nl
-"First, let's set up a custom combinator for using our database.  See " { $link "db-custom-database-combinators" } " for more details."
+"First, let's set up a custom combinator for using our database. See " { $link "db-custom-database-combinators" } " for more details."
 { $code <"
 USING: db.sqlite db io.files ;
 : with-book-db ( quot -- )

basis/db/queries/queries.factor

@@ -19,7 +19,7 @@ SINGLETON: retryable
     ] if ;
 
 : maybe-make-retryable ( statement -- statement )
-    dup in-params>> [ generator-bind? ] contains?
+    dup in-params>> [ generator-bind? ] any?
     [ make-retryable ] when ;
 
 : regenerate-params ( statement -- statement )

basis/db/sqlite/sqlite.factor

@@ -294,7 +294,7 @@ M: sqlite-db-connection persistent-table ( -- assoc )
     ] with-string-writer ;
 
 : can-be-null? ( -- ? )
-    "sql-spec" get modifiers>> [ +not-null+ = ] contains? not ;
+    "sql-spec" get modifiers>> [ +not-null+ = ] any? not ;
 
 : delete-cascade? ( -- ? )
     "sql-spec" get modifiers>> { +on-delete+ +cascade+ } swap subseq? ;

basis/db/tuples/tuples-docs.factor

@@ -90,7 +90,7 @@ HELP: ensure-table
 
 HELP: ensure-tables
 { $values
-     { "classes" null } }
+     { "classes" "a sequence of classes" } }
 { $description "Creates a SQL table from a mapping defined by " { $link define-persistent } ". If a table already exists, the error is silently ignored." } ;
 
 HELP: recreate-table
@@ -199,7 +199,7 @@ ARTICLE: "db-tuples-protocol" "Tuple database protocol"
 { $subsection <count-statement> } ;
 
 ARTICLE: "db-tuples-tutorial" "Tuple database tutorial"
-"Let's make a tuple and store it in a database. To follow along, click on each code example and run it in the listener.  If you forget to run an example, just start at the top and run them all again in order." $nl
+"Let's make a tuple and store it in a database. To follow along, click on each code example and run it in the listener. If you forget to run an example, just start at the top and run them all again in order." $nl
 "We're going to store books in this tutorial."
 { $code "TUPLE: book id title author date-published edition cover-price condition ;" }
 "The title, author, and publisher should be strings; the date-published a timestamp; the edition an integer; the cover-price a float. These are the Factor types for which we will need to look up the corresponding " { $link "db.types" } ". " $nl
@@ -246,7 +246,7 @@ T{ book
 { $code <" [
     book get update-tuple
 ] with-book-tutorial "> }
-"And select it again.  You can query the database by any field -- just set it in the exemplar tuple you pass to " { $link select-tuples } "."
+"And select it again. You can query the database by any field -- just set it in the exemplar tuple you pass to " { $link select-tuples } "."
 { $code <" [
     T{ book { title "Factor for Sheeple" } } select-tuples
 ] with-book-tutorial "> }

basis/db/types/types-docs.factor

@@ -4,39 +4,24 @@ USING: classes hashtables help.markup help.syntax io.streams.string
 kernel sequences strings math ;
 IN: db.types
 
-HELP: +autoincrement+
-{ $description "" } ;
-
 HELP: +db-assigned-id+
 { $description "The database assigns a primary key to the object. The primary key is most likely a big integer, but is database-dependent." } ;
 
 HELP: +default+
-{ $description "" } ;
-
-HELP: +foreign-id+
-{ $description "" } ;
-
-HELP: +has-many+
-{ $description "" } ;
+{ $description "Allows a default value for a column to be provided." } ;
 
 HELP: +not-null+
-{ $description "" } ;
+{ $description "Ensures that a column is not null." } ;
 
 HELP: +null+
-{ $description "" } ;
+{ $description "Allows a column to be null." } ;
 
 HELP: +primary-key+
-{ $description "" } ;
+{ $description "Makes a column a primary key. Only one column may be a primary key." } ;
 
 HELP: +random-id+
 { $description "Factor chooses a random number and tries to insert the tuple into the database with this number as its primary key. The default number of retries to find a unique random number is 10, though in practice it will almost certainly succeed on the first try." } ;
 
-HELP: +serial+
-{ $description "" } ;
-
-HELP: +unique+
-{ $description "" } ;
-
 HELP: +user-assigned-id+
 { $description "The user is responsible for choosing a primary key for tuples inserted with this database type. Keys must be unique or else the database will throw an error. Usually it is better to use a " { $link +db-assigned-id+ } "." } ;
 
@@ -114,12 +99,12 @@ HELP: user-assigned-id-spec?
 
 HELP: bind#
 { $values
-     { "spec" null } { "obj" object } }
+     { "spec" "a sql spec" } { "obj" object } }
 { $description "" } ;
 
 HELP: bind%
 { $values
-     { "spec" null } }
+     { "spec" "a sql spec" } }
 { $description "" } ;
 
 HELP: compound
@@ -176,7 +161,7 @@ HELP: low-level-binding
 
 HELP: modifiers
 { $values
-     { "spec" null }
+     { "spec" "a sql spec" }
      { "string" string } }
 { $description "" } ;
 
@@ -187,7 +172,7 @@ HELP: no-sql-type
 
 HELP: normalize-spec
 { $values
-     { "spec" null } }
+     { "spec" "a sql spec" } }
 { $description "" } ;
 
 HELP: offset-of-slot
@@ -204,7 +189,7 @@ HELP: persistent-table
 
 HELP: primary-key?
 { $values
-     { "spec" null }
+     { "spec" "a sql spec" }
      { "?" "a boolean" } }
 { $description "" } ;
 
@@ -213,37 +198,31 @@ HELP: random-id-generator
 
 HELP: relation?
 { $values
-     { "spec" null }
+     { "spec" "a sql spec" }
      { "?" "a boolean" } }
 { $description "" } ;
 
 HELP: remove-db-assigned-id
 { $values
-     { "specs" null }
+     { "specs" "a sequence of sql specs" }
      { "obj" object } }
 { $description "" } ;
 
 HELP: remove-id
 { $values
-     { "specs" null }
+     { "specs" "a sequence of sql specs" }
      { "obj" object } }
 { $description "" } ;
 
-HELP: remove-relations
-{ $values
-     { "specs" null }
-     { "newcolumns" null } }
-{ $description "" } ;
-
 HELP: set-slot-named
 { $values
-     { "value" null } { "name" null } { "obj" object } }
+     { "value" object } { "name" string } { "obj" object } }
 { $description "" } ;
 
 HELP: spec>tuple
 { $values
-     { "class" class } { "spec" null }
-     { "tuple" null } }
+     { "class" class } { "spec" "a sql spec" }
+     { "tuple" tuple } }
 { $description "" } ;
 
 HELP: sql-spec

basis/db/types/types.factor

@@ -71,10 +71,10 @@ ERROR: not-persistent class ;
     primary-key>> +primary-key+? ;
 
 : db-assigned-id-spec? ( specs -- ? )
-    [ primary-key>> +db-assigned-id+? ] contains? ;
+    [ primary-key>> +db-assigned-id+? ] any? ;
 
 : user-assigned-id-spec? ( specs -- ? )
-    [ primary-key>> +user-assigned-id+? ] contains? ;
+    [ primary-key>> +user-assigned-id+? ] any? ;
 
 : normalize-spec ( spec -- )
     dup type>> dup +primary-key+? [
@@ -105,7 +105,7 @@ FACTOR-BLOB NULL URL ;
         dup normalize-spec ;
 
 : spec>tuple ( class spec -- tuple )
-    3 f pad-right [ first3 ] keep 3 tail <sql-spec> ;
+    3 f pad-tail [ first3 ] keep 3 tail <sql-spec> ;
 
 : number>string* ( n/string -- string )
     dup number? [ number>string ] when ;

basis/dlists/dlists-docs.factor

@@ -15,7 +15,7 @@ $nl
 "Iterating over elements:"
 { $subsection dlist-each }
 { $subsection dlist-find }
-{ $subsection dlist-contains? }
+{ $subsection dlist-any? }
 "Deleting a node matching a predicate:"
 { $subsection delete-node-if* }
 { $subsection delete-node-if }
@@ -40,7 +40,7 @@ HELP: dlist-find
     "This operation is O(n)."
 } ;
 
-HELP: dlist-contains?
+HELP: dlist-any?
 { $values { "dlist" { $link dlist } } { "quot" quotation } { "?" "a boolean" } }
 { $description "Just like " { $link dlist-find } " except it doesn't return the object." }
 { $notes "This operation is O(n)." } ;

basis/dlists/dlists-tests.factor

@@ -46,8 +46,8 @@ IN: dlists.tests
 [ f f ] [ <dlist> [ 1 = ] dlist-find ] unit-test
 [ 1 t ] [ <dlist> 1 over push-back [ 1 = ] dlist-find ] unit-test
 [ f f ] [ <dlist> 1 over push-back [ 2 = ] dlist-find ] unit-test
-[ f ] [ <dlist> 1 over push-back [ 2 = ] dlist-contains? ] unit-test
-[ t ] [ <dlist> 1 over push-back [ 1 = ] dlist-contains? ] unit-test
+[ f ] [ <dlist> 1 over push-back [ 2 = ] dlist-any? ] unit-test
+[ t ] [ <dlist> 1 over push-back [ 1 = ] dlist-any? ] unit-test
 
 [ 1 ] [ <dlist> 1 over push-back [ 1 = ] delete-node-if ] unit-test
 [ t ] [ <dlist> 1 over push-back dup [ 1 = ] delete-node-if drop deque-empty? ] unit-test

basis/dlists/dlists.factor

@@ -117,11 +117,11 @@ M: dlist pop-back* ( dlist -- )
 : dlist-find ( dlist quot -- obj/f ? )
     '[ obj>> @ ] dlist-find-node [ obj>> t ] [ drop f f ] if ; inline
 
-: dlist-contains? ( dlist quot -- ? )
+: dlist-any? ( dlist quot -- ? )
     dlist-find nip ; inline
 
 M: dlist deque-member? ( value dlist -- ? )
-    [ = ] with dlist-contains? ;
+    [ = ] with dlist-any? ;
 
 M: dlist delete-node ( dlist-node dlist -- )
     {

basis/farkup/farkup.factor

@@ -34,7 +34,7 @@ TUPLE: line ;
 TUPLE: line-break ;
 
 : absolute-url? ( string -- ? )
-    { "http://" "https://" "ftp://" } [ head? ] with contains? ;
+    { "http://" "https://" "ftp://" } [ head? ] with any? ;
 
 : simple-link-title ( string -- string' )
     dup absolute-url? [ "/" split1-last swap or ] unless ;
@@ -162,7 +162,7 @@ stand-alone
 : check-url ( href -- href' )
     {
         { [ dup empty? ] [ drop invalid-url ] }
-        { [ dup [ 127 > ] contains? ] [ drop invalid-url ] }
+        { [ dup [ 127 > ] any? ] [ drop invalid-url ] }
         { [ dup first "/\\" member? ] [ drop invalid-url ] }
         { [ CHAR: : over member? ] [ dup absolute-url? [ drop invalid-url ] unless ] }
         [ relative-link-prefix get prepend "" like ]
@@ -236,7 +236,7 @@ M: f (write-farkup) ;
     parse-farkup (write-farkup) ;
 
 : write-farkup ( string -- )
-    farkup>xml write-xml-chunk ;
+    farkup>xml write-xml ;
 
 : convert-farkup ( string -- string' )
     [ write-farkup ] with-string-writer ;

basis/formatting/formatting-docs.factor

@@ -43,7 +43,7 @@ HELP: printf
     "string. For example:\n"
     { $list 
         "\"%.3s\" formats a string to truncate at 3 characters (from the left)."
-        "\"%.10f\" formats a float to pad-right with zeros up to 10 digits beyond the decimal point."
+        "\"%.10f\" formats a float to pad-tail with zeros up to 10 digits beyond the decimal point."
         "\"%.5E\" formats a float into scientific notation with zeros up to 5 digits beyond the decimal point, but before the exponent."
     }
 }

basis/formatting/formatting.factor

@@ -29,7 +29,7 @@ IN: formatting
     [ 0 ] [ string>number ] if-empty ;
 
 : pad-digits ( string digits -- string' )
-    [ "." split1 ] dip [ CHAR: 0 pad-right ] [ head-slice ] bi "." glue ;
+    [ "." split1 ] dip [ CHAR: 0 pad-tail ] [ head-slice ] bi "." glue ;
 
 : max-digits ( n digits -- n' )
     10 swap ^ [ * round ] keep / ; inline
@@ -48,7 +48,7 @@ IN: formatting
     [ max-digits ] keep -rot
     [
         [ 0 < "-" "+" ? ]
-        [ abs number>string 2 CHAR: 0 pad-left ] bi 
+        [ abs number>string 2 CHAR: 0 pad-head ] bi 
         "e" -rot 3append
     ]
     [ number>string ] bi*
@@ -60,7 +60,7 @@ zero      = "0"                  => [[ CHAR: 0 ]]
 char      = "'" (.)              => [[ second ]]
 
 pad-char  = (zero|char)?         => [[ CHAR: \s or ]]
-pad-align = ("-")?               => [[ \ pad-right \ pad-left ? ]] 
+pad-align = ("-")?               => [[ \ pad-tail \ pad-head ? ]] 
 pad-width = ([0-9])*             => [[ >digits ]]
 pad       = pad-align pad-char pad-width => [[ reverse >quotation dup first 0 = [ drop [ ] ] when ]]
 
@@ -110,9 +110,9 @@ MACRO: printf ( format-string -- )
 
 <PRIVATE
 
-: pad-00 ( n -- string ) number>string 2 CHAR: 0 pad-left ; inline
+: pad-00 ( n -- string ) number>string 2 CHAR: 0 pad-head ; inline
 
-: pad-000 ( n -- string ) number>string 3 CHAR: 0 pad-left ; inline
+: pad-000 ( n -- string ) number>string 3 CHAR: 0 pad-head ; inline
 
 : >time ( timestamp -- string )
     [ hour>> ] [ minute>> ] [ second>> floor ] tri 3array

basis/ftp/client/listing-parser/listing-parser.factor

@@ -39,7 +39,7 @@ name target ;
 
 : parse-list-11 ( lines -- seq )
     [
-        11 f pad-right
+        11 f pad-tail
         <remote-file> swap {
             [ 0 swap nth parse-permissions ]
             [ 1 swap nth string>number >>links ]

basis/furnace/auth/features/edit-profile/edit-profile.factor

@@ -31,7 +31,7 @@ IN: furnace.auth.features.edit-profile
             } validate-params
 
             { "password" "new-password" "verify-password" }
-            [ value empty? not ] contains? [
+            [ value empty? not ] any? [
                 "password" value username check-login
                 [ "incorrect password" validation-error ] unless
 

basis/furnace/auth/login/login.factor

@@ -16,7 +16,7 @@ IN: furnace.auth.login
 SYMBOL: permit-id
 
 : permit-id-key ( realm -- string )
-    [ >hex 2 CHAR: 0 pad-left ] { } map-as concat
+    [ >hex 2 CHAR: 0 pad-head ] { } map-as concat
     "__p_" prepend ;
 
 : client-permit-id ( realm -- id/f )

basis/furnace/utilities/utilities.factor

@@ -29,7 +29,7 @@ ERROR: no-such-word name vocab ;
 
 : base-path ( string -- pair )
     dup responder-nesting get
-    [ second class superclasses [ name>> = ] with contains? ] with find nip
+    [ second class superclasses [ name>> = ] with any? ] with find nip
     [ first ] [ "No such responder: " swap append throw ] ?if ;
 
 : resolve-base-path ( string -- string' )

basis/help/lint/lint.factor

@@ -43,7 +43,7 @@ SYMBOL: vocabs-quot
         $predicate
         $class-description
         $error-description
-    } swap '[ _ elements empty? not ] contains? ;
+    } swap '[ _ elements empty? not ] any? ;
 
 : don't-check-word? ( word -- ? )
     {
@@ -103,7 +103,7 @@ SYMBOL: vocabs-quot
     [ "Missing whitespace between strings" throw ] unless ;
 
 : check-bogus-nl ( element -- )
-    { { $nl } { { $nl } } } [ head? ] with contains?
+    { { $nl } { { $nl } } } [ head? ] with any?
     [ "Simple element should not begin with a paragraph break" throw ] when ;
 
 : check-elements ( element -- )
@@ -114,12 +114,22 @@ SYMBOL: vocabs-quot
         [ 2 <clumps> [ [ string? ] all? ] filter [ first2 check-whitespace ] each ]
     } cleave ;
 
+: check-descriptions ( element -- )
+    { $description $class-description $var-description }
+    swap '[
+        _ elements [
+            rest { { } { "" } } member?
+            [ "Empty description" throw ] when
+        ] each
+    ] each ;
+
 : check-markup ( element -- )
     {
         [ check-elements ]
         [ check-rendering ]
         [ check-examples ]
         [ check-modules ]
+        [ check-descriptions ]
     } cleave ;
 
 : all-word-help ( words -- seq )

basis/html/components/components.factor

@@ -19,7 +19,7 @@ GENERIC: render* ( value name renderer -- xml )
         [ f swap ]
         if
     ] 2dip
-    render* write-xml-chunk
+    render* write-xml
     [ render-error ] when* ;
 
 <PRIVATE
@@ -176,4 +176,4 @@ M: comparison render*
 ! HTML component
 SINGLETON: html
 
-M: html render* 2drop string>xml-chunk ;
+M: html render* 2drop <unescaped> ;

basis/html/elements/elements.factor

@@ -1,11 +1,9 @@
-! cont-html v0.6
-!
-! Copyright (C) 2004 Chris Double.
+! Copyright (C) 2004, 2009 Chris Double, Daniel Ehrenberg.
 ! See http://factorcode.org/license.txt for BSD license.
-
 USING: io io.styles kernel namespaces prettyprint quotations
 sequences strings words xml.entities compiler.units effects
-urls math math.parser combinators present fry ;
+xml.data xml.interpolate urls math math.parser combinators
+present fry io.streams.string xml.writer ;
 
 IN: html.elements
 
@@ -135,17 +133,18 @@ SYMBOL: html
     "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.1//EN\" \"http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd\">" write-html ;
 
 : simple-page ( title head-quot body-quot -- )
-    #! Call the quotation, with all output going to the
-    #! body of an html page with the given title.
-    spin
-    xhtml-preamble
-    <html "http://www.w3.org/1999/xhtml" =xmlns "en" =xml:lang "en" =lang html>
-        <head>
-            <title> write </title>
-            call
-        </head>
-        <body> call </body>
-    </html> ; inline
+    [ with-string-writer <unescaped> ] bi@
+    <XML
+        <?xml version="1.0"?>
+        <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.1//EN" "http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd">
+        <html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
+            <head>
+                <title><-></title>
+                <->
+            </head>
+            <body><-></body>
+        </html>
+    XML> write-xml ; inline
 
 : render-error ( message -- )
-    <span "error" =class span> escape-string write </span> ;
+    [XML <span class="error"><-></span> XML] write-xml ;

basis/html/streams/streams.factor

@@ -55,7 +55,7 @@ TUPLE: html-sub-stream < html-stream style parent ;
 
 : hex-color, ( color -- )
     [ red>> ] [ green>> ] [ blue>> ] tri
-    [ 255 * >fixnum >hex 2 CHAR: 0 pad-left % ] tri@ ;
+    [ 255 * >fixnum >hex 2 CHAR: 0 pad-head % ] tri@ ;
 
 : fg-css, ( color -- )
     "color: #" % hex-color, "; " % ;

basis/html/templates/chloe/compiler/compiler.factor

@@ -49,7 +49,7 @@ DEFER: compile-element
     reset-buffer "@" ?head [ , [ value present ] % ] [ , ] if ;
 
 : compile-attrs ( assoc -- )
-    attrs>> [
+    [
         " " [write]
         swap name>string [write]
         "=\"" [write]
@@ -59,7 +59,7 @@ DEFER: compile-element
 
 : compile-start-tag ( tag -- )
     "<" [write]
-    [ name>string [write] ] [ compile-attrs ] bi
+    [ name>string [write] ] [ attrs>> compile-attrs ] bi
     ">" [write] ;
 
 : compile-end-tag ( tag -- )
@@ -90,7 +90,7 @@ ERROR: unknown-chloe-tag tag ;
         { [ dup [ tag? ] [ xml? ] bi or ] [ compile-tag ] }
         { [ dup string? ] [ escape-string [write] ] }
         { [ dup comment? ] [ drop ] }
-        [ [ write-xml-chunk ] [code-with] ]
+        [ [ write-xml ] [code-with] ]
     } cond ;
 
 : with-compiler ( quot -- quot' )
@@ -126,7 +126,7 @@ ERROR: unknown-chloe-tag tag ;
 
 : compile-prologue ( xml -- )
     [
-        [ prolog>> [ write-prolog ] [code-with] ]
+        [ prolog>> [ write-xml ] [code-with] ]
         [ before>> compile-chunk ]
         bi
     ] compile-quot

basis/http/client/client.factor

@@ -86,7 +86,7 @@ SYMBOL: redirects
     ] [ too-many-redirects ] if ; inline recursive
 
 : read-chunk-size ( -- n )
-    read-crlf ";" split1 drop [ blank? ] trim-right
+    read-crlf ";" split1 drop [ blank? ] trim-tail
     hex> [ "Bad chunk size" throw ] unless* ;
 
 : read-chunked ( quot: ( chunk -- ) -- )

basis/http/http-tests.factor

@@ -2,7 +2,7 @@ USING: http http.server http.client http.client.private tools.test multiline
 io.streams.string io.encodings.utf8 io.encodings.8-bit
 io.encodings.binary io.encodings.string kernel arrays splitting
 sequences assocs io.sockets db db.sqlite continuations urls
-hashtables accessors namespaces ;
+hashtables accessors namespaces xml.data ;
 IN: http.tests
 
 [ "text/plain" latin1 ] [ "text/plain" parse-content-type ] unit-test
@@ -322,7 +322,7 @@ SYMBOL: a
 
 3 a set-global
 
-: test-a string>xml "input" tag-named "value" swap at ;
+: test-a string>xml "input" tag-named "value" attr ;
 
 [ "3" ] [
     "http://localhost/" add-port http-get

basis/http/server/server.factor

@@ -12,6 +12,7 @@ io.encodings.utf8
 io.encodings.ascii
 io.encodings.binary
 io.streams.limited
+io.streams.string
 io.servers.connection
 io.timeouts
 io.crlf

basis/http/server/static/static.factor

@@ -45,9 +45,9 @@ TUPLE: file-responder root hook special allow-listings ;
     [ file-responder get hook>> call ] [ 2drop <304> ] if ;
 
 : serving-path ( filename -- filename )
-    file-responder get root>> trim-right-separators
+    file-responder get root>> trim-tail-separators
     "/"
-    rot "" or trim-left-separators 3append ;
+    rot "" or trim-head-separators 3append ;
 
 : serve-file ( filename -- response )
     dup mime-type

basis/io/backend/unix/unix.factor

@@ -164,10 +164,10 @@ M: stdin refill
         size-read-fd <fd> init-fd <input-port> >>size
         data-read-fd <fd> >>data ;
 
-M: unix (init-stdio) ( -- )
+M: unix (init-stdio)
     <stdin> <input-port>
     1 <fd> <output-port>
-    2 <fd> <output-port> ;
+    2 <fd> <output-port> t ;
 
 ! mx io-task for embedding an fd-based mx inside another mx
 TUPLE: mx-port < port mx ;

basis/io/backend/windows/nt/nt.factor

@@ -120,6 +120,9 @@ M: winnt (wait-to-read) ( port -- )
         tri
     ] with-destructors ;
 
-M: winnt (init-stdio) init-c-stdio ;
+: console-app? ( -- ? ) GetConsoleWindow >boolean ;
+
+M: winnt (init-stdio)
+    console-app? [ init-c-stdio t ] [ f f f f ] if ;
 
 winnt set-io-backend

basis/io/directories/directories.factor

@@ -15,7 +15,7 @@ IN: io.directories
 HOOK: make-directory io-backend ( path -- )
 
 : make-directories ( path -- )
-    normalize-path trim-right-separators {
+    normalize-path trim-tail-separators {
         { [ dup "." = ] [ ] }
         { [ dup root-directory? ] [ ] }
         { [ dup empty? ] [ ] }
@@ -87,4 +87,4 @@ M: object copy-file
 {
     { [ os unix? ] [ "io.directories.unix" require ] }
     { [ os windows? ] [ "io.directories.windows" require ] }
-} cond
+} cond

basis/io/directories/search/search-docs.factor

@@ -52,7 +52,7 @@ HELP: find-all-in-directories
 
 { find-file find-all-files find-in-directories find-all-in-directories } related-words
 
-ARTICLE: "io.directories.search" "io.directories.search"
+ARTICLE: "io.directories.search" "Searching directories"
 "The " { $vocab-link "io.directories.search" } " vocabulary contains words used for recursively iterating over a directory and for finding files in a directory tree." $nl
 "Traversing directories:"
 { $subsection recursive-directory }

basis/io/files/windows/nt/nt-tests.factor

@@ -25,8 +25,8 @@ IN: io.files.windows.nt.tests
 [ t ] [ "\\\\" root-directory? ] unit-test
 [ t ] [ "/" root-directory? ] unit-test
 [ t ] [ "//" root-directory? ] unit-test
-[ t ] [ "c:\\" trim-right-separators root-directory? ] unit-test
-[ t ] [ "Z:\\" trim-right-separators root-directory? ] unit-test
+[ t ] [ "c:\\" trim-tail-separators root-directory? ] unit-test
+[ t ] [ "Z:\\" trim-tail-separators root-directory? ] unit-test
 [ f ] [ "c:\\foo" root-directory? ] unit-test
 [ f ] [ "." root-directory? ] unit-test
 [ f ] [ ".." root-directory? ] unit-test

basis/io/files/windows/nt/nt.factor

@@ -22,10 +22,10 @@ M: winnt root-directory? ( path -- ? )
     {
         { [ dup empty? ] [ drop f ] }
         { [ dup [ path-separator? ] all? ] [ drop t ] }
-        { [ dup trim-right-separators { [ length 2 = ]
+        { [ dup trim-tail-separators { [ length 2 = ]
           [ second CHAR: : = ] } 1&& ] [ drop t ] }
         { [ dup unicode-prefix head? ]
-          [ trim-right-separators length unicode-prefix length 2 + = ] }
+          [ trim-tail-separators length unicode-prefix length 2 + = ] }
         [ drop f ]
     } cond ;
 

basis/io/monitors/linux/linux-tests.factor

@@ -2,7 +2,7 @@ IN: io.monitors.linux.tests
 USING: io.monitors tools.test io.files io.files.temp
 io.directories system sequences continuations namespaces
 concurrency.count-downs kernel io threads calendar prettyprint
-destructors io.timeouts ;
+destructors io.timeouts accessors ;
 
 ! On Linux, a notification on the directory itself would report an invalid
 ! path name

basis/io/monitors/monitors-tests.factor

@@ -56,7 +56,7 @@ os { winnt linux macosx } member? [
                     "m" get next-change path>>
                     dup print flush
                     dup parent-directory
-                    [ trim-right-separators "xyz" tail? ] either? not
+                    [ trim-tail-separators "xyz" tail? ] either? not
                 ] loop
 
                 "c1" get count-down
@@ -65,7 +65,7 @@ os { winnt linux macosx } member? [
                     "m" get next-change path>>
                     dup print flush
                     dup parent-directory
-                    [ trim-right-separators "yxy" tail? ] either? not
+                    [ trim-tail-separators "yxy" tail? ] either? not
                 ] loop
 
                 "c2" get count-down

basis/io/styles/styles.factor

@@ -118,7 +118,7 @@ M: plain-writer make-block-stream
 : format-column ( seq ? -- seq )
     [
         [ 0 [ length max ] reduce ] keep
-        swap [ CHAR: \s pad-right ] curry map
+        swap [ CHAR: \s pad-tail ] curry map
     ] unless ;
 
 : map-last ( seq quot -- seq )

basis/io/timeouts/timeouts.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2008 Slava Pestov, Doug Coleman
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel calendar alarms io io.encodings accessors
-namespaces fry ;
+namespaces fry io.streams.null ;
 IN: io.timeouts
 
 GENERIC: timeout ( obj -- dt/f )
@@ -27,3 +27,5 @@ GENERIC: cancel-operation ( obj -- )
 : timeouts ( dt -- )
     [ input-stream get set-timeout ]
     [ output-stream get set-timeout ] bi ;
+
+M: null-stream set-timeout 2drop ;

basis/lcs/diff2html/diff2html-tests.factor

@@ -3,4 +3,4 @@
 USING: lcs.diff2html lcs kernel tools.test strings sequences xml.writer ;
 IN: lcs.diff2html.tests
 
-[ ] [ "hello" "heyo" [ 1string ] { } map-as diff htmlize-diff xml-chunk>string drop ] unit-test
+[ ] [ "hello" "heyo" [ 1string ] { } map-as diff htmlize-diff xml>string drop ] unit-test

basis/locals/rewrite/point-free/point-free.factor

@@ -40,7 +40,7 @@ M: object localize 1quotation ;
 ! We special-case all the :> at the start of a quotation
 : load-locals-quot ( args -- quot )
     [ [ ] ] [
-        dup [ local-reader? ] contains? [
+        dup [ local-reader? ] any? [
             dup [ local-reader? [ 1array ] [ ] ? ] map
             spread>quot
         ] [ [ ] ] if swap length [ load-locals ] curry append

basis/locals/rewrite/sugar/sugar.factor

@@ -33,9 +33,9 @@ GENERIC: rewrite-literal? ( obj -- ? )
 
 M: special rewrite-literal? drop t ;
 
-M: array rewrite-literal? [ rewrite-literal? ] contains? ;
+M: array rewrite-literal? [ rewrite-literal? ] any? ;
 
-M: quotation rewrite-literal? [ rewrite-literal? ] contains? ;
+M: quotation rewrite-literal? [ rewrite-literal? ] any? ;
 
 M: wrapper rewrite-literal? wrapped>> rewrite-literal? ;
 

basis/math/combinatorics/combinatorics.factor

@@ -25,7 +25,7 @@ IN: math.combinatorics
     reverse 1 cut [ (>permutation) ] each ;
 
 : permutation-indices ( n seq -- permutation )
-    length [ factoradic ] dip 0 pad-left >permutation ;
+    length [ factoradic ] dip 0 pad-head >permutation ;
 
 PRIVATE>
 

basis/math/intervals/intervals.factor

@@ -77,7 +77,7 @@ TUPLE: interval { from read-only } { to read-only } ;
     [ from>> ] [ to>> ] bi ;
 
 : points>interval ( seq -- interval )
-    dup [ first fp-nan? ] contains?
+    dup [ first fp-nan? ] any?
     [ drop [-inf,inf] ] [
         dup first
         [ [ endpoint-min ] reduce ]

basis/math/polynomials/polynomials.factor

@@ -6,10 +6,10 @@ IN: math.polynomials
 
 <PRIVATE
 
-: 2pad-left ( p q n -- p q ) [ 0 pad-left ] curry bi@ ;
-: 2pad-right ( p q n -- p q ) [ 0 pad-right ] curry bi@ ;
-: pextend ( p q -- p q ) 2dup [ length ] bi@ max 2pad-right ;
-: pextend-left ( p q -- p q ) 2dup [ length ] bi@ max 2pad-left ;
+: 2pad-head ( p q n -- p q ) [ 0 pad-head ] curry bi@ ;
+: 2pad-tail ( p q n -- p q ) [ 0 pad-tail ] curry bi@ ;
+: pextend ( p q -- p q ) 2dup [ length ] bi@ max 2pad-tail ;
+: pextend-left ( p q -- p q ) 2dup [ length ] bi@ max 2pad-head ;
 : unempty ( seq -- seq ) [ { 0 } ] when-empty ;
 : 2unempty ( seq seq -- seq seq ) [ unempty ] bi@ ;
 
@@ -21,7 +21,7 @@ PRIVATE>
 : p= ( p q -- ? ) pextend = ;
 
 : ptrim ( p -- p )
-    dup length 1 = [ [ zero? ] trim-right ] unless ;
+    dup length 1 = [ [ zero? ] trim-tail ] unless ;
 
 : 2ptrim ( p q -- p q ) [ ptrim ] bi@ ;
 : p+ ( p q -- r ) pextend v+ ;
@@ -29,7 +29,7 @@ PRIVATE>
 : n*p ( n p -- n*p ) n*v ;
 
 : pextend-conv ( p q -- p q )
-    2dup [ length ] bi@ + 1- 2pad-right [ >vector ] bi@ ;
+    2dup [ length ] bi@ + 1- 2pad-tail [ >vector ] bi@ ;
 
 : p* ( p q -- r )
     2unempty pextend-conv <reversed> dup length
@@ -44,7 +44,7 @@ PRIVATE>
     2ptrim
     2dup [ length ] bi@ -
     dup 1 < [ drop 1 ] when
-    [ over length + 0 pad-left pextend ] keep 1+ ;
+    [ over length + 0 pad-head pextend ] keep 1+ ;
 
 : /-last ( seq seq -- a )
     #! divide the last two numbers in the sequences

basis/opengl/gl/gl.factor

@@ -356,6 +356,10 @@ CONSTANT: GL_DITHER                         HEX: 0BD0
 CONSTANT: GL_RGB                            HEX: 1907
 CONSTANT: GL_RGBA                           HEX: 1908
 
+! GL_BGRA_ext: http://www.opengl.org/registry/specs/EXT/bgra.txt
+CONSTANT: GL_BGR_EXT                        HEX: 80E0
+CONSTANT: GL_BGRA_EXT                       HEX: 80E1
+
 ! Implementation limits
 CONSTANT: GL_MAX_LIST_NESTING               HEX: 0B31
 CONSTANT: GL_MAX_ATTRIB_STACK_DEPTH         HEX: 0D35

basis/peg/peg.factor

@@ -509,7 +509,7 @@ TUPLE: sp-parser p1 ;
 
 M: sp-parser (compile) ( peg -- quot )
   p1>> compile-parser 1quotation '[ 
-    input-slice [ blank? ] trim-left-slice input-from pos set @ 
+    input-slice [ blank? ] trim-head-slice input-from pos set @ 
   ] ;
 
 TUPLE: delay-parser quot ;

basis/quoted-printable/quoted-printable.factor

@@ -23,7 +23,7 @@ IN: quoted-printable
 : char>quoted ( ch -- str )
     dup printable? [ 1string ] [
         assure-small >hex >upper
-        2 CHAR: 0 pad-left 
+        2 CHAR: 0 pad-head 
         CHAR: = prefix
     ] if ;
 

basis/sequences/deep/deep-docs.factor

@@ -21,10 +21,10 @@ HELP: deep-find
 { $description "Gets the first sub-node of the object, in preorder, which satisfies the quotation. If nothing satisifies it, it returns " { $link f } "." }
 { $see-also find }  ;
 
-HELP: deep-contains?
+HELP: deep-any?
 { $values { "obj" object } { "quot" { $quotation "( elt -- ? )" } } { "?" "a boolean" } }
 { $description "Tests whether the given object or any subnode satisfies the given quotation." }
-{ $see-also contains? } ;
+{ $see-also any? } ;
 
 HELP: flatten
 { $values { "obj" object } { "seq" "a sequence" } }
@@ -41,7 +41,7 @@ ARTICLE: "sequences.deep" "Deep sequence combinators"
 { $subsection deep-map }
 { $subsection deep-filter }
 { $subsection deep-find }
-{ $subsection deep-contains? }
+{ $subsection deep-any? }
 { $subsection deep-change-each }
 "A utility word to collapse nested subsequences:"
 { $subsection flatten } ;

basis/sequences/deep/deep-tests.factor

@@ -19,7 +19,7 @@ IN: sequences.deep.tests
 [ { { "heyhello" "hihello" } } ]
 [ "hey" 1array 1array [ [ change-something ] deep-change-each ] keep ] unit-test
 
-[ t ] [ "foo" [ string? ] deep-contains?  ] unit-test
+[ t ] [ "foo" [ string? ] deep-any?  ] unit-test
 
 [ "foo" ] [ "foo" [ string? ] deep-find ] unit-test
 

basis/sequences/deep/deep.factor

@@ -33,10 +33,10 @@ M: object branch? drop f ;
 
 : deep-find ( obj quot -- elt ) (deep-find) drop ; inline
 
-: deep-contains? ( obj quot -- ? ) (deep-find) nip ; inline
+: deep-any? ( obj quot -- ? ) (deep-find) nip ; inline
 
 : deep-all? ( obj quot -- ? )
-    '[ @ not ] deep-contains? not ; inline
+    '[ @ not ] deep-any? not ; inline
 
 : deep-member? ( obj seq -- ? )
     swap '[

basis/soundex/soundex.factor

@@ -14,7 +14,7 @@ TR: soundex-tr
     [ 2 <clumps> [ = not ] assoc-filter values ] [ first ] bi prefix ;
 
 : first>upper ( seq -- seq' ) 1 head >upper ;
-: trim-first ( seq -- seq' ) dup first [ = ] curry trim-left ;
+: trim-first ( seq -- seq' ) dup first [ = ] curry trim-head ;
 : remove-zeroes ( seq -- seq' ) CHAR: 0 swap remove ;
 : remove-non-alpha ( seq -- seq' ) [ alpha? ] filter ;
 : pad-4 ( first seq -- seq' ) "000" 3append 4 head ;

basis/stack-checker/backend/backend.factor

@@ -147,7 +147,7 @@ M: object apply-object push-literal ;
     {
         { [ dup deferred? ] [ drop f ] }
         { [ dup crossref? not ] [ drop f ] }
-        [ def>> [ word? ] contains? ]
+        [ def>> [ word? ] any? ]
     } cond ;
 
 : ?missing-effect ( word -- )

basis/stack-checker/branches/branches.factor

@@ -17,7 +17,7 @@ SYMBOL: +bottom+
 : pad-with-bottom ( seq -- newseq )
     dup empty? [
         dup [ length ] map supremum
-        '[ _ +bottom+ pad-left ] map
+        '[ _ +bottom+ pad-head ] map
     ] unless ;
 
 : phi-inputs ( max-d-in pairs -- newseq )
@@ -108,7 +108,7 @@ M: callable infer-branch
         (infer-if)
     ] [
         drop 2 consume-d
-        dup [ known [ curried? ] [ composed? ] bi or ] contains? [
+        dup [ known [ curried? ] [ composed? ] bi or ] any? [
             output-d
             [ rot [ drop call ] [ nip call ] if ]
             infer-quot-here

basis/stack-checker/transforms/transforms.factor

@@ -125,9 +125,9 @@ IN: stack-checker.transforms
     #! Can we use a fast byte array test here?
     {
         { [ dup length 8 < ] [ f ] }
-        { [ dup [ integer? not ] contains? ] [ f ] }
-        { [ dup [ 0 < ] contains? ] [ f ] }
-        { [ dup [ bit-member-n >= ] contains? ] [ f ] }
+        { [ dup [ integer? not ] any? ] [ f ] }
+        { [ dup [ 0 < ] any? ] [ f ] }
+        { [ dup [ bit-member-n >= ] any? ] [ f ] }
         [ t ]
     } cond nip ;
 

basis/syndication/syndication.factor

@@ -80,8 +80,8 @@ TUPLE: entry title url description date ;
         [ atom-entry-link >>url ]
         [
             { "content" "summary" } any-tag-named
-            dup children>> [ string? not ] contains?
-            [ children>> [ write-xml-chunk ] with-string-writer ]
+            dup children>> [ string? not ] any?
+            [ children>> xml>string ]
             [ children>string ] if >>description
         ]
         [

basis/tools/crossref/crossref-tests.factor

@@ -10,4 +10,4 @@ M: integer foo + ;
 "resource:basis/tools/crossref/test/foo.factor" run-file
 
 [ t ] [ integer \ foo method \ + usage member? ] unit-test
-[ t ] [ \ foo usage [ pathname? ] contains? ] unit-test
+[ t ] [ \ foo usage [ pathname? ] any? ] unit-test

basis/tools/disassembler/udis/udis.factor

@@ -59,8 +59,8 @@ SINGLETON: udis-disassembler
     dup [ second length ] map supremum
     '[
         [
-            [ first >hex cell 2 * CHAR: 0 pad-left % ": " % ]
-            [ second _ CHAR: \s pad-right % "  " % ]
+            [ first >hex cell 2 * CHAR: 0 pad-head % ": " % ]
+            [ second _ CHAR: \s pad-tail % "  " % ]
             [ third % ]
             tri
         ] "" make

basis/tools/files/files.factor

@@ -9,22 +9,22 @@ IN: tools.files
 
 : dir-or-size ( file-info -- str )
     dup directory? [
-        drop "<DIR>" 20 CHAR: \s pad-right
+        drop "<DIR>" 20 CHAR: \s pad-tail
     ] [
-        size>> number>string 20 CHAR: \s pad-left
+        size>> number>string 20 CHAR: \s pad-head
     ] if ;
 
 : listing-time ( timestamp -- string )
     [ hour>> ] [ minute>> ] bi
-    [ number>string 2 CHAR: 0 pad-left ] bi@ ":" glue ;
+    [ number>string 2 CHAR: 0 pad-head ] bi@ ":" glue ;
 
 : listing-date ( timestamp -- string )
     [ month>> month-abbreviation ]
-    [ day>> number>string 2 CHAR: \s pad-left ]
+    [ day>> number>string 2 CHAR: \s pad-head ]
     [
         dup year>> dup now year>> =
         [ drop listing-time ] [ nip number>string ] if
-        5 CHAR: \s pad-left
+        5 CHAR: \s pad-head
     ] tri 3array " " join ;
 
 : read>string ( ? -- string ) "r" "-" ? ; inline

basis/tools/hexdump/hexdump.factor

@@ -12,13 +12,13 @@ IN: tools.hexdump
     [ >hex write "h" write nl ] bi ;
 
 : write-offset ( lineno -- )
-    16 * >hex 8 CHAR: 0 pad-left write "h: " write ;
+    16 * >hex 8 CHAR: 0 pad-head write "h: " write ;
 
 : >hex-digit ( digit -- str )
-    >hex 2 CHAR: 0 pad-left " " append ;
+    >hex 2 CHAR: 0 pad-head " " append ;
 
 : >hex-digits ( bytes -- str )
-    [ >hex-digit ] { } map-as concat 48 CHAR: \s pad-right ;
+    [ >hex-digit ] { } map-as concat 48 CHAR: \s pad-tail ;
 
 : >ascii ( bytes -- str )
     [ [ printable? ] keep CHAR: . ? ] "" map-as ;

basis/tools/scaffold/scaffold.factor

@@ -22,7 +22,7 @@ ERROR: no-vocab vocab ;
 
 : contains-dot? ( string -- ? ) ".." swap subseq? ;
 
-: contains-separator? ( string -- ? ) [ path-separator? ] contains? ;
+: contains-separator? ( string -- ? ) [ path-separator? ] any? ;
 
 : check-vocab-name ( string -- string )
     dup contains-dot? [ vocab-name-contains-dot ] when
@@ -92,7 +92,7 @@ ERROR: no-vocab vocab ;
     ] if ;
 
 : lookup-type ( string -- object/string ? )
-    "new" ?head drop [ [ CHAR: ' = ] [ digit? ] bi or ] trim-right
+    "new" ?head drop [ [ CHAR: ' = ] [ digit? ] bi or ] trim-tail
     H{
         { "object" object } { "obj" object }
         { "quot" quotation }

basis/tools/vocabs/monitor/monitor.factor

@@ -9,8 +9,8 @@ IN: tools.vocabs.monitor
 TR: convert-separators "/\\" ".." ;
 
 : vocab-dir>vocab-name ( path -- vocab )
-    trim-left-separators
-    trim-right-separators
+    trim-head-separators
+    trim-tail-separators
     convert-separators ;
 
 : path>vocab-name ( path -- vocab )

basis/ui/x11/x11.factor

@@ -144,7 +144,7 @@ M: world selection-notify-event
 
 : supported-type? ( atom -- ? )
     { "UTF8_STRING" "STRING" "TEXT" }
-    [ x-atom = ] with contains? ;
+    [ x-atom = ] with any? ;
 
 : clipboard-for-atom ( atom -- clipboard )
     {

basis/unicode/collation/collation.factor

@@ -88,7 +88,7 @@ ducet insert-helpers
 : add ( char -- )
     dup blocked? [ 1string , ] [
         dup possible-bases dup length
-        [ ?combine ] with with contains?
+        [ ?combine ] with with any?
         [ drop ] [ 1string , ] if
     ] if ;
 
@@ -138,7 +138,7 @@ PRIVATE>
 : insensitive= ( str1 str2 levels-removed -- ? )
     [
         [ collation-key ] dip
-        [ [ 0 = not ] trim-right but-last ] times
+        [ [ 0 = not ] trim-tail but-last ] times
     ] curry bi@ = ;
 PRIVATE>
 

basis/unicode/data/data.factor

@@ -72,7 +72,7 @@ VALUE: properties
 
 : exclusions ( -- set )
     exclusions-file utf8 file-lines
-    [ "#" split1 drop [ blank? ] trim-right hex> ] map harvest ;
+    [ "#" split1 drop [ blank? ] trim-tail hex> ] map harvest ;
 
 : remove-exclusions ( alist -- alist )
     exclusions [ dup ] H{ } map>assoc assoc-diff ;

basis/unix/utmpx/utmpx.factor

@@ -33,7 +33,7 @@ HOOK: new-utmpx-record os ( -- utmpx-record )
 HOOK: utmpx>utmpx-record os ( utmpx -- utmpx-record )
 
 : memory>string ( alien n -- string )
-    memory>byte-array utf8 decode [ 0 = ] trim-right ;
+    memory>byte-array utf8 decode [ 0 = ] trim-tail ;
 
 M: unix new-utmpx-record
     utmpx-record new ;

basis/urls/encoding/encoding.factor

@@ -18,7 +18,7 @@ IN: urls.encoding
 
 : push-utf8 ( ch -- )
     1string utf8 encode
-    [ CHAR: % , >hex 2 CHAR: 0 pad-left % ] each ;
+    [ CHAR: % , >hex 2 CHAR: 0 pad-head % ] each ;
 
 PRIVATE>
 

basis/uuid/uuid.factor

@@ -43,7 +43,7 @@ IN: uuid
     ] dip 76 shift bitor ;
 
 : uuid>string ( n -- string )
-    >hex 32 CHAR: 0 pad-left 
+    >hex 32 CHAR: 0 pad-head 
     [ CHAR: - 20 ] dip insert-nth
     [ CHAR: - 16 ] dip insert-nth 
     [ CHAR: - 12 ] dip insert-nth 

basis/windows/kernel32/kernel32.factor

@@ -1179,7 +1179,7 @@ ALIAS: GetComputerNameEx GetComputerNameExW
 ! FUNCTION: GetConsoleSelectionInfo
 FUNCTION: DWORD GetConsoleTitleW ( LPWSTR lpConsoleTitle, DWORD nSize ) ;
 ALIAS: GetConsoleTitle GetConsoleTitleW
-! FUNCTION: GetConsoleWindow
+FUNCTION: HWND GetConsoleWindow ( ) ;
 ! FUNCTION: GetCPFileNameFromRegistry
 ! FUNCTION: GetCPInfo
 ! FUNCTION: GetCPInfoExA

basis/windows/ole32/ole32.factor

@@ -163,10 +163,10 @@ M: ole32-error error.
     ] keep ;
 
 : (guid-section%) ( guid quot len -- )
-    [ call >hex ] dip CHAR: 0 pad-left % ; inline
+    [ call >hex ] dip CHAR: 0 pad-head % ; inline
 
 : (guid-byte%) ( guid byte -- )
-    swap nth >hex 2 CHAR: 0 pad-left % ; inline
+    swap nth >hex 2 CHAR: 0 pad-head % ; inline
 
 : guid>string ( guid -- string )
     [

basis/xml/autoencoding/autoencoding.factor

@@ -2,14 +2,15 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel namespaces xml.name io.encodings.utf8 xml.elements
 io.encodings.utf16 xml.tokenize xml.state math ascii sequences
-io.encodings.string io.encodings combinators ;
+io.encodings.string io.encodings combinators accessors
+xml.data io.encodings.iana ;
 IN: xml.autoencoding
 
 : continue-make-tag ( str -- tag )
     parse-name-starting middle-tag end-tag ;
 
 : start-utf16le ( -- tag )
-    utf16le decode-input-if
+    utf16le decode-input
     "?\0" expect
     check instruct ;
 
@@ -17,20 +18,36 @@ IN: xml.autoencoding
     -6 shift 3 bitand 2 = ;
           
 : start<name ( ch -- tag )
+    ! This is unfortunate, and exists for the corner case
+    ! that the first letter of the document is < and second is
+    ! not ASCII
     ascii?
-    [ utf8 decode-input-if next make-tag ] [
+    [ utf8 decode-input next make-tag ] [
         next
         [ get-next 10xxxxxx? not ] take-until
         get-char suffix utf8 decode
-        utf8 decode-input-if next
+        utf8 decode-input next
         continue-make-tag
     ] if ;
-          
+
+: prolog-encoding ( prolog -- )
+    encoding>> dup "UTF-16" =
+    [ drop ] [ name>encoding [ decode-input ] when* ] if ;
+
+: instruct-encoding ( instruct/prolog -- )
+    dup prolog?
+    [ prolog-encoding ]
+    [ drop utf8 decode-input ] if ;
+
+: go-utf8 ( -- )
+    check utf8 decode-input next next ;
+
 : start< ( -- tag )
+    ! What if first letter of processing instruction is non-ASCII?
     get-next {
         { 0 [ next next start-utf16le ] }
-        { CHAR: ? [ check next next instruct ] } ! XML prolog parsing sets the encoding
-        { CHAR: ! [ check utf8 decode-input next next direct ] }
+        { CHAR: ? [ go-utf8 instruct dup instruct-encoding ] }
+        { CHAR: ! [ go-utf8 direct ] }
         [ check start<name ]
     } case ;
 
@@ -39,7 +56,7 @@ IN: xml.autoencoding
     "<" expect check make-tag ;
 
 : decode-expecting ( encoding string -- tag )
-    [ decode-input-if next ] [ expect ] bi* check make-tag ;
+    [ decode-input next ] [ expect ] bi* check make-tag ;
 
 : start-utf16be ( -- tag )
     utf16be "<" decode-expecting ;
@@ -57,8 +74,6 @@ IN: xml.autoencoding
         { HEX: EF [ skip-utf8-bom ] }
         { HEX: FF [ skip-utf16le-bom ] }
         { HEX: FE [ skip-utf16be-bom ] }
-        { f [ "" ] }
-        [ drop utf8 decode-input-if f ]
-        ! Same problem as with <e`>, in the case of XML chunks?
-    } case check ;
+        [ drop utf8 decode-input check f ]
+    } case ;
 

basis/xml/char-classes/char-classes.factor

@@ -26,7 +26,7 @@ CATEGORY: 1.1name-char Ll Lu Lo Lm Ln Nl Mc Mn Nd Pc Cf _-.\u0000b7: ;
     ! 1.1:
     ! [#x1-#xD7FF] | [#xE000-#xFFFD] | [#x10000-#x10FFFF]
     {
-        { [ dup HEX: 20 < ] [ "\t\r\n" member? and ] }
+        { [ dup HEX: 20 < ] [ swap [ "\t\r\n" member? ] [ zero? not ] if ] }
         { [ nip dup HEX: D800 < ] [ drop t ] }
         { [ dup HEX: E000 < ] [ drop f ] }
         [ { HEX: FFFE HEX: FFFF } member? not ]

basis/xml/data/data-docs.factor

@@ -13,15 +13,17 @@ ARTICLE: "xml.data" "XML data types"
 "For high-level tools for manipulating XML, see " { $vocab-link "xml.utilities" } ;
 
 ARTICLE: { "xml.data" "classes" } "XML data classes"
-    "Data types that XML documents are made of:"
-    { $subsection name }
+    "XML documents and chunks are made of the following classes:"
+    { $subsection xml }
+    { $subsection xml-chunk }
     { $subsection tag }
+    { $subsection name }
     { $subsection contained-tag }
     { $subsection open-tag }
-    { $subsection xml }
     { $subsection prolog }
     { $subsection comment }
     { $subsection instruction }
+    { $subsection unescaped }
     { $subsection element-decl }
     { $subsection attlist-decl }
     { $subsection entity-decl }
@@ -32,13 +34,15 @@ ARTICLE: { "xml.data" "classes" } "XML data classes"
 
 ARTICLE: { "xml.data" "constructors" } "XML data constructors"
     "These data types are constructed with:"
-    { $subsection <name> }
-    { $subsection <tag> }
-    { $subsection <contained-tag> }
     { $subsection <xml> }
+    { $subsection <xml-chunk> } 
+    { $subsection <tag> }
+    { $subsection <name> }
+    { $subsection <contained-tag> }
     { $subsection <prolog> }
     { $subsection <comment> }
     { $subsection <instruction> }
+    { $subsection <unescaped> }
     { $subsection <simple-name> }
     { $subsection <element-decl> }
     { $subsection <attlist-decl> }
@@ -89,7 +93,7 @@ HELP: xml
 HELP: <xml>
 { $values { "prolog" "an XML prolog" } { "before" "a sequence of XML elements" }
 { "body" tag } { "after" "a sequence of XML elements" } { "xml" "an XML document" } }
-{ $description "creates an XML document, delegating to the main tag, with the specified prolog, before, and after" }
+{ $description "Creates an XML document. The " { $snippet "before" } " and " { $snippet "after" } " slots store what comes before and after the main tag, and " { $snippet "body" } "contains the main tag itself." }
 { $see-also xml <tag> } ;
 
 HELP: prolog
@@ -99,47 +103,46 @@ HELP: prolog
 HELP: <prolog>
 { $values { "version" "a string, 1.0 or 1.1" }
 { "encoding" "a string" } { "standalone" "a boolean" } { "prolog" "an XML prolog" } }
-{ $description "creates an XML prolog tuple" }
+{ $description "Creates an XML prolog tuple." }
 { $see-also prolog <xml> } ;
 
 HELP: comment
-{ $class-description "represents a comment in XML. Has one slot, text, which contains the string of the comment" }
+{ $class-description "Represents a comment in XML. This tuple has one slot, " { $snippet "text" } ", which contains the string of the comment." }
 { $see-also <comment> } ;
 
 HELP: <comment>
-{ $values { "text" "a string" } { "comment" "a comment" } }
-{ $description "creates an XML comment tuple" }
+{ $values { "text" string } { "comment" comment } }
+{ $description "Creates an XML " { $link comment } " tuple." }
 { $see-also comment } ;
 
 HELP: instruction
-{ $class-description "represents an XML instruction, such as <?xsl stylesheet='foo.xml'?>. Contains one slot, text, which contains the string between the question marks." }
+{ $class-description "Represents an XML instruction, such as " { $snippet "<?xsl stylesheet='foo.xml'?>" } ". Contains one slot, " { $snippet "text" } ", which contains the string between the question marks." }
 { $see-also <instruction> } ;
 
 HELP: <instruction>
 { $values { "text" "a string" } { "instruction" "an XML instruction" } }
-{ $description "creates an XML parsing instruction, such as <?xsl stylesheet='foo.xml'?>." }
+{ $description "Creates an XML parsing instruction, like " { $snippet "<?xsl stylesheet='foo.xml'?>" } "." }
 { $see-also instruction } ;
 
 HELP: opener
-{ $class-description "describes an opening tag, like <a>. Contains two slots, name and attrs containing, respectively, the name of the tag and its attributes. Usually, the name-url will be f." }
-{ $see-also closer contained } ;
+{ $class-description "Describes an opening tag, like " { $snippet "<a>" } ". Contains two slots, " { $snippet "name" } " and " { $snippet "attrs" } " containing, respectively, the name of the tag and its attributes." } ;
 
 HELP: closer
-{ $class-description "describes a closing tag, like </a>. Contains one slot, name, containing the tag's name. Usually, the name-url will be f." }
-{ $see-also opener contained } ;
+{ $class-description "Describes a closing tag, like " { $snippet "</a>" } ". Contains one slot, " { $snippet "name" } ", containing the closer's name." } ;
 
 HELP: contained
-{ $class-description "represents a self-closing tag, like <a/>. Contains two slots, name and attrs containing, respectively, the name of the tag and its attributes. Usually, the name-url will be f." }
-{ $see-also opener closer } ;
+{ $class-description "Represents a self-closing tag, like " { $snippet "<a/>" } ". Contains two slots," { $snippet "name" } " and " { $snippet "attrs" } " containing, respectively, the name of the tag and its attributes." } ;
+
+{ opener closer contained } related-words
 
 HELP: open-tag
-{ $class-description "represents a tag that does have children, ie is not a contained tag" }
-{ $notes "the constructor used for this class is simply " { $link <tag> } "." }
+{ $class-description "Represents a tag that does have children, ie. is not a contained tag" }
+{ $notes "The constructor used for this class is simply " { $link <tag> } "." }
 { $see-also tag contained-tag } ;
 
 HELP: names-match?
 { $values { "name1" "a name" } { "name2" "a name" } { "?" "t or f" } }
-{ $description "checks to see if the two names match, that is, if all fields are equal, ignoring fields whose value is f in either name." }
+{ $description "Checks to see if the two names match, that is, if all fields are equal, ignoring fields whose value is f in either name." }
 { $example "USING: prettyprint xml.data ;" "T{ name f \"rpc\" \"methodCall\" f } T{ name f f \"methodCall\" \"http://www.xmlrpc.org/\" } names-match? ." "t" }
 { $see-also name } ;
 
@@ -173,7 +176,7 @@ HELP: <entity-decl>
 { $description "Creates an entity declaration object, of the class " { $link entity-decl } ". The pe? slot should be t if the object is a DTD-internal entity, like " { $snippet "<!ENTITY % foo 'bar'>" } " and f if the object is like " { $snippet "<!ENTITY foo 'bar'>" } ", that is, it can be used outside of the DTD." } ;
 
 HELP: system-id
-{ $class-description "Describes the class of system identifiers within an XML DTD directive, such as " { $snippet "<!DOCTYPE greeting " { $emphasis "SYSTEM 'hello.dtd'" } ">" } } ;
+{ $class-description "Describes the class of system identifiers within an XML DTD directive, such as " { $snippet "<!DOCTYPE greeting " { $emphasis "SYSTEM 'hello.dtd'" } ">" } "." } ;
 
 HELP: <system-id>
 { $values { "system-literal" string } { "system-id" system-id } }
@@ -199,3 +202,17 @@ HELP: doctype-decl
 HELP: <doctype-decl>
 { $values { "name" name } { "external-id" id } { "internal-subset" sequence } { "doctype-decl" doctype-decl } }
 { $description "Creates a new doctype declaration object, of the class " { $link doctype-decl } ". Only one of external-id or internal-subset will be non-null." } ;
+
+HELP: unescaped
+{ $class-description "When constructing XML documents to write to output, it can be useful to splice in a string which is already written. This tuple type allows for that. Printing an " { $snippet "unescaped" } " is the same is printing its " { $snippet "string" } " slot." } ;
+
+HELP: <unescaped>
+{ $values { "string" string } { "unescaped" unescaped } }
+{ $description "Constructs an " { $link unescaped } " tuple, given a string." } ;
+
+HELP: xml-chunk
+{ $class-description "Encapsulates a balanced fragment of an XML document. This is a sequence (following the sequence protocol) of XML data types, eg " { $link string } "s and " { $link tag } "s." } ;
+
+HELP: <xml-chunk>
+{ $values { "seq" sequence } { "xml-chunk" xml-chunk } }
+{ $description "Constructs an " { $link xml-chunk } " tuple, given a sequence to be its contents." } ;

basis/xml/elements/elements.factor

@@ -29,7 +29,7 @@ IN: xml.elements
     parse-name swap ;
 
 : (middle-tag) ( -- )
-    pass-blank version=1.0? get-char name-start?
+    pass-blank version-1.0? get-char name-start?
     [ parse-attr (middle-tag) ] when ;
 
 : assure-no-duplicates ( attrs-alist -- attrs-alist )
@@ -66,7 +66,8 @@ IN: xml.elements
 
 : prolog-version ( alist -- version )
     T{ name { space "" } { main "version" } } swap at
-    [ good-version ] [ versionless-prolog ] if* ;
+    [ good-version ] [ versionless-prolog ] if*
+    dup set-version ;
 
 : prolog-encoding ( alist -- encoding )
     T{ name { space "" } { main "encoding" } } swap at
@@ -89,16 +90,9 @@ IN: xml.elements
     [ prolog-standalone ]
     tri <prolog> ;
 
-SYMBOL: string-input?
-: decode-input-if ( encoding -- )
-    string-input? get [ drop ] [ decode-input ] if ;
-
 : parse-prolog ( -- prolog )
     pass-blank middle-tag "?>" expect
-    dup assure-no-extra prolog-attrs
-    dup encoding>> dup "UTF-16" =
-    [ drop ] [ name>encoding [ decode-input-if ] when* ] if
-    dup prolog-data set ;
+    dup assure-no-extra prolog-attrs ;
 
 : instruct ( -- instruction )
     take-name {

basis/xml/entities/entities-docs.factor

@@ -12,11 +12,10 @@ ARTICLE: "xml.entities" "XML entities"
 "For entities used in HTML/XHTML, see " { $vocab-link "xml.entities.html" } ;
 
 HELP: entities
-{ $description "a hash table from default XML entity names (like & and <) to the characters they represent. This is automatically included when parsing any XML document." }
+{ $description "A hash table from default XML entity names (like " { $snippet "&" } " and " { $snippet "<" } ") to the characters they represent. This is automatically included when parsing any XML document." }
 { $see-also with-entities } ;
 
 HELP: with-entities
-{ $values { "entities" "a hash table of strings to chars" }
-    { "quot" "a quotation ( -- )" } }
-{ $description "calls the quotation using the given table of entity values (symbolizing, eg, that &foo; represents CHAR: a) on top of the default XML entities" } ;
+{ $values { "entities" "a hash table of strings to strings" } { "quot" "a quotation ( -- )" } }
+{ $description "Calls the quotation using the given table of entity values (symbolizing, eg, that " { $snippet "&foo;" } " represents " { $snippet "\"a\"" } ") on top of the default XML entities" } ;
 

basis/xml/entities/html/html-docs.factor

@@ -5,14 +5,14 @@ IN: xml.entities.html
 
 ARTICLE: "xml.entities.html" "HTML entities"
 { $vocab-link "xml.entities.html" } " defines words for using entities defined in HTML/XHTML."
-    { $subsection html-entities }
-    { $subsection with-html-entities } ;
+{ $subsection html-entities }
+{ $subsection with-html-entities } ;
 
 HELP: html-entities
-{ $description "a hash table from HTML entity names to their character values" }
+{ $description "A hash table from HTML entity names to their character values." }
 { $see-also entities with-html-entities } ;
 
 HELP: with-html-entities
 { $values { "quot" "a quotation ( -- )" } }
-{ $description "calls the given quotation using HTML entity values" }
+{ $description "Calls the given quotation using HTML entity values." }
 { $see-also html-entities with-entities } ;

basis/xml/errors/errors-docs.factor

@@ -3,45 +3,60 @@
 USING: help.markup help.syntax ;
 IN: xml.errors
 
+<PRIVATE
+
+: $xml-error ( element -- )
+    "Bad XML document for the error" $heading $code ;
+
+PRIVATE>
+
 HELP: multitags
-{ $class-description "XML parsing error describing the case where there is more than one main tag in a document. Contains no slots" } ;
+{ $class-description "XML parsing error describing the case where there is more than one main tag in a document." }
+{ $xml-error "<a/>\n<b/>" } ;
 
 HELP: notags
-{ $class-description "XML parsing error describing the case where an XML document contains no main tag, or any tags at all" } ;
+{ $class-description "XML parsing error describing the case where an XML document contains no main tag, or any tags at all" }
+{ $xml-error "<?xml version='1.0'?>" } ;
 
 HELP: extra-attrs
-{ $class-description "XML parsing error describing the case where the XML prolog (" { $snippet "<?xml ...?>" } ") contains attributes other than the three allowed ones, standalone, version and encoding. Contains one slot, attrs, which is a hashtable of all the extra attributes' names. Delegates to " { $link xml-error-at } "." } ;
+{ $class-description "XML parsing error describing the case where the XML prolog (" { $snippet "<?xml ...?>" } ") contains attributes other than the three allowed ones, " { $snippet "standalone" } ", " { $snippet "version" } " and " { $snippet "encoding" } ". Contains one slot, " { $snippet "attrs" } ", which is a hashtable of all the extra attributes' names. This is a subclass of " { $link xml-error-at } "." }
+{ $xml-error "<?xml version='1.0' reason='because I said so'?>\n<foo/>" } ;
 
 HELP: nonexist-ns
-{ $class-description "XML parsing error describing the case where a namespace doesn't exist but it is used in a tag. Contains one slot, name, which contains the name of the undeclared namespace, and delegates to " { $link xml-error-at } "." } ;
+{ $class-description "XML parsing error describing the case where a namespace doesn't exist but it is used in a tag. Contains one slot, " { $snippet "name" } ", which contains the name of the undeclared namespace, and is a subclass of " { $link xml-error-at } "." }
+{ $xml-error "<a:b>c</a:b>" } ;
 
 HELP: not-yes/no
-{ $class-description "XML parsing error used to describe the case where standalone is set in the XML prolog to something other than 'yes' or 'no'. Delegates to " { $link xml-error-at } " and contains one slot, text, which contains offending value." } ;
+{ $class-description "XML parsing error used to describe the case where standalone is set in the XML prolog to something other than " { $snippet "yes" } " or " { $snippet "no" } ". This is a subclass of " { $link xml-error-at } " and contains one slot, text, which contains offending value." }
+{ $xml-error "<?xml version='1.0' standalone='maybe'?>\n<x/>" } ;
 
 HELP: unclosed
-{ $class-description "XML parsing error used to describe the case where the XML document contains classes which are not closed by the end of the document. Contains one slot, tags, a sequence of names." } ;
+{ $class-description "XML parsing error used to describe the case where the XML document contains classes which are not closed by the end of the document. Contains one slot, " { $snippet "tags" } ", a sequence of names." }
+{ $xml-error "<x>some text" } ;
 
 HELP: mismatched
-{ $class-description "XML parsing error describing mismatched tags, eg " { $snippet "<a></c>" } ". Contains two slots: open is the name of the opening tag and close is the name of the closing tag. Delegates to " { $link xml-error-at } " showing the location of the closing tag" } ;
+{ $class-description "XML parsing error describing mismatched tags. Contains two slots: " { $snippet "open" } " is the name of the opening tag and " { $snippet "close" } " is the name of the closing tag. This is a subclass of " { $link xml-error-at } " showing the location of the closing tag" }
+{ $xml-error "<a></c>" } ;
 
 HELP: expected
-{ $class-description "XML parsing error describing when an expected token was not present. Delegates to " { $link xml-error-at } ". Contains two slots, should-be, which has the expected string, and was, which has the actual string." } ;
+{ $class-description "XML parsing error describing when an expected token was not present. Delegates to " { $link xml-error-at } ". Contains two slots, " { $snippet "should-be" } ", which has the expected string, and " { $snippet "was" } ", which has the actual string." } ;
 
 HELP: no-entity
-{ $class-description "XML parsing error describing the use of an undefined entity in a case where standalone is marked yes. Delegates to " { $link xml-error-at } ". Contains one slot, thing, containing a string representing the entity." } ;
+{ $class-description "XML parsing error describing the use of an undefined entity. This is a subclass of " { $link xml-error-at } ". Contains one slot, thing, containing a string representing the entity." }
+{ $xml-error "<x>&foo;</x>" } ;
 
 
 HELP: pre/post-content
-{ $class-description "Describes the error where a non-whitespace string is used before or after the main tag in an XML document. Contains two slots: string contains the offending string, and pre? is t if it occured before the main tag and f if it occured after" } ;
-
-HELP: unclosed-quote
-{ $class-description "Describes the error where a quotation for an attribute value is opened but not closed before the end of the document." } ;
+{ $class-description "Describes the error where a non-whitespace string is used before or after the main tag in an XML document. Contains two slots: " { $snippet "string" } " contains the offending string, and " { $snippet "pre?" } " is " { $snippet "t" } " if it occured before the main tag and " { $snippet "f" } " if it occured after." }
+{ $xml-error "hello\n<main-tag/>" } ;
 
 HELP: bad-name
-{ $class-description "Describes the error where a name is used, for example in an XML tag or attribute key, which is invalid." } ;
+{ $class-description "Describes the error where a name is used, for example in an XML tag or attribute key, which is invalid." }
+{ $xml-error "<%>\n</%>" } ;
 
 HELP: quoteless-attr
-{ $class-description "Describes the error where an attribute of an XML tag is missing quotes around a value." } ;
+{ $class-description "Describes the error where an attribute of an XML tag is missing quotes around a value." }
+{ $xml-error "<tag foo=bar/>" } ;
 
 HELP: disallowed-char
 { $class-description "Describes the error where a disallowed character occurs in an XML document." } ;
@@ -53,25 +68,30 @@ HELP: unexpected-end
 { $class-description "Describes the error where a document unexpectedly ends, and the XML parser expected it to continue." } ;
 
 HELP: duplicate-attr
-{ $class-description "Describes the error where there is more than one attribute of the same key." } ;
+{ $class-description "Describes the error where there is more than one attribute of the same key." }
+{ $xml-error "<tag value='1' value='2'/>" } ;
 
 HELP: bad-cdata
-{ $class-description "Describes the error where CDATA is used outside of the main tag of an XML document." } ;
+{ $class-description "Describes the error where CDATA is used outside of the main tag of an XML document." }
+{ $xml-error "<x>y</x>\n<![CDATA[]]>" } ;
 
 HELP: text-w/]]>
-{ $class-description "Describes the error where a text node contains the literal string " { $snippet "]]>" } " which is disallowed." } ;
+{ $class-description "Describes the error where a text node contains the literal string " { $snippet "]]>" } " which is disallowed." }
+{ $xml-error "<x>Here's some text: ]]> there it was</x>" } ;
 
 HELP: attr-w/<
-{ $class-description "Describes the error where an attribute value contains the literal character " { $snippet "<" } " which is disallowed." } ;
+{ $class-description "Describes the error where an attribute value contains the literal character " { $snippet "<" } " which is disallowed." }
+{ $xml-error "<x value='bar<baz'/>" } ;
 
 HELP: misplaced-directive
-{ $class-description "Describes the error where an internal DTD directive is used outside of a DOCTYPE or DTD file, or where a DOCTYPE occurs somewhere other than before the main tag of an XML document." } ;
+{ $class-description "Describes the error where an internal DTD directive is used outside of a DOCTYPE or DTD file, or where a DOCTYPE occurs somewhere other than before the main tag of an XML document." }
+{ $xml-error "<x><!ENTITY foo 'bar'></x>" } ;
 
 HELP: xml-error
 { $class-description "The exception class that all parsing errors in XML documents are in." } ;
 
 ARTICLE: "xml.errors" "XML parsing errors"
-"The " { $vocab-link "xml.errors" } " vocabulary provides a rich and highly inspectable set of parsing errors. All XML errors are described by the union class " { $link xml-error } " but there are many classes contained in that:"
+"The " { $vocab-link "xml.errors" } " vocabulary provides a rich and highly inspectable set of parsing errors. All XML errors are described by the union class " { $link xml-error } "."
     { $subsection multitags }
     { $subsection notags }
     { $subsection extra-attrs }
@@ -93,7 +113,7 @@ ARTICLE: "xml.errors" "XML parsing errors"
     { $subsection text-w/]]> }
     { $subsection attr-w/< }
     { $subsection misplaced-directive }
-    "Additionally, most of these errors are a kind of " { $link xml-error-at } " which provides more information"
+    "Additionally, most of these errors are a kind of " { $link xml-error-at } " which provides more information about where the error occurred."
     $nl
     "Note that, in parsing an XML document, only the first error is reported." ;
 

basis/xml/errors/errors.factor

@@ -194,7 +194,7 @@ M: bad-prolog summary ( obj -- str )
     [
         dup call-next-method write
         "Misplaced XML prolog" print
-        prolog>> write-prolog nl
+        prolog>> write-xml nl
     ] with-string-writer ;
 
 TUPLE: capitalized-prolog < xml-error-at name ;
@@ -258,7 +258,7 @@ M: misplaced-directive summary ( obj -- str )
     [
         dup call-next-method write
         "Misplaced directive:" print
-        dir>> write-xml-chunk nl
+        dir>> write-xml nl
     ] with-string-writer ;
 
 TUPLE: bad-name < xml-error-at name ;

basis/xml/interpolate/interpolate-tests.factor

@@ -51,8 +51,8 @@ IN: xml.interpolate.tests
   <XML <x number=<-> false=<-> url=<-> string=<-> word=<->/> XML>
   pprint-xml>string  ] unit-test
 
-[ "<x>3</x>" ] [ 3 [XML <x><-></x> XML] xml-chunk>string ] unit-test
-[ "<x></x>" ] [ f [XML <x><-></x> XML] xml-chunk>string ] unit-test
+[ "<x>3</x>" ] [ 3 [XML <x><-></x> XML] xml>string ] unit-test
+[ "<x></x>" ] [ f [XML <x><-></x> XML] xml>string ] unit-test
 
 \ <XML must-infer
 [ { } "" interpolate-xml ] must-infer

basis/xml/interpolate/interpolate.factor

@@ -3,7 +3,7 @@
 USING: xml xml.state kernel sequences fry assocs xml.data
 accessors strings make multiline parser namespaces macros
 sequences.deep generalizations words combinators
-math present arrays ;
+math present arrays unicode.categories ;
 IN: xml.interpolate
 
 <PRIVATE
@@ -95,7 +95,7 @@ M: xml-chunk interpolate-xml
     } cond ;
 
 : parse-def ( accum delimiter quot -- accum )
-    [ parse-multiline-string 1 short head* ] dip call
+    [ parse-multiline-string [ blank? ] trim ] dip call
     [ extract-variables collect ] keep swap
     [ number<-> parsed ] dip
     [ \ interpolate-xml parsed ] when ; inline

basis/xml/name/name.factor

@@ -47,7 +47,7 @@ SYMBOL: ns-stack
 
 : valid-name? ( str -- ? )
     [ f ] [
-        version=1.0? swap {
+        version-1.0? swap {
             [ first name-start? ]
             [ rest-slice [ name-char? ] with all? ]
         } 2&&
@@ -66,7 +66,7 @@ SYMBOL: ns-stack
     ] ?if ;
 
 : take-name ( -- string )
-    version=1.0? '[ _ get-char name-char? not ] take-until ;
+    version-1.0? '[ _ get-char name-char? not ] take-until ;
 
 : parse-name ( -- name )
     take-name interpret-name ;

basis/xml/state/state.factor

@@ -3,7 +3,7 @@
 USING: accessors kernel namespaces io ;
 IN: xml.state
 
-TUPLE: spot char line column next check ;
+TUPLE: spot char line column next check version-1.0? ;
 
 C: <spot> spot
 
@@ -17,11 +17,12 @@ C: <spot> spot
 : set-next ( char -- ) spot get swap >>next drop ;
 : get-check ( -- ? ) spot get check>> ;
 : check ( -- ) spot get t >>check drop ;
+: version-1.0? ( -- ? ) spot get version-1.0?>> ;
+: set-version ( string -- )
+    spot get swap "1.0" = >>version-1.0? drop ;
 
 SYMBOL: xml-stack
 
-SYMBOL: prolog-data
-
 SYMBOL: depth
 
 SYMBOL: interpolating?

basis/xml/tests/templating.factor

@@ -9,10 +9,10 @@ SYMBOL: ref-table
 
 GENERIC: (r-ref) ( xml -- )
 M: tag (r-ref)
-    sub-tag over at* [
+    dup sub-tag attr [
         ref-table get at
         >>children drop
-    ] [ 2drop ] if ;
+    ] [ drop ] if* ;
 M: object (r-ref) drop ;
 
 : template ( xml -- )