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

2009-04-18 11:34:03 -05:00 · 2009-04-18 11:34:03 -05:00 · badefd0865
parent 7e5ab38ed1 9add08c200
commit badefd0865
95 changed files with 1615 additions and 314 deletions
--- a/basis/alien/parser/parser.factor
+++ b/basis/alien/parser/parser.factor
@ -1,7 +1,7 @@
-! Copyright (C) 2008 Slava Pestov.
+! Copyright (C) 2008, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: alien alien.c-types arrays assocs effects grouping kernel
-parser sequences splitting words fry locals ;
+parser sequences splitting words fry locals lexer namespaces ;
 IN: alien.parser

 : parse-arglist ( parameters return -- types effect )
@ -12,8 +12,15 @@ IN: alien.parser
 : function-quot ( return library function types -- quot )
    '[ _ _ _ _ alien-invoke ] ;

-:: define-function ( return library function parameters -- )
+:: make-function ( return library function parameters -- word quot effect )
    function create-in dup reset-generic
    return library function
-    parameters return parse-arglist [ function-quot ] dip
-    define-declared ;
+    parameters return parse-arglist [ function-quot ] dip ;
+
+: (FUNCTION:) ( -- word quot effect )
+    scan "c-library" get scan ";" parse-tokens
+    [ "()" subseq? not ] filter
+    make-function ;
+
+: define-function ( return library function parameters -- )
+    make-function define-declared ;
--- a/basis/alien/syntax/syntax.factor
+++ b/basis/alien/syntax/syntax.factor
@ -16,9 +16,7 @@ SYNTAX: BAD-ALIEN <bad-alien> parsed ;
 SYNTAX: LIBRARY: scan "c-library" set ;

 SYNTAX: FUNCTION:
-    scan "c-library" get scan ";" parse-tokens
-    [ "()" subseq? not ] filter
-    define-function ;
+    (FUNCTION:) define-declared ;

 SYNTAX: TYPEDEF:
    scan scan typedef ;
--- a/basis/compiler/errors/errors-docs.factor
+++ b/basis/compiler/errors/errors-docs.factor
@ -2,33 +2,4 @@ IN: compiler.errors
 USING: help.markup help.syntax vocabs.loader words io
 quotations words.symbol ;

-ARTICLE: "compiler-errors" "Compiler warnings and errors"
-"After loading a vocabulary, you might see messages like:"
-{ $code
-    ":errors - print 2 compiler errors"
-    ":warnings - print 50 compiler warnings"
-}
-"These messages arise from the compiler's stack effect checker. Production code should not have any warnings and errors in it. Warning and error conditions are documented in " { $link "inference-errors" } "."
-$nl
-"Words to view warnings and errors:"
-{ $subsection :warnings }
-{ $subsection :errors }
-{ $subsection :linkage }
-"Compiler warnings and errors are reported using the " { $link "tools.errors" } " mechanism and are shown in the " { $link "ui.tools.error-list" } "." ;
-
-HELP: compiler-error
-{ $values { "error" "an error" } { "word" word } }
-{ $description "Saves the error for future persual via " { $link :errors } ", " { $link :warnings } " and " { $link :linkage } "." } ;
-
-HELP: :errors
-{ $description "Prints all serious compiler errors from the most recent compile to " { $link output-stream } "." } ;
-
-HELP: :warnings
-{ $description "Prints all ignorable compiler warnings from the most recent compile to " { $link output-stream } "." } ;
-
-HELP: :linkage
-{ $description "Prints all C library interface linkage errors from the most recent compile to " { $link output-stream } "." } ;
-
-{ :errors :warnings } related-words
-
 ABOUT: "compiler-errors"
--- a/basis/compiler/errors/errors.factor
+++ b/basis/compiler/errors/errors.factor
@ -1,7 +1,6 @@
 ! Copyright (C) 2007, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors source-files.errors kernel namespaces assocs
-tools.errors ;
+USING: accessors source-files.errors kernel namespaces assocs ;
 IN: compiler.errors

 TUPLE: compiler-error < source-file-error ;
@ -53,12 +52,3 @@ T{ error-type
 : compiler-error ( error word -- )
    compiler-errors get-global pick
    [ [ [ <compiler-error> ] keep ] dip set-at ] [ delete-at drop ] if ;
-
-: compiler-errors. ( type -- )
-    errors-of-type values errors. ;
-
-: :errors ( -- ) +compiler-error+ compiler-errors. ;
-
-: :warnings ( -- ) +compiler-warning+ compiler-errors. ;
-
-: :linkage ( -- ) +linkage-error+ compiler-errors. ;
--- a/basis/editors/gedit/authors.txt
+++ b/basis/editors/gedit/authors.txt
@ -0,0 +1 @@
+Doug Coleman
--- a/basis/editors/gedit/gedit.factor
+++ b/basis/editors/gedit/gedit.factor
@ -0,0 +1,17 @@
+! Copyright (C) 2008 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: editors io.launcher kernel make math.parser namespaces
+sequences ;
+IN: editors.gedit
+
+: gedit-path ( -- path )
+    \ gedit-path get-global [
+        "gedit"
+    ] unless* ;
+
+: gedit ( file line -- )
+    [
+        gedit-path , number>string "+" prepend , ,
+    ] { } make run-detached drop ;
+
+[ gedit ] edit-hook set-global
--- a/basis/editors/gedit/summary.txt
+++ b/basis/editors/gedit/summary.txt
@ -0,0 +1 @@
+gedit integration
--- a/unmaintained/openal/macosx/tags.txt
+++ b/unmaintained/openal/macosx/tags.txt
--- a/basis/generalizations/generalizations.factor
+++ b/basis/generalizations/generalizations.factor
@ -7,7 +7,7 @@ IN: generalizations

 <<

-: n*quot ( n quot -- seq' ) <repetition> concat >quotation ;
+: n*quot ( n quot -- quot' ) <repetition> concat >quotation ;

 : repeat ( n obj quot -- ) swapd times ; inline

--- a/basis/http/client/client.factor
+++ b/basis/http/client/client.factor
@ -184,6 +184,12 @@ ERROR: download-failed response ;
 : http-put ( post-data url -- response data )
    <put-request> http-request ;

+: <delete-request> ( url -- request )
+    "DELETE" <client-request> ;
+
+: http-delete ( url -- response data )
+    <delete-request> http-request ;
+
 USING: vocabs vocabs.loader ;

 "debugger" vocab [ "http.client.debugger" require ] when
--- a/basis/math/matrices/authors.txt
+++ b/basis/math/matrices/authors.txt
--- a/basis/math/matrices/elimination/authors.txt
+++ b/basis/math/matrices/elimination/authors.txt
--- a/basis/math/matrices/elimination/elimination-tests.factor
+++ b/basis/math/matrices/elimination/elimination-tests.factor
--- a/basis/math/matrices/elimination/elimination.factor
+++ b/basis/math/matrices/elimination/elimination.factor
--- a/basis/math/matrices/elimination/summary.txt
+++ b/basis/math/matrices/elimination/summary.txt
--- a/basis/math/matrices/matrices-tests.factor
+++ b/basis/math/matrices/matrices-tests.factor
--- a/basis/math/matrices/matrices.factor
+++ b/basis/math/matrices/matrices.factor
--- a/basis/math/matrices/summary.txt
+++ b/basis/math/matrices/summary.txt
--- a/basis/refs/authors.txt
+++ b/basis/refs/authors.txt
@ -1 +1,2 @@
 Slava Pestov
+Alex Chapman
--- a/basis/refs/refs-docs.factor
+++ b/basis/refs/refs-docs.factor
@ -1,38 +1,90 @@
-! Copyright (C) 2007 Slava Pestov
+! Copyright (C) 2007 Slava Pestov, 2009 Alex Chapman
 ! See http://factorcode.org/license.txt for BSD license.
-USING: help.markup help.syntax kernel ;
+USING: boxes help.markup help.syntax kernel math namespaces ;
 IN: refs

-ARTICLE: "refs" "References to assoc entries"
-"A " { $emphasis "reference" } " is an object encapsulating an assoc and a key; the reference then refers to either the key itself, or the value associated to the key. References can be read, written, and deleted. References are defined in the " { $vocab-link "refs" } " vocabulary."
+ARTICLE: "refs" "References"
+"References provide a uniform way of accessing and changing values. Some examples of referenced values are variables, tuple slots, and keys or values of assocs. References can be read, written, and deleted. References are defined in the " { $vocab-link "refs" } " vocabulary, and new reference types can be made by implementing the " { $link "refs-protocol" } "."
 { $subsection get-ref }
 { $subsection set-ref }
+{ $subsection set-ref* }
 { $subsection delete-ref }
-"References to keys:"
+"References to objects:"
+{ $subsection obj-ref }
+{ $subsection <obj-ref> }
+"References to assoc keys:"
 { $subsection key-ref }
 { $subsection <key-ref> }
-"References to values:"
+"References to assoc values:"
 { $subsection value-ref }
 { $subsection <value-ref> }
+"References to variables:"
+{ $subsection var-ref }
+{ $subsection <var-ref> }
+{ $subsection global-var-ref }
+{ $subsection <global-var-ref> }
+"References to tuple slots:"
+{ $subsection slot-ref }
+{ $subsection <slot-ref> }
+"Using boxes as references:"
+{ $subsection "box-refs" }
 "References are used by the UI inspector." ;

 ABOUT: "refs"

+ARTICLE: "refs-protocol" "Reference Protocol"
+"To use a class of objects as references you must implement the reference protocol for that class, and mark your class as an instance of the " { $link ref } " mixin class. All references must implement these two words:"
+{ $subsection get-ref }
+{ $subsection set-ref }
+"References may also implement:"
+{ $subsection delete-ref } ;
+
+ARTICLE: "box-refs" "Using Boxes as References"
+"Boxes are elements of the " { $link ref } " mixin class, so any box may be used as a reference. Bear in mind that boxes will still throw an error if you call " { $link get-ref } " on an empty box." ;
+
 HELP: ref
-{ $class-description "A class whose instances identify a key or value location in an associative structure. Instances of this clas are never used directly; only instances of " { $link key-ref } " and " { $link value-ref } " should be created." } ;
+{ $class-description "A mixin class whose instances encapsulate a value which can be read, written, and deleted. Instantiable members of this class include:" { $link obj-ref } ", " { $link var-ref } ", " { $link global-var-ref } ", " { $link slot-ref } ", " { $link box } ", " { $link key-ref } ", and " { $link value-ref } "." } ;

 HELP: delete-ref
 { $values { "ref" ref } }
-{ $description "Deletes the association entry pointed at by this reference." } ;
+{ $description "Deletes the value pointed to by this reference. In most references this simply sets the value to f, but in some cases it is more destructive, such as in " { $link value-ref } " and " { $link key-ref } ", where it actually deletes the entry from the underlying assoc." } ;

 HELP: get-ref
 { $values { "ref" ref } { "obj" object } }
-{ $description "Outputs the key or the value pointed at by this reference." } ;
+{ $description "Outputs the value pointed at by this reference." } ;

 HELP: set-ref
 { $values { "obj" object } { "ref" ref } }
-{ $description "Stores a new key or value at by this reference." } ;
+{ $description "Stores a new value at this reference." } ;

+HELP: obj-ref
+{ $class-description "Instances of this class contain a value which can be changed using the " { $link "refs-protocol" } ". New object references are created by calling " { $link <obj-ref> } "." } ;
+
+HELP: <obj-ref>
+{ $values { "obj" object } { "obj-ref" obj-ref } }
+{ $description "Creates a reference which contains the value it references." } ;
+
+HELP: var-ref
+{ $class-description "Instances of this class reference a variable as defined by the " { $vocab-link "namespaces" } " vocabulary. New variable references are created by calling " { $link <var-ref> } "." } ;
+
+HELP: <var-ref>
+{ $values { "var" object } { "var-ref" var-ref } }
+{ $description "Creates a reference to the given variable. Note that this reference behaves just like any variable when it comes to dynamic scope. For example, if you use " { $link set-ref } " in an inner scope and then leave that scope, then calling " { $link get-ref } " may not return the expected value. If this is not what you want, try using an " { $link obj-ref } " instead." } ;
+ 
+HELP: global-var-ref
+{ $class-description "Instances of this class reference a global variable. New global references are created by calling " { $link <global-var-ref> } "." } ;
+
+HELP: <global-var-ref>
+{ $values { "var" object } { "global-var-ref" global-var-ref } }
+{ $description "Creates a reference to a global variable." } ;
+
+HELP: slot-ref
+{ $class-description "Instances of this class identify a particular slot of a particular instance of a tuple. New slot references are created by calling " { $link <slot-ref> } "." } ;
+
+HELP: <slot-ref>
+{ $values { "tuple" tuple } { "slot" integer } { "slot-ref" slot-ref } }
+{ $description "Creates a reference to the value in a particular slot of the given tuple. The slot must be given as an integer, where the first user-defined slot is number 2. This is mostly just a proof of concept until we have a way of generating this slot number from a slot name." } ;
+  
 HELP: key-ref
 { $class-description "Instances of this class identify a key in an associative structure. New key references are created by calling " { $link <key-ref> } "." } ;

@ -47,6 +99,37 @@ HELP: <value-ref>
 { $values { "assoc" "an assoc" } { "key" object } { "value-ref" value-ref } }
 { $description "Creates a reference to the value associated with " { $snippet "key" } " in " { $snippet "assoc" } "." } ;

-{ get-ref set-ref delete-ref } related-words
+{ get-ref set-ref delete-ref set-ref* } related-words
+  
+{ <obj-ref> <var-ref> <global-var-ref> <slot-ref> <key-ref> <value-ref> } related-words

-{ <key-ref> <value-ref> } related-words
+HELP: set-ref*
+{ $values { "ref" ref } { "obj" object } }
+{ $description "Just like " { $link set-ref } ", but leave the ref on the stack." } ;
+
+HELP: ref-on
+{ $values { "ref" ref } }
+{ $description "Sets the value of the ref to t." } ;
+
+HELP: ref-off
+{ $values { "ref" ref } }
+{ $description "Sets the value of the ref to f." } ;
+
+HELP: ref-inc
+{ $values { "ref" ref } }
+{ $description "Increment the value of the ref by 1." } ;
+
+HELP: ref-dec
+{ $values { "ref" ref } }
+{ $description "Decrement the value of the ref by 1." } ;
+
+HELP: take
+{ $values { "ref" ref } { "obj" object } }
+{ $description "Retrieve the value of the ref and then delete it, returning the value." } ;
+  
+{ ref-on ref-off ref-inc ref-dec take } related-words
+{ take delete-ref } related-words
+{ on ref-on } related-words
+{ off ref-off } related-words
+{ inc ref-inc } related-words
+{ dec ref-dec } related-words
--- a/basis/refs/refs-tests.factor
+++ b/basis/refs/refs-tests.factor
@ -1,5 +1,7 @@
-USING: refs tools.test kernel ;
+USING: boxes kernel namespaces refs tools.test ;
+IN: refs.tests

+! assoc-refs
 [ 3 ] [
    H{ { "a" 3 } } "a" <value-ref> get-ref
 ] unit-test
@ -20,3 +22,84 @@ USING: refs tools.test kernel ;
        set-ref
    ] keep
 ] unit-test
+
+SYMBOLS: lion giraffe elephant rabbit ;
+
+! obj-refs
+[ rabbit ] [ rabbit <obj-ref> get-ref ] unit-test
+[ rabbit ] [ f <obj-ref> rabbit set-ref* get-ref ] unit-test
+[ rabbit ] [ rabbit <obj-ref> take ] unit-test
+[ rabbit f ] [ rabbit <obj-ref> [ take ] keep get-ref ] unit-test
+[ lion ] [ rabbit <obj-ref> dup [ drop lion ] change-ref get-ref ] unit-test
+
+! var-refs 
+[ giraffe ] [ [ giraffe rabbit set rabbit <var-ref> get-ref ] with-scope ] unit-test
+
+[ rabbit ]
+[
+    [
+        lion rabbit set [
+            rabbit rabbit set rabbit <var-ref> get-ref
+        ] with-scope
+    ] with-scope
+] unit-test
+
+[ rabbit ] [
+    rabbit <var-ref>
+    [
+        lion rabbit set [
+            rabbit rabbit set get-ref
+        ] with-scope
+    ] with-scope
+] unit-test
+
+[ elephant ] [
+    rabbit <var-ref>
+    [
+        elephant rabbit set [
+            rabbit rabbit set
+        ] with-scope
+        get-ref
+    ] with-scope
+] unit-test
+
+[ rabbit ] [
+    rabbit <var-ref>
+    [
+        elephant set-ref* [
+            rabbit set-ref* get-ref
+        ] with-scope
+    ] with-scope
+] unit-test
+
+[ elephant ] [
+    rabbit <var-ref>
+    [
+        elephant set-ref* [
+            rabbit set-ref*
+        ] with-scope
+        get-ref
+    ] with-scope
+] unit-test
+
+! Top Hats
+[ lion ] [ lion rabbit set-global rabbit <global-var-ref> get-ref ] unit-test
+[ giraffe ] [ rabbit <global-var-ref> giraffe set-ref* get-ref ] unit-test
+
+! Tuple refs
+TUPLE: foo bar ;
+C: <foo> foo
+
+: test-tuple ( -- tuple )
+    rabbit <foo> ;
+
+: test-slot-ref ( -- slot-ref )
+    test-tuple 2 <slot-ref> ; ! hack!
+
+[ rabbit ] [ test-slot-ref get-ref ] unit-test
+[ lion ] [ test-slot-ref lion set-ref* get-ref ] unit-test
+
+! Boxes as refs
+[ rabbit ] [ <box> rabbit set-ref* get-ref ] unit-test
+[ <box> rabbit set-ref* lion set-ref* ] must-fail
+[ <box> get-ref ] must-fail
--- a/basis/refs/refs.factor
+++ b/basis/refs/refs.factor
@ -1,22 +1,77 @@
-! Copyright (C) 2007, 2008 Slava Pestov
+! Copyright (C) 2007, 2008 Slava Pestov, 2009 Alex Chapman
 ! See http://factorcode.org/license.txt for BSD license.
-USING: classes.tuple kernel assocs accessors ;
+USING: kernel assocs accessors boxes math namespaces ;
 IN: refs

-TUPLE: ref assoc key ;
+MIXIN: ref

-: >ref< ( ref -- key value ) [ key>> ] [ assoc>> ] bi ; inline
-
-: delete-ref ( ref -- ) >ref< delete-at ;
 GENERIC: get-ref ( ref -- obj )
 GENERIC: set-ref ( obj ref -- )
+GENERIC: delete-ref ( ref -- )

-TUPLE: key-ref < ref ;
+! works like >>slot words
+: set-ref* ( ref obj -- ref ) over set-ref ;
+
+! very similar to change, on, off, +@, inc, and dec from namespaces
+: change-ref ( ref quot -- )
+    [ [ get-ref ] keep ] dip dip set-ref ; inline
+: ref-on ( ref -- ) t swap set-ref ;
+: ref-off ( ref -- ) f swap set-ref ;
+: ref-+@ ( n ref -- ) [ 0 or + ] change-ref ;
+: ref-inc ( ref -- ) 1 swap ref-+@ ;
+: ref-dec ( ref -- ) -1 swap ref-+@ ;
+
+: take ( ref -- obj )
+    dup get-ref swap delete-ref ;
+
+! delete-ref defaults to setting ref to f
+M: ref delete-ref ref-off ;
+
+TUPLE: obj-ref obj ;
+C: <obj-ref> obj-ref
+M: obj-ref get-ref obj>> ;
+M: obj-ref set-ref (>>obj) ;
+INSTANCE: obj-ref ref
+
+TUPLE: var-ref var ;
+C: <var-ref> var-ref
+M: var-ref get-ref var>> get ;
+M: var-ref set-ref var>> set ;
+INSTANCE: var-ref ref
+
+TUPLE: global-var-ref var ;
+C: <global-var-ref> global-var-ref
+M: global-var-ref get-ref var>> get-global ;
+M: global-var-ref set-ref var>> set-global ;
+INSTANCE: global-var-ref ref
+
+USE: slots.private
+TUPLE: slot-ref tuple slot ;
+C: <slot-ref> slot-ref
+: >slot-ref< ( slot-ref -- tuple slot ) [ tuple>> ] [ slot>> ] bi ; inline
+M: slot-ref get-ref >slot-ref< slot ;
+M: slot-ref set-ref >slot-ref< set-slot ;
+INSTANCE: slot-ref ref
+
+M: box get-ref box> ;
+M: box set-ref >box ;
+M: box delete-ref box> drop ;
+INSTANCE: box ref
+
+TUPLE: assoc-ref assoc key ;
+
+: >assoc-ref< ( assoc-ref -- key value ) [ key>> ] [ assoc>> ] bi ; inline
+
+M: assoc-ref delete-ref ( assoc-ref -- ) >assoc-ref< delete-at ;
+
+TUPLE: key-ref < assoc-ref ;
 C: <key-ref> key-ref
 M: key-ref get-ref key>> ;
-M: key-ref set-ref >ref< rename-at ;
+M: key-ref set-ref >assoc-ref< rename-at ;
+INSTANCE: key-ref ref

-TUPLE: value-ref < ref ;
+TUPLE: value-ref < assoc-ref ;
 C: <value-ref> value-ref
-M: value-ref get-ref >ref< at ;
-M: value-ref set-ref >ref< set-at ;
+M: value-ref get-ref >assoc-ref< at ;
+M: value-ref set-ref >assoc-ref< set-at ;
+INSTANCE: value-ref ref
--- a/basis/tools/errors/errors-docs.factor
+++ b/basis/tools/errors/errors-docs.factor
@ -1,5 +1,35 @@
 IN: tools.errors
-USING: help.markup help.syntax source-files.errors ;
+USING: help.markup help.syntax source-files.errors words io
+compiler.errors ;
+
+ARTICLE: "compiler-errors" "Compiler warnings and errors"
+"After loading a vocabulary, you might see messages like:"
+{ $code
+    ":errors - print 2 compiler errors"
+    ":warnings - print 50 compiler warnings"
+}
+"These messages arise from the compiler's stack effect checker. Production code should not have any warnings and errors in it. Warning and error conditions are documented in " { $link "inference-errors" } "."
+$nl
+"Words to view warnings and errors:"
+{ $subsection :warnings }
+{ $subsection :errors }
+{ $subsection :linkage }
+"Compiler warnings and errors are reported using the " { $link "tools.errors" } " mechanism and are shown in the " { $link "ui.tools.error-list" } "." ;
+
+HELP: compiler-error
+{ $values { "error" "an error" } { "word" word } }
+{ $description "Saves the error for future persual via " { $link :errors } ", " { $link :warnings } " and " { $link :linkage } "." } ;
+
+HELP: :errors
+{ $description "Prints all serious compiler errors from the most recent compile to " { $link output-stream } "." } ;
+
+HELP: :warnings
+{ $description "Prints all ignorable compiler warnings from the most recent compile to " { $link output-stream } "." } ;
+
+HELP: :linkage
+{ $description "Prints all C library interface linkage errors from the most recent compile to " { $link output-stream } "." } ;
+
+{ :errors :warnings :linkage } related-words

 HELP: errors.
 { $values { "errors" "a sequence of " { $link source-file-error } " instances" } }
--- a/basis/tools/errors/errors.factor
+++ b/basis/tools/errors/errors.factor
@ -1,7 +1,8 @@
 ! Copyright (C) 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: assocs debugger io kernel sequences source-files.errors
-summary accessors continuations make math.parser io.styles namespaces ;
+summary accessors continuations make math.parser io.styles namespaces
+compiler.errors ;
 IN: tools.errors

 #! Tools for source-files.errors. Used by tools.tests and others
@ -30,3 +31,12 @@ M: source-file-error error.
        [ [ nl ] [ error. ] interleave ]
        bi*
    ] assoc-each ;
+
+: compiler-errors. ( type -- )
+    errors-of-type values errors. ;
+
+: :errors ( -- ) +compiler-error+ compiler-errors. ;
+
+: :warnings ( -- ) +compiler-warning+ compiler-errors. ;
+
+: :linkage ( -- ) +linkage-error+ compiler-errors. ;
--- a/basis/ui/backend/x11/x11.factor
+++ b/basis/ui/backend/x11/x11.factor
@ -3,11 +3,11 @@
 USING: accessors alien alien.c-types arrays ui ui.private ui.gadgets
 ui.gadgets.private ui.gestures ui.backend ui.clipboards
 ui.gadgets.worlds ui.render ui.event-loop assocs kernel math
-namespaces opengl sequences strings x11.xlib x11.events x11.xim
-x11.glx x11.clipboard x11.constants x11.windows io.encodings.string
-io.encodings.ascii io.encodings.utf8 combinators command-line
-math.vectors classes.tuple opengl.gl threads math.rectangles
-environment ascii ;
+namespaces opengl sequences strings x11 x11.xlib x11.events x11.xim
+x11.glx x11.clipboard x11.constants x11.windows x11.io
+io.encodings.string io.encodings.ascii io.encodings.utf8 combinators
+command-line math.vectors classes.tuple opengl.gl threads
+math.rectangles environment ascii ;
 IN: ui.backend.x11

 SINGLETON: x11-ui-backend
@ -196,7 +196,7 @@ M: world client-event
    QueuedAfterFlush events-queued 0 > [
        next-event dup
        None XFilterEvent 0 = [ drop wait-event ] unless
-    ] [ ui-wait wait-event ] if ;
+    ] [ wait-for-display wait-event ] if ;

 M: x11-ui-backend do-events
    wait-event dup XAnyEvent-window window dup
--- a/basis/urls/encoding/encoding-docs.factor
+++ b/basis/urls/encoding/encoding-docs.factor
@ -7,7 +7,11 @@ HELP: url-decode

 HELP: url-encode
 { $values { "str" string } { "encoded" string } }
-{ $description "URL-encodes a string." } ;
+{ $description "URL-encodes a string, excluding certain characters, such as \"/\"." } ;
+
+HELP: url-encode-full
+{ $values { "str" string } { "encoded" string } }
+{ $description "URL-encodes a string, including all reserved characters, such as \"/\"." } ;

 HELP: url-quotable?
 { $values { "ch" "a character" } { "?" "a boolean" } }
--- a/basis/urls/encoding/encoding.factor
+++ b/basis/urls/encoding/encoding.factor
@ -14,6 +14,25 @@ IN: urls.encoding
        [ "/_-.:" member? ]
    } 1|| ; foldable

+! see http://tools.ietf.org/html/rfc3986#section-2.2
+: gen-delim? ( ch -- ? )
+    ":/?#[]@" member? ; foldable
+
+: sub-delim? ( ch -- ? )
+    "!$&'()*+,;=" member? ; foldable
+
+: reserved? ( ch -- ? )
+    [ gen-delim? ] [ sub-delim? ] bi or ; foldable
+
+! see http://tools.ietf.org/html/rfc3986#section-2.3
+: unreserved? ( ch -- ? )
+    {
+        [ letter? ]
+        [ LETTER? ]
+        [ digit? ]
+        [ "-._~" member? ]
+    } 1|| ; foldable
+
 <PRIVATE

 : push-utf8 ( ch -- )
@ -27,6 +46,11 @@ PRIVATE>
        [ dup url-quotable? [ , ] [ push-utf8 ] if ] each
    ] "" make ;

+: url-encode-full ( str -- encoded )
+    [
+        [ dup unreserved? [ , ] [ push-utf8 ] if ] each
+    ] "" make ;
+
 <PRIVATE

 : url-decode-hex ( index str -- )
--- a/basis/x11/authors.txt
+++ b/basis/x11/authors.txt
@ -0,0 +1,2 @@
+Eduardo Cavazos
+Slava Pestov
--- a/basis/x11/clipboard/clipboard.factor
+++ b/basis/x11/clipboard/clipboard.factor
@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: alien alien.c-types alien.strings alien.syntax arrays
 kernel math namespaces sequences io.encodings.string
-io.encodings.utf8 io.encodings.ascii x11.xlib x11.constants
+io.encodings.utf8 io.encodings.ascii x11 x11.xlib x11.constants
 specialized-arrays.int accessors ;
 IN: x11.clipboard

--- a/basis/x11/events/events.factor
+++ b/basis/x11/events/events.factor
@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: alien alien.c-types arrays hashtables io kernel math
 math.order namespaces prettyprint sequences strings combinators
-x11.xlib ;
+x11 x11.xlib ;
 IN: x11.events

 GENERIC: expose-event ( event window -- )
--- a/basis/x11/glx/glx.factor
+++ b/basis/x11/glx/glx.factor
@ -2,8 +2,9 @@
 ! See http://factorcode.org/license.txt for BSD license.
 !
 ! based on glx.h from xfree86, and some of glxtokens.h
-USING: alien alien.c-types alien.syntax x11.xlib namespaces make
-kernel sequences parser words specialized-arrays.int accessors ;
+USING: alien alien.c-types alien.syntax x11 x11.xlib x11.syntax
+namespaces make kernel sequences parser words specialized-arrays.int
+accessors ;
 IN: x11.glx

 LIBRARY: glx
@ -36,52 +37,52 @@ TYPEDEF: XID GLXFBConfigID
 TYPEDEF: void* GLXContext  ! typedef struct __GLXcontextRec *GLXContext;
 TYPEDEF: void* GLXFBConfig ! typedef struct __GLXFBConfigRec *GLXFBConfig;

-FUNCTION: XVisualInfo* glXChooseVisual ( Display* dpy, int screen, int* attribList ) ;
-FUNCTION: void glXCopyContext ( Display* dpy, GLXContext src, GLXContext dst, ulong mask ) ;
-FUNCTION: GLXContext glXCreateContext ( Display* dpy, XVisualInfo* vis, GLXContext shareList, bool direct ) ;
-FUNCTION: GLXPixmap glXCreateGLXPixmap ( Display* dpy, XVisualInfo* vis, Pixmap pixmap ) ;
-FUNCTION: void glXDestroyContext ( Display* dpy, GLXContext ctx ) ;
-FUNCTION: void glXDestroyGLXPixmap ( Display* dpy, GLXPixmap pix ) ;
-FUNCTION: int glXGetConfig ( Display* dpy, XVisualInfo* vis, int attrib, int* value ) ;
-FUNCTION: GLXContext glXGetCurrentContext ( ) ;
-FUNCTION: GLXDrawable glXGetCurrentDrawable ( ) ;
-FUNCTION: bool glXIsDirect ( Display* dpy, GLXContext ctx ) ;
-FUNCTION: bool glXMakeCurrent ( Display* dpy, GLXDrawable drawable, GLXContext ctx ) ;
-FUNCTION: bool glXQueryExtension ( Display* dpy, int* errorBase, int* eventBase ) ;
-FUNCTION: bool glXQueryVersion ( Display* dpy, int* major, int* minor ) ;
-FUNCTION: void glXSwapBuffers ( Display* dpy, GLXDrawable drawable ) ;
-FUNCTION: void glXUseXFont ( Font font, int first, int count, int listBase ) ;
-FUNCTION: void glXWaitGL ( ) ;
-FUNCTION: void glXWaitX ( ) ;
-FUNCTION: char* glXGetClientString ( Display* dpy, int name ) ;
-FUNCTION: char* glXQueryServerString ( Display* dpy, int screen, int name ) ;
-FUNCTION: char* glXQueryExtensionsString ( Display* dpy, int screen ) ;
+X-FUNCTION: XVisualInfo* glXChooseVisual ( Display* dpy, int screen, int* attribList ) ;
+X-FUNCTION: void glXCopyContext ( Display* dpy, GLXContext src, GLXContext dst, ulong mask ) ;
+X-FUNCTION: GLXContext glXCreateContext ( Display* dpy, XVisualInfo* vis, GLXContext shareList, bool direct ) ;
+X-FUNCTION: GLXPixmap glXCreateGLXPixmap ( Display* dpy, XVisualInfo* vis, Pixmap pixmap ) ;
+X-FUNCTION: void glXDestroyContext ( Display* dpy, GLXContext ctx ) ;
+X-FUNCTION: void glXDestroyGLXPixmap ( Display* dpy, GLXPixmap pix ) ;
+X-FUNCTION: int glXGetConfig ( Display* dpy, XVisualInfo* vis, int attrib, int* value ) ;
+X-FUNCTION: GLXContext glXGetCurrentContext ( ) ;
+X-FUNCTION: GLXDrawable glXGetCurrentDrawable ( ) ;
+X-FUNCTION: bool glXIsDirect ( Display* dpy, GLXContext ctx ) ;
+X-FUNCTION: bool glXMakeCurrent ( Display* dpy, GLXDrawable drawable, GLXContext ctx ) ;
+X-FUNCTION: bool glXQueryExtension ( Display* dpy, int* errorBase, int* eventBase ) ;
+X-FUNCTION: bool glXQueryVersion ( Display* dpy, int* major, int* minor ) ;
+X-FUNCTION: void glXSwapBuffers ( Display* dpy, GLXDrawable drawable ) ;
+X-FUNCTION: void glXUseXFont ( Font font, int first, int count, int listBase ) ;
+X-FUNCTION: void glXWaitGL ( ) ;
+X-FUNCTION: void glXWaitX ( ) ;
+X-FUNCTION: char* glXGetClientString ( Display* dpy, int name ) ;
+X-FUNCTION: char* glXQueryServerString ( Display* dpy, int screen, int name ) ;
+X-FUNCTION: char* glXQueryExtensionsString ( Display* dpy, int screen ) ;

 ! New for GLX 1.3
-FUNCTION: GLXFBConfig* glXGetFBConfigs ( Display* dpy, int screen, int* nelements ) ;
-FUNCTION: GLXFBConfig* glXChooseFBConfig ( Display* dpy, int screen, int* attrib_list, int* nelements ) ;
-FUNCTION: int glXGetFBConfigAttrib ( Display* dpy, GLXFBConfig config, int attribute, int* value ) ;
-FUNCTION: XVisualInfo* glXGetVisualFromFBConfig ( Display* dpy, GLXFBConfig config ) ;
-FUNCTION: GLXWindow glXCreateWindow ( Display* dpy, GLXFBConfig config, Window win, int* attrib_list ) ;
-FUNCTION: void glXDestroyWindow ( Display* dpy, GLXWindow win ) ;
-FUNCTION: GLXPixmap glXCreatePixmap ( Display* dpy, GLXFBConfig config, Pixmap pixmap, int* attrib_list ) ;
-FUNCTION: void glXDestroyPixmap ( Display* dpy, GLXPixmap pixmap ) ;
-FUNCTION: GLXPbuffer glXCreatePbuffer ( Display* dpy, GLXFBConfig config, int* attrib_list ) ;
-FUNCTION: void glXDestroyPbuffer ( Display* dpy, GLXPbuffer pbuf ) ;
-FUNCTION: void glXQueryDrawable ( Display* dpy, GLXDrawable draw, int attribute, uint* value ) ;
-FUNCTION: GLXContext glXCreateNewContext ( Display* dpy, GLXFBConfig config, int render_type, GLXContext share_list, bool direct ) ;
-FUNCTION: bool glXMakeContextCurrent ( Display* display, GLXDrawable draw, GLXDrawable read, GLXContext ctx ) ;
-FUNCTION: GLXDrawable glXGetCurrentReadDrawable ( ) ;
-FUNCTION: Display*  glXGetCurrentDisplay ( ) ;
-FUNCTION: int glXQueryContext ( Display* dpy, GLXContext ctx, int attribute, int* value ) ;
-FUNCTION: void glXSelectEvent ( Display* dpy, GLXDrawable draw, ulong event_mask ) ;
-FUNCTION: void glXGetSelectedEvent ( Display* dpy, GLXDrawable draw, ulong* event_mask ) ;
+X-FUNCTION: GLXFBConfig* glXGetFBConfigs ( Display* dpy, int screen, int* nelements ) ;
+X-FUNCTION: GLXFBConfig* glXChooseFBConfig ( Display* dpy, int screen, int* attrib_list, int* nelements ) ;
+X-FUNCTION: int glXGetFBConfigAttrib ( Display* dpy, GLXFBConfig config, int attribute, int* value ) ;
+X-FUNCTION: XVisualInfo* glXGetVisualFromFBConfig ( Display* dpy, GLXFBConfig config ) ;
+X-FUNCTION: GLXWindow glXCreateWindow ( Display* dpy, GLXFBConfig config, Window win, int* attrib_list ) ;
+X-FUNCTION: void glXDestroyWindow ( Display* dpy, GLXWindow win ) ;
+X-FUNCTION: GLXPixmap glXCreatePixmap ( Display* dpy, GLXFBConfig config, Pixmap pixmap, int* attrib_list ) ;
+X-FUNCTION: void glXDestroyPixmap ( Display* dpy, GLXPixmap pixmap ) ;
+X-FUNCTION: GLXPbuffer glXCreatePbuffer ( Display* dpy, GLXFBConfig config, int* attrib_list ) ;
+X-FUNCTION: void glXDestroyPbuffer ( Display* dpy, GLXPbuffer pbuf ) ;
+X-FUNCTION: void glXQueryDrawable ( Display* dpy, GLXDrawable draw, int attribute, uint* value ) ;
+X-FUNCTION: GLXContext glXCreateNewContext ( Display* dpy, GLXFBConfig config, int render_type, GLXContext share_list, bool direct ) ;
+X-FUNCTION: bool glXMakeContextCurrent ( Display* display, GLXDrawable draw, GLXDrawable read, GLXContext ctx ) ;
+X-FUNCTION: GLXDrawable glXGetCurrentReadDrawable ( ) ;
+X-FUNCTION: Display*  glXGetCurrentDisplay ( ) ;
+X-FUNCTION: int glXQueryContext ( Display* dpy, GLXContext ctx, int attribute, int* value ) ;
+X-FUNCTION: void glXSelectEvent ( Display* dpy, GLXDrawable draw, ulong event_mask ) ;
+X-FUNCTION: void glXGetSelectedEvent ( Display* dpy, GLXDrawable draw, ulong* event_mask ) ;

 ! GLX 1.4 and later
-FUNCTION: void* glXGetProcAddress ( char* procname ) ;
+X-FUNCTION: void* glXGetProcAddress ( char* procname ) ;

 ! GLX_ARB_get_proc_address extension
-FUNCTION: void* glXGetProcAddressARB ( char* procname ) ;
+X-FUNCTION: void* glXGetProcAddressARB ( char* procname ) ;

 ! GLX Events
 ! (also skipped for now. only has GLXPbufferClobberEvent, the rest is handled by xlib methinks)
--- a/basis/x11/io/authors.txt
+++ b/basis/x11/io/authors.txt
@ -0,0 +1 @@
+Slava Pestov
--- a/basis/x11/io/io.factor
+++ b/basis/x11/io/io.factor
@ -0,0 +1,16 @@
+! Copyright (C) 2009 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: io.backend calendar threads kernel ;
+IN: x11.io
+
+HOOK: init-x-io io-backend ( -- )
+
+M: object init-x-io ;
+
+HOOK: wait-for-display io-backend ( -- )
+
+M: object wait-for-display 10 milliseconds sleep ;
+
+HOOK: awaken-event-loop io-backend ( -- )
+
+M: object awaken-event-loop ;
--- a/basis/x11/io/unix/authors.txt
+++ b/basis/x11/io/unix/authors.txt
@ -0,0 +1 @@
+Slava Pestov
--- a/basis/x11/io/unix/unix.factor
+++ b/basis/x11/io/unix/unix.factor
@ -0,0 +1,15 @@
+! Copyright (C) 2009 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: io.backend.unix io.backend.unix.multiplexers
+namespaces system x11 x11.xlib x11.io
+accessors threads sequences kernel ;
+IN: x11.io.unix
+
+SYMBOL: dpy-fd
+
+M: unix init-x-io dpy get XConnectionNumber <fd> dpy-fd set-global ;
+
+M: unix wait-for-display dpy-fd get +input+ wait-for-fd ;
+
+M: unix awaken-event-loop
+    dpy-fd get [ fd>> mx get remove-input-callbacks [ resume ] each ] when* ;
--- a/basis/x11/syntax/authors.txt
+++ b/basis/x11/syntax/authors.txt
@ -0,0 +1 @@
+Slava Pestov
--- a/basis/x11/syntax/syntax.factor
+++ b/basis/x11/syntax/syntax.factor
@ -0,0 +1,9 @@
+! Copyright (C) 2009 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: alien.syntax alien.parser words x11.io sequences kernel ;
+IN: x11.syntax
+
+SYNTAX: X-FUNCTION:
+    (FUNCTION:)
+    [ \ awaken-event-loop suffix ] dip
+    define-declared ;
--- a/basis/x11/windows/windows.factor
+++ b/basis/x11/windows/windows.factor
@ -1,7 +1,7 @@
 ! Copyright (C) 2005, 2006 Eduardo Cavazos and Slava Pestov
 ! See http://factorcode.org/license.txt for BSD license.
 USING: alien alien.c-types hashtables kernel math math.vectors
-math.bitwise namespaces sequences x11.xlib x11.constants x11.glx
+math.bitwise namespaces sequences x11 x11.xlib x11.constants x11.glx
 arrays fry ;
 IN: x11.windows

--- a/basis/x11/x11.factor
+++ b/basis/x11/x11.factor
@ -0,0 +1,36 @@
+! Copyright (C) 2005, 2009 Eduardo Cavazos, Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: alien.strings continuations io
+io.encodings.ascii kernel namespaces x11.xlib x11.io
+vocabs vocabs.loader ;
+IN: x11
+
+SYMBOL: dpy
+SYMBOL: scr
+SYMBOL: root
+
+: init-locale ( -- )
+   LC_ALL "" setlocale [ "setlocale() failed" print flush ] unless
+   XSupportsLocale [ "XSupportsLocale() failed" print flush ] unless ;
+
+: flush-dpy ( -- ) dpy get XFlush drop ;
+
+: x-atom ( string -- atom ) [ dpy get ] dip 0 XInternAtom ;
+
+: check-display ( alien -- alien' )
+    [ "Cannot connect to X server - check $DISPLAY" throw ] unless* ;
+
+: init-x ( display-string -- )
+    init-locale
+    dup [ ascii string>alien ] when
+    XOpenDisplay check-display dpy set-global
+    dpy get XDefaultScreen scr set-global
+    dpy get scr get XRootWindow root set-global
+    init-x-io ;
+
+: close-x ( -- ) dpy get XCloseDisplay drop ;
+
+: with-x ( display-string quot -- )
+    [ init-x ] dip [ close-x ] [ ] cleanup ; inline
+
+"io.backend.unix" vocab [ "x11.io.unix" require ] when
--- a/basis/x11/xim/xim.factor
+++ b/basis/x11/xim/xim.factor
@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: alien alien.c-types alien.strings arrays byte-arrays
 hashtables io io.encodings.string kernel math namespaces
-sequences strings continuations x11.xlib specialized-arrays.uint
+sequences strings continuations x11 x11.xlib specialized-arrays.uint
 accessors io.encodings.utf16n ;
 IN: x11.xim

--- a/basis/x11/xlib/xlib.factor
+++ b/basis/x11/xlib/xlib.factor
@ -13,7 +13,7 @@

 USING: kernel arrays alien alien.c-types alien.strings
 alien.syntax math math.bitwise words sequences namespaces
-continuations io io.encodings.ascii ;
+continuations io io.encodings.ascii x11.syntax ;
 IN: x11.xlib

 LIBRARY: xlib
@ -71,26 +71,26 @@ C-STRUCT: Display
 { "void*" "free_funcs" }
 { "int" "fd" } ;

-FUNCTION: Display* XOpenDisplay ( void* display_name ) ;
+X-FUNCTION: Display* XOpenDisplay ( void* display_name ) ;

 ! 2.2 Obtaining Information about the Display, Image Formats, or Screens

-FUNCTION: ulong XBlackPixel ( Display* display, int screen_number ) ;
-FUNCTION: ulong XWhitePixel ( Display* display, int screen_number ) ;
-FUNCTION: Colormap XDefaultColormap ( Display* display, int screen_number ) ;
-FUNCTION: int XDefaultDepth ( Display* display, int screen_number ) ;
-FUNCTION: GC XDefaultGC ( Display* display, int screen_number ) ;
-FUNCTION: int XDefaultScreen ( Display* display ) ;
-FUNCTION: Window XRootWindow ( Display* display, int screen_number ) ;
-FUNCTION: Window XDefaultRootWindow ( Display* display ) ;
-FUNCTION: int XProtocolVersion ( Display* display ) ;
-FUNCTION: int XProtocolRevision ( Display* display ) ;
-FUNCTION: int XQLength ( Display* display ) ;
-FUNCTION: int XScreenCount ( Display* display ) ;
-FUNCTION: int XConnectionNumber ( Display* display ) ;
+X-FUNCTION: ulong XBlackPixel ( Display* display, int screen_number ) ;
+X-FUNCTION: ulong XWhitePixel ( Display* display, int screen_number ) ;
+X-FUNCTION: Colormap XDefaultColormap ( Display* display, int screen_number ) ;
+X-FUNCTION: int XDefaultDepth ( Display* display, int screen_number ) ;
+X-FUNCTION: GC XDefaultGC ( Display* display, int screen_number ) ;
+X-FUNCTION: int XDefaultScreen ( Display* display ) ;
+X-FUNCTION: Window XRootWindow ( Display* display, int screen_number ) ;
+X-FUNCTION: Window XDefaultRootWindow ( Display* display ) ;
+X-FUNCTION: int XProtocolVersion ( Display* display ) ;
+X-FUNCTION: int XProtocolRevision ( Display* display ) ;
+X-FUNCTION: int XQLength ( Display* display ) ;
+X-FUNCTION: int XScreenCount ( Display* display ) ;
+X-FUNCTION: int XConnectionNumber ( Display* display ) ;

 ! 2.5 Closing the Display
-FUNCTION: int XCloseDisplay ( Display* display ) ;
+X-FUNCTION: int XCloseDisplay ( Display* display ) ;

 !
 ! 3 - Window Functions
@ -147,17 +147,17 @@ CONSTANT: StaticGravity         10

 ! 3.3 - Creating Windows

-FUNCTION: Window XCreateWindow ( Display* display, Window parent, int x, int y, uint width, uint height, uint border_width, int depth, uint class, Visual* visual, ulong valuemask, XSetWindowAttributes* attributes ) ;
-FUNCTION: Window XCreateSimpleWindow ( Display* display, Window parent, int x, int y, uint width, uint height, uint border_width, ulong border, ulong background ) ;
-FUNCTION: Status XDestroyWindow ( Display* display, Window w ) ;
-FUNCTION: Status XMapWindow ( Display* display, Window window ) ;
-FUNCTION: Status XMapSubwindows ( Display* display, Window window ) ;
-FUNCTION: Status XUnmapWindow ( Display* display, Window w ) ;
-FUNCTION: Status XUnmapSubwindows ( Display* display, Window w ) ;
+X-FUNCTION: Window XCreateWindow ( Display* display, Window parent, int x, int y, uint width, uint height, uint border_width, int depth, uint class, Visual* visual, ulong valuemask, XSetWindowAttributes* attributes ) ;
+X-FUNCTION: Window XCreateSimpleWindow ( Display* display, Window parent, int x, int y, uint width, uint height, uint border_width, ulong border, ulong background ) ;
+X-FUNCTION: Status XDestroyWindow ( Display* display, Window w ) ;
+X-FUNCTION: Status XMapWindow ( Display* display, Window window ) ;
+X-FUNCTION: Status XMapSubwindows ( Display* display, Window window ) ;
+X-FUNCTION: Status XUnmapWindow ( Display* display, Window w ) ;
+X-FUNCTION: Status XUnmapSubwindows ( Display* display, Window w ) ;

 ! 3.5 Mapping Windows

-FUNCTION: int XMapRaised ( Display* display, Window w ) ;
+X-FUNCTION: int XMapRaised ( Display* display, Window w ) ;

 ! 3.7 - Configuring Windows

@ -178,25 +178,25 @@ C-STRUCT: XWindowChanges
        { "Window" "sibling" }
        { "int" "stack_mode" } ;

-FUNCTION: Status XConfigureWindow ( Display* display, Window w, uint value_mask, XWindowChanges* values ) ;
-FUNCTION: Status XMoveWindow ( Display* display, Window w, int x, int y ) ;
-FUNCTION: Status XResizeWindow ( Display* display, Window w, uint width, uint height ) ;
-FUNCTION: Status XSetWindowBorderWidth ( Display* display, ulong w, uint width ) ;
+X-FUNCTION: Status XConfigureWindow ( Display* display, Window w, uint value_mask, XWindowChanges* values ) ;
+X-FUNCTION: Status XMoveWindow ( Display* display, Window w, int x, int y ) ;
+X-FUNCTION: Status XResizeWindow ( Display* display, Window w, uint width, uint height ) ;
+X-FUNCTION: Status XSetWindowBorderWidth ( Display* display, ulong w, uint width ) ;


 ! 3.8 Changing Window Stacking Order

-FUNCTION: Status XRaiseWindow ( Display* display, Window w ) ;
-FUNCTION: Status XLowerWindow ( Display* display, Window w ) ;
+X-FUNCTION: Status XRaiseWindow ( Display* display, Window w ) ;
+X-FUNCTION: Status XLowerWindow ( Display* display, Window w ) ;

 ! 3.9 - Changing Window Attributes

-FUNCTION: Status XChangeWindowAttributes (
+X-FUNCTION: Status XChangeWindowAttributes (
  Display* display, Window w, ulong valuemask, XSetWindowAttributes* attr ) ;
-FUNCTION: Status XSetWindowBackground (
+X-FUNCTION: Status XSetWindowBackground (
  Display* display, Window w, ulong background_pixel ) ;
-FUNCTION: Status XDefineCursor ( Display* display, Window w, Cursor cursor ) ;
-FUNCTION: Status XUndefineCursor ( Display* display, Window w ) ;
+X-FUNCTION: Status XDefineCursor ( Display* display, Window w, Cursor cursor ) ;
+X-FUNCTION: Status XUndefineCursor ( Display* display, Window w ) ;

 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 ! 4 - Window Information Functions
@ -204,7 +204,7 @@ FUNCTION: Status XUndefineCursor ( Display* display, Window w ) ;

 ! 4.1 - Obtaining Window Information

-FUNCTION: Status XQueryTree (
+X-FUNCTION: Status XQueryTree (
  Display* display,
  Window w,
  Window* root_return,
@ -236,13 +236,13 @@ C-STRUCT: XWindowAttributes
        { "Bool" "override_redirect" }
        { "Screen*" "screen" } ;

-FUNCTION: Status XGetWindowAttributes ( Display* display, Window w, XWindowAttributes* attr ) ;
+X-FUNCTION: Status XGetWindowAttributes ( Display* display, Window w, XWindowAttributes* attr ) ;

 CONSTANT: IsUnmapped            0
 CONSTANT: IsUnviewable          1
 CONSTANT: IsViewable            2

-FUNCTION: Status XGetGeometry (
+X-FUNCTION: Status XGetGeometry (
  Display* display,
  Drawable d,
  Window* root_return,
@ -255,27 +255,27 @@ FUNCTION: Status XGetGeometry (

 ! 4.2 - Translating Screen Coordinates

-FUNCTION: Bool XQueryPointer ( Display* display, Window w, Window* root_return, Window* child_return, int* root_x_return, int* root_y_return, int* win_x_return, int* win_y_return, uint* mask_return ) ;
+X-FUNCTION: Bool XQueryPointer ( Display* display, Window w, Window* root_return, Window* child_return, int* root_x_return, int* root_y_return, int* win_x_return, int* win_y_return, uint* mask_return ) ;

 ! 4.3 - Properties and Atoms

-FUNCTION: Atom XInternAtom ( Display* display, char* atom_name, Bool only_if_exists ) ;
+X-FUNCTION: Atom XInternAtom ( Display* display, char* atom_name, Bool only_if_exists ) ;

-FUNCTION: char* XGetAtomName ( Display* display, Atom atom ) ;
+X-FUNCTION: char* XGetAtomName ( Display* display, Atom atom ) ;

 ! 4.4 - Obtaining and Changing Window Properties

-FUNCTION: int XGetWindowProperty ( Display* display, Window w, Atom property, long long_offset, long long_length, Bool delete, Atom req_type, Atom* actual_type_return, int* actual_format_return, ulong* nitems_return, ulong* bytes_after_return, char** prop_return ) ;
+X-FUNCTION: int XGetWindowProperty ( Display* display, Window w, Atom property, long long_offset, long long_length, Bool delete, Atom req_type, Atom* actual_type_return, int* actual_format_return, ulong* nitems_return, ulong* bytes_after_return, char** prop_return ) ;

-FUNCTION: int XChangeProperty ( Display* display, Window w, Atom property, Atom type, int format, int mode, void* data, int nelements ) ;
+X-FUNCTION: int XChangeProperty ( Display* display, Window w, Atom property, Atom type, int format, int mode, void* data, int nelements ) ;

 ! 4.5 Selections

-FUNCTION: int XSetSelectionOwner ( Display* display, Atom selection, Window owner, Time time ) ;
+X-FUNCTION: int XSetSelectionOwner ( Display* display, Atom selection, Window owner, Time time ) ;

-FUNCTION: Window XGetSelectionOwner ( Display* display, Atom selection ) ;
+X-FUNCTION: Window XGetSelectionOwner ( Display* display, Atom selection ) ;

-FUNCTION: int XConvertSelection ( Display* display, Atom selection, Atom target, Atom property, Window requestor, Time time ) ;
+X-FUNCTION: int XConvertSelection ( Display* display, Atom selection, Atom target, Atom property, Window requestor, Time time ) ;


 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@ -284,8 +284,8 @@ FUNCTION: int XConvertSelection ( Display* display, Atom selection, Atom target,

 ! 5.1 - Creating and Freeing Pixmaps

-FUNCTION: Pixmap XCreatePixmap ( Display* display, Drawable d, uint width, uint height, uint depth ) ;
-FUNCTION: int XFreePixmap ( Display* display, Pixmap pixmap ) ;
+X-FUNCTION: Pixmap XCreatePixmap ( Display* display, Drawable d, uint width, uint height, uint depth ) ;
+X-FUNCTION: int XFreePixmap ( Display* display, Pixmap pixmap ) ;


 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@ -300,13 +300,13 @@ C-STRUCT: XColor
        { "char" "flags" }
        { "char" "pad" } ;

-FUNCTION: Status XLookupColor ( Display* display, Colormap colormap, char* color_name, XColor* exact_def_return, XColor* screen_def_return ) ;
-FUNCTION: Status XAllocColor ( Display* display, Colormap colormap, XColor* screen_in_out ) ;
-FUNCTION: Status XQueryColor ( Display* display, Colormap colormap, XColor* def_in_out ) ;
+X-FUNCTION: Status XLookupColor ( Display* display, Colormap colormap, char* color_name, XColor* exact_def_return, XColor* screen_def_return ) ;
+X-FUNCTION: Status XAllocColor ( Display* display, Colormap colormap, XColor* screen_in_out ) ;
+X-FUNCTION: Status XQueryColor ( Display* display, Colormap colormap, XColor* def_in_out ) ;

 ! 6.4 Creating, Copying, and Destroying Colormaps

-FUNCTION: Colormap XCreateColormap ( Display* display, Window w, Visual* visual, int alloc ) ;
+X-FUNCTION: Colormap XCreateColormap ( Display* display, Window w, Visual* visual, int alloc ) ;

 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 ! 7 - Graphics Context Functions
@ -378,27 +378,27 @@ C-STRUCT: XGCValues
        { "int" "dash_offset" }
        { "char" "dashes" } ;

-FUNCTION: GC XCreateGC ( Display* display, Window d, ulong valuemask, XGCValues* values ) ;
-FUNCTION: int XChangeGC ( Display* display, GC gc, ulong valuemask, XGCValues* values ) ;
-FUNCTION: Status XGetGCValues ( Display* display, GC gc, ulong valuemask, XGCValues* values_return ) ;
-FUNCTION: Status XSetForeground ( Display* display, GC gc, ulong foreground ) ;
-FUNCTION: Status XSetBackground ( Display* display, GC gc, ulong background ) ;
-FUNCTION: Status XSetFunction ( Display* display, GC gc, int function ) ;
-FUNCTION: Status XSetSubwindowMode ( Display* display, GC gc, int subwindow_mode ) ;
+X-FUNCTION: GC XCreateGC ( Display* display, Window d, ulong valuemask, XGCValues* values ) ;
+X-FUNCTION: int XChangeGC ( Display* display, GC gc, ulong valuemask, XGCValues* values ) ;
+X-FUNCTION: Status XGetGCValues ( Display* display, GC gc, ulong valuemask, XGCValues* values_return ) ;
+X-FUNCTION: Status XSetForeground ( Display* display, GC gc, ulong foreground ) ;
+X-FUNCTION: Status XSetBackground ( Display* display, GC gc, ulong background ) ;
+X-FUNCTION: Status XSetFunction ( Display* display, GC gc, int function ) ;
+X-FUNCTION: Status XSetSubwindowMode ( Display* display, GC gc, int subwindow_mode ) ;

-FUNCTION: GContext XGContextFromGC ( GC gc ) ;
+X-FUNCTION: GContext XGContextFromGC ( GC gc ) ;

-FUNCTION: Status XSetFont ( Display* display, GC gc, Font font ) ;
+X-FUNCTION: Status XSetFont ( Display* display, GC gc, Font font ) ;

 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 ! 8 - Graphics Functions
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

-FUNCTION: Status XClearWindow ( Display* display, Window w ) ;
-FUNCTION: Status XDrawPoint ( Display* display, Drawable d, GC gc, int x, int y ) ;
-FUNCTION: Status XDrawLine ( Display* display, Drawable d, GC gc, int x1, int y1, int x2, int y2 ) ;
-FUNCTION: Status XDrawArc ( Display* display, Drawable d, GC gc, int x, int y, uint width, uint height, int angle1, int angle2 ) ;
-FUNCTION: Status XFillArc ( Display* display, Drawable d, GC gc, int x, int y, uint width, uint height, int angle1, int angle2 ) ;
+X-FUNCTION: Status XClearWindow ( Display* display, Window w ) ;
+X-FUNCTION: Status XDrawPoint ( Display* display, Drawable d, GC gc, int x, int y ) ;
+X-FUNCTION: Status XDrawLine ( Display* display, Drawable d, GC gc, int x1, int y1, int x2, int y2 ) ;
+X-FUNCTION: Status XDrawArc ( Display* display, Drawable d, GC gc, int x, int y, uint width, uint height, int angle1, int angle2 ) ;
+X-FUNCTION: Status XFillArc ( Display* display, Drawable d, GC gc, int x, int y, uint width, uint height, int angle1, int angle2 ) ;

 ! 8.5 - Font Metrics

@ -410,9 +410,9 @@ C-STRUCT: XCharStruct
        { "short" "descent" }
        { "ushort" "attributes" } ;

-FUNCTION: Font XLoadFont ( Display* display, char* name ) ;
-FUNCTION: XFontStruct* XQueryFont ( Display* display, XID font_ID ) ;
-FUNCTION: XFontStruct* XLoadQueryFont ( Display* display, char* name ) ;
+X-FUNCTION: Font XLoadFont ( Display* display, char* name ) ;
+X-FUNCTION: XFontStruct* XQueryFont ( Display* display, XID font_ID ) ;
+X-FUNCTION: XFontStruct* XLoadQueryFont ( Display* display, char* name ) ;

 C-STRUCT: XFontStruct
        { "XExtData*" "ext_data" }
@ -432,11 +432,11 @@ C-STRUCT: XFontStruct
        { "int" "ascent" }
        { "int" "descent" } ;

-FUNCTION: int XTextWidth ( XFontStruct* font_struct, char* string, int count ) ;
+X-FUNCTION: int XTextWidth ( XFontStruct* font_struct, char* string, int count ) ;

 ! 8.6 - Drawing Text

-FUNCTION: Status XDrawString (
+X-FUNCTION: Status XDrawString (
        Display* display,
        Drawable d,
        GC gc,
@ -479,8 +479,8 @@ C-STRUCT: XImage
    { "XPointer"     "obdata" }
    { "XImage-funcs" "f" } ;

-FUNCTION: XImage* XGetImage ( Display* display, Drawable d, int x, int y, uint width, uint height, ulong plane_mask, int format ) ;
-FUNCTION: int XDestroyImage ( XImage *ximage ) ;
+X-FUNCTION: XImage* XGetImage ( Display* display, Drawable d, int x, int y, uint width, uint height, ulong plane_mask, int format ) ;
+X-FUNCTION: int XDestroyImage ( XImage *ximage ) ;

 : XImage-size ( ximage -- size )
    [ XImage-height ] [ XImage-bytes_per_line ] bi * ;
@ -492,12 +492,12 @@ FUNCTION: int XDestroyImage ( XImage *ximage ) ;
 ! 9 - Window and Session Manager Functions
 !

-FUNCTION: Status XReparentWindow ( Display* display, Window w, Window parent, int x, int y ) ;
-FUNCTION: Status XAddToSaveSet ( Display* display, Window w ) ;
-FUNCTION: Status XRemoveFromSaveSet ( Display* display, Window w ) ;
-FUNCTION: Status XGrabServer ( Display* display ) ;
-FUNCTION: Status XUngrabServer ( Display* display ) ;
-FUNCTION: Status XKillClient ( Display* display, XID resource ) ;
+X-FUNCTION: Status XReparentWindow ( Display* display, Window w, Window parent, int x, int y ) ;
+X-FUNCTION: Status XAddToSaveSet ( Display* display, Window w ) ;
+X-FUNCTION: Status XRemoveFromSaveSet ( Display* display, Window w ) ;
+X-FUNCTION: Status XGrabServer ( Display* display ) ;
+X-FUNCTION: Status XUngrabServer ( Display* display ) ;
+X-FUNCTION: Status XKillClient ( Display* display, XID resource ) ;

 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 ! 10 - Events
@ -1066,11 +1066,11 @@ C-UNION: XEvent
 ! 11 - Event Handling Functions
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

-FUNCTION: Status XSelectInput ( Display* display, Window w, long event_mask ) ;
-FUNCTION: Status XFlush ( Display* display ) ;
-FUNCTION: Status XSync ( Display* display, int discard ) ;
-FUNCTION: Status XNextEvent ( Display* display, XEvent* event ) ;
-FUNCTION: Status XMaskEvent ( Display* display, long event_mask, XEvent* event_return ) ;
+X-FUNCTION: Status XSelectInput ( Display* display, Window w, long event_mask ) ;
+X-FUNCTION: Status XFlush ( Display* display ) ;
+X-FUNCTION: Status XSync ( Display* display, int discard ) ;
+X-FUNCTION: Status XNextEvent ( Display* display, XEvent* event ) ;
+X-FUNCTION: Status XMaskEvent ( Display* display, long event_mask, XEvent* event_return ) ;

 ! 11.3 - Event Queue Management

@ -1078,16 +1078,16 @@ CONSTANT: QueuedAlready 0
 CONSTANT: QueuedAfterReading 1
 CONSTANT: QueuedAfterFlush 2

-FUNCTION: int XEventsQueued ( Display* display, int mode ) ;
-FUNCTION: int XPending ( Display* display ) ;
+X-FUNCTION: int XEventsQueued ( Display* display, int mode ) ;
+X-FUNCTION: int XPending ( Display* display ) ;

 ! 11.6 - Sending Events to Other Applications

-FUNCTION: Status XSendEvent ( Display* display, Window w, Bool propagate, long event_mask, XEvent* event_send ) ;
+X-FUNCTION: Status XSendEvent ( Display* display, Window w, Bool propagate, long event_mask, XEvent* event_send ) ;

 ! 11.8 - Handling Protocol Errors

-FUNCTION: int XSetErrorHandler ( void* handler ) ;
+X-FUNCTION: int XSetErrorHandler ( void* handler ) ;

 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 ! 12 - Input Device Functions
@ -1095,7 +1095,7 @@ FUNCTION: int XSetErrorHandler ( void* handler ) ;

 CONSTANT: None 0

-FUNCTION: int XGrabPointer (
+X-FUNCTION: int XGrabPointer (
  Display* display,
  Window grab_window,
  Bool owner_events,
@ -1106,16 +1106,16 @@ FUNCTION: int XGrabPointer (
  Cursor cursor,
  Time time ) ;

-FUNCTION: Status XUngrabPointer ( Display* display, Time time ) ;
-FUNCTION: Status XChangeActivePointerGrab ( Display* display, uint event_mask, Cursor cursor, Time time ) ;
-FUNCTION: Status XGrabKey ( Display* display, int keycode, uint modifiers, Window grab_window, Bool owner_events, int pointer_mode, int keyboard_mode ) ;
-FUNCTION: Status XSetInputFocus ( Display* display, Window focus, int revert_to, Time time ) ;
+X-FUNCTION: Status XUngrabPointer ( Display* display, Time time ) ;
+X-FUNCTION: Status XChangeActivePointerGrab ( Display* display, uint event_mask, Cursor cursor, Time time ) ;
+X-FUNCTION: Status XGrabKey ( Display* display, int keycode, uint modifiers, Window grab_window, Bool owner_events, int pointer_mode, int keyboard_mode ) ;
+X-FUNCTION: Status XSetInputFocus ( Display* display, Window focus, int revert_to, Time time ) ;

-FUNCTION: Status XGetInputFocus ( Display* display,
+X-FUNCTION: Status XGetInputFocus ( Display* display,
                                  Window*  focus_return,
                                  int*     revert_to_return ) ;

-FUNCTION: Status XWarpPointer ( Display* display, Window src_w, Window dest_w, int src_x, int src_y, uint src_width, uint src_height, int dest_x, int dest_y ) ;
+X-FUNCTION: Status XWarpPointer ( Display* display, Window src_w, Window dest_w, int src_x, int src_y, uint src_width, uint src_height, int dest_x, int dest_y ) ;

 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 ! 14 - Inter-Client Communication Functions
@ -1123,15 +1123,15 @@ FUNCTION: Status XWarpPointer ( Display* display, Window src_w, Window dest_w, i

 ! 14.1 Client to Window Manager Communication

-FUNCTION: Status XFetchName ( Display* display, Window w, char** window_name_return ) ;
-FUNCTION: Status XGetTransientForHint ( Display* display, Window w, Window* prop_window_return ) ;
+X-FUNCTION: Status XFetchName ( Display* display, Window w, char** window_name_return ) ;
+X-FUNCTION: Status XGetTransientForHint ( Display* display, Window w, Window* prop_window_return ) ;

 ! 14.1.1.  Manipulating Top-Level Windows

-FUNCTION: Status XIconifyWindow (
+X-FUNCTION: Status XIconifyWindow (
        Display* display, Window w, int screen_number ) ;

-FUNCTION: Status XWithdrawWindow (
+X-FUNCTION: Status XWithdrawWindow (
        Display* display, Window w, int screen_number ) ;

 ! 14.1.6 - Setting and Reading the WM_HINTS Property
@ -1173,10 +1173,10 @@ C-STRUCT: XSizeHints

 ! 14.1.10.  Setting and Reading the WM_PROTOCOLS Property

-FUNCTION: Status XSetWMProtocols (
+X-FUNCTION: Status XSetWMProtocols (
        Display* display, Window w, Atom* protocols, int count ) ;

-FUNCTION: Status XGetWMProtocols (
+X-FUNCTION: Status XGetWMProtocols (
        Display* display,
        Window w,
        Atom** protocols_return,
@ -1188,9 +1188,9 @@ FUNCTION: Status XGetWMProtocols (

 ! 16.1 Keyboard Utility Functions

-FUNCTION: KeySym XLookupKeysym ( XKeyEvent* key_event, int index ) ;
+X-FUNCTION: KeySym XLookupKeysym ( XKeyEvent* key_event, int index ) ;

-FUNCTION: int XLookupString (
+X-FUNCTION: int XLookupString (
        XKeyEvent* event_struct,
        void* buffer_return,
        int bytes_buffer,
@ -1227,7 +1227,7 @@ C-STRUCT: XVisualInfo
 ! Appendix D - Compatibility Functions
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

-FUNCTION: Status XSetStandardProperties (
+X-FUNCTION: Status XSetStandardProperties (
        Display* display,
        Window w,
        char* window_name,
@ -1314,10 +1314,10 @@ CONSTANT: XA_LAST_PREDEFINED 68
 ! The rest of the stuff is not from the book.
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

-FUNCTION: void XFree ( void* data ) ;
-FUNCTION: int XStoreName ( Display* display, Window w, char* window_name ) ;
-FUNCTION: void XSetWMNormalHints ( Display* display, Window w, XSizeHints* hints ) ;
-FUNCTION: int XBell ( Display* display, int percent ) ;
+X-FUNCTION: void XFree ( void* data ) ;
+X-FUNCTION: int XStoreName ( Display* display, Window w, char* window_name ) ;
+X-FUNCTION: void XSetWMNormalHints ( Display* display, Window w, XSizeHints* hints ) ;
+X-FUNCTION: int XBell ( Display* display, int percent ) ;

 ! !!! INPUT METHODS

@ -1381,23 +1381,23 @@ CONSTANT: XLookupChars     2
 CONSTANT: XLookupKeySym    3
 CONSTANT: XLookupBoth      4

-FUNCTION: Bool XFilterEvent ( XEvent* event, Window w ) ;
+X-FUNCTION: Bool XFilterEvent ( XEvent* event, Window w ) ;

-FUNCTION: XIM XOpenIM ( Display* dpy, void* rdb, char* res_name, char* res_class ) ;
+X-FUNCTION: XIM XOpenIM ( Display* dpy, void* rdb, char* res_name, char* res_class ) ;

-FUNCTION: Status XCloseIM ( XIM im ) ;
+X-FUNCTION: Status XCloseIM ( XIM im ) ;

-FUNCTION: XIC XCreateIC ( XIM im, char* key1, Window value1, char* key2, Window value2, char* key3, int value3, char* key4, char* value4, char* key5, char* value5, int key6 ) ;
+X-FUNCTION: XIC XCreateIC ( XIM im, char* key1, Window value1, char* key2, Window value2, char* key3, int value3, char* key4, char* value4, char* key5, char* value5, int key6 ) ;

-FUNCTION: void XDestroyIC ( XIC ic ) ;
+X-FUNCTION: void XDestroyIC ( XIC ic ) ;

-FUNCTION: void XSetICFocus ( XIC ic ) ;
+X-FUNCTION: void XSetICFocus ( XIC ic ) ;
        
-FUNCTION: void XUnsetICFocus ( XIC ic ) ;
+X-FUNCTION: void XUnsetICFocus ( XIC ic ) ;

-FUNCTION: int XwcLookupString ( XIC ic, XKeyPressedEvent* event, ulong* buffer_return, int bytes_buffer, KeySym* keysym_return, Status* status_return ) ;
+X-FUNCTION: int XwcLookupString ( XIC ic, XKeyPressedEvent* event, ulong* buffer_return, int bytes_buffer, KeySym* keysym_return, Status* status_return ) ;

-FUNCTION: int Xutf8LookupString ( XIC ic, XKeyPressedEvent* event, char* buffer_return, int bytes_buffer, KeySym* keysym_return, Status* status_return ) ;
+X-FUNCTION: int Xutf8LookupString ( XIC ic, XKeyPressedEvent* event, char* buffer_return, int bytes_buffer, KeySym* keysym_return, Status* status_return ) ;

 ! !!! category of setlocale
 CONSTANT: LC_ALL      0
@ -1407,37 +1407,8 @@ CONSTANT: LC_MONETARY 3
 CONSTANT: LC_NUMERIC  4
 CONSTANT: LC_TIME     5

-FUNCTION: char* setlocale ( int category, char* name ) ;
+X-FUNCTION: char* setlocale ( int category, char* name ) ;

-FUNCTION: Bool XSupportsLocale ( ) ;
+X-FUNCTION: Bool XSupportsLocale ( ) ;

-FUNCTION: char* XSetLocaleModifiers ( char* modifier_list ) ;
-
-SYMBOL: dpy
-SYMBOL: scr
-SYMBOL: root
-
-: init-locale ( -- )
-   LC_ALL "" setlocale [ "setlocale() failed" print flush ] unless
-   XSupportsLocale [ "XSupportsLocale() failed" print flush ] unless ;
-
-: flush-dpy ( -- ) dpy get XFlush drop ;
-
-: x-atom ( string -- atom ) dpy get swap 0 XInternAtom ;
-
-: check-display ( alien -- alien' )
-    [
-        "Cannot connect to X server - check $DISPLAY" throw
-    ] unless* ;
-
-: initialize-x ( display-string -- )
-    init-locale
-    dup [ ascii string>alien ] when
-    XOpenDisplay check-display dpy set-global
-    dpy get XDefaultScreen scr set-global
-    dpy get scr get XRootWindow root set-global ;
-
-: close-x ( -- ) dpy get XCloseDisplay drop ;
-
-: with-x ( display-string quot -- )
-    [ initialize-x ] dip [ close-x ] [ ] cleanup ; inline
+X-FUNCTION: char* XSetLocaleModifiers ( char* modifier_list ) ;
--- a/core/parser/parser.factor
+++ b/core/parser/parser.factor
@ -180,6 +180,7 @@ SYMBOL: interactive-vocabs
    "math.order"
    "memory"
    "namespaces"
+    "parser"
    "prettyprint"
    "see"
    "sequences"
@ -191,6 +192,7 @@ SYMBOL: interactive-vocabs
    "tools.annotations"
    "tools.crossref"
    "tools.disassembler"
+    "tools.errors"
    "tools.memory"
    "tools.profiler"
    "tools.test"
--- a/unmaintained/morse/authors.txt
+++ b/unmaintained/morse/authors.txt
--- a/extra/couchdb/couchdb-tests.factor
+++ b/extra/couchdb/couchdb-tests.factor
@ -0,0 +1,46 @@
+! Copyright (C) 2008 Alex Chapman
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors assocs couchdb kernel namespaces sequences strings tools.test ;
+IN: couchdb.tests
+
+! You must have a CouchDB server (currently only the version from svn will
+! work) running on localhost and listening on the default port for these tests
+! to work.
+
+<default-server> "factor-test" <db> [
+    [ ] [ couch get create-db ] unit-test
+    [ couch get create-db ] must-fail
+    [ ] [ couch get delete-db ] unit-test
+    [ couch get delete-db ] must-fail
+    [ ] [ couch get ensure-db ] unit-test
+    [ ] [ couch get ensure-db ] unit-test
+    [ 0 ] [ couch get db-info "doc_count" swap at ] unit-test
+    [ ] [ couch get compact-db ] unit-test
+    [ t ] [ couch get server>> next-uuid string? ] unit-test
+    [ ] [ H{
+            { "Subject" "I like Planktion" }
+            { "Tags" { "plankton" "baseball" "decisions" } }
+            { "Body"
+              "I decided today that I don't like baseball. I like plankton." }
+            { "Author" "Rusty" }
+            { "PostedDate" "2006-08-15T17:30:12Z-04:00" }
+           } save-doc ] unit-test
+    [ t ] [ couch get all-docs "rows" swap at first "id" swap at dup "id" set string? ] unit-test
+    [ t ] [ "id" get dup load-doc id> = ] unit-test
+    [ ] [ "id" get load-doc save-doc ] unit-test
+    [ "Rusty" ] [ "id" get load-doc "Author" swap at ] unit-test
+    [ ] [ "id" get load-doc "Alex" "Author" pick set-at save-doc ] unit-test
+    [ "Alex" ] [ "id" get load-doc "Author" swap at ] unit-test
+    [ 1 ] [ "function(doc) { emit(null, doc) }" temp-view-map "total_rows" swap at ] unit-test
+    [ ] [ H{
+         { "_id" "_design/posts" }
+         { "language" "javascript" }
+         { "views" H{
+             { "all" H{ { "map" "function(doc) { emit(null, doc) }" } } }
+           }
+         }
+       } save-doc ] unit-test
+    [ t ] [ "id" get load-doc delete-doc string? ] unit-test
+    [ "id" get load-doc ] must-fail
+    [ ] [ couch get delete-db ] unit-test
+] with-couch
--- a/extra/couchdb/couchdb.factor
+++ b/extra/couchdb/couchdb.factor
@ -0,0 +1,200 @@
+! Copyright (C) 2008, 2009 Alex Chapman
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors arrays assocs continuations debugger hashtables http
+http.client io io.encodings.string io.encodings.utf8 json.reader
+json.writer kernel make math math.parser namespaces sequences strings
+urls urls.encoding vectors ;
+IN: couchdb
+
+! NOTE: This code only works with the latest couchdb (0.9.*), because old
+! versions didn't provide the /_uuids feature which this code relies on when
+! creating new documents.
+
+SYMBOL: couch
+: with-couch ( db quot -- )
+    couch swap with-variable ; inline
+
+! errors
+TUPLE: couchdb-error { data assoc } ;
+C: <couchdb-error> couchdb-error
+
+M: couchdb-error error. ( error -- )
+    "CouchDB Error: " write data>>
+    "error" over at [ print ] when*
+    "reason" swap at [ print ] when* ;
+
+PREDICATE: file-exists-error < couchdb-error
+    data>> "error" swap at "file_exists" = ;
+
+! http tools
+: couch-http-request ( request -- data )
+    [ http-request ] [
+        dup download-failed? [
+            response>> body>> json> <couchdb-error> throw
+        ] [
+            rethrow
+        ] if
+    ] recover nip ;
+
+: couch-request ( request -- assoc )
+    couch-http-request json> ;
+
+: couch-get ( url -- assoc )
+    <get-request> couch-request ;
+
+: couch-put ( post-data url -- assoc )
+    <put-request> couch-request ;
+
+: couch-post ( post-data url -- assoc )
+    <post-request> couch-request ;
+
+: couch-delete ( url -- assoc )
+    <delete-request> couch-request ;
+
+: response-ok ( assoc -- assoc )
+    "ok" over delete-at* and t assert= ;
+
+: response-ok* ( assoc -- )
+    response-ok drop ;
+
+! server
+TUPLE: server { host string } { port integer } { uuids vector } { uuids-to-cache integer } ;
+
+: default-couch-host ( -- host ) "localhost" ; inline
+: default-couch-port ( -- port ) 5984 ; inline
+: default-uuids-to-cache ( -- n ) 100 ; inline
+
+: <server> ( host port -- server )
+    V{ } clone default-uuids-to-cache server boa ;
+
+: <default-server> ( -- server )
+    default-couch-host default-couch-port <server> ;
+
+: (server-url) ( server -- )
+    "http://" % [ host>> % ] [ CHAR: : , port>> number>string % ] bi CHAR: / , ; inline
+
+: server-url ( server -- url )
+    [ (server-url) ] "" make ;
+
+: all-dbs ( server -- dbs )
+    server-url "_all_dbs" append couch-get ;
+
+: uuids-url ( server -- url )
+    [ dup server-url % "_uuids?count=" % uuids-to-cache>> number>string % ] "" make ;
+
+: uuids-get ( server -- uuids )
+     uuids-url couch-get "uuids" swap at >vector ;
+
+: get-uuids ( server -- server )
+    dup uuids-get [ nip ] curry change-uuids ;
+
+: ensure-uuids ( server -- server )
+    dup uuids>> empty? [ get-uuids ] when ;
+
+: next-uuid ( server -- uuid )
+    ensure-uuids uuids>> pop ;
+
+! db 
+TUPLE: db { server server } { name string } ;
+C: <db> db
+
+: (db-url) ( db -- )
+    [ server>> server-url % ] [ name>> % ] bi CHAR: / , ; inline
+
+: db-url ( db -- url )
+    [ (db-url) ] "" make ;
+
+: create-db ( db -- )
+    f swap db-url couch-put response-ok* ;
+
+: ensure-db ( db -- )
+    [ create-db ] [
+        dup file-exists-error? [ 2drop ] [ rethrow ] if
+    ] recover ;
+
+: delete-db ( db -- )
+    db-url couch-delete drop ;
+
+: db-info ( db -- info )
+    db-url couch-get ;
+
+: compact-db ( db -- )
+    f swap db-url "_compact" append couch-post response-ok* ;
+
+: all-docs ( db -- docs )
+    ! TODO: queries. Maybe pass in a hashtable with options
+    db-url "_all_docs" append couch-get ;
+
+: <json-post-data> ( assoc -- post-data )
+    >json utf8 encode "application/json" <post-data> swap >>data ;
+
+! documents
+: id> ( assoc -- id ) "_id" swap at ; 
+: >id ( assoc id -- assoc ) "_id" pick set-at ;
+: rev> ( assoc -- rev ) "_rev" swap at ;
+: >rev ( assoc rev -- assoc ) "_rev" pick set-at ;
+: attachments> ( assoc -- attachments ) "_attachments" swap at ;
+: >attachments ( assoc attachments -- assoc ) "_attachments" pick set-at ;
+
+: copy-key ( to from to-key from-key -- )
+    rot at spin set-at ;
+
+: copy-id ( to from -- )
+    "_id" "id" copy-key ;
+
+: copy-rev ( to from -- )
+    "_rev" "rev" copy-key ;
+
+: id-url ( id -- url )
+    couch get db-url swap url-encode-full append ;
+
+: doc-url ( assoc -- url )
+    id> id-url ;
+
+: temp-view ( view -- results )
+    <json-post-data> couch get db-url "_temp_view" append couch-post ;
+
+: temp-view-map ( map -- results )
+    "map" H{ } clone [ set-at ] keep temp-view ;
+
+: save-doc-as ( assoc id -- )
+    [ dup <json-post-data> ] dip id-url couch-put response-ok
+    [ copy-id ] [ copy-rev ] 2bi ;
+
+: save-new-doc ( assoc -- )
+    couch get server>> next-uuid save-doc-as ;
+
+: save-doc ( assoc -- )
+    dup id> [ save-doc-as ] [ save-new-doc ] if* ; 
+
+: load-doc ( id -- assoc )
+    id-url couch-get ;
+
+: delete-doc ( assoc -- deletion-revision )
+    [
+        [ doc-url % ]
+        [ "?rev=" % "_rev" swap at % ] bi
+    ] "" make couch-delete response-ok "rev" swap at  ;
+
+: remove-keys ( assoc keys -- )
+    swap [ delete-at ] curry each ;
+
+: remove-couch-info ( assoc -- )
+    { "_id" "_rev" "_attachments" } remove-keys ;
+
+! : construct-attachment ( content-type data -- assoc )
+!     H{ } clone "name" pick set-at "content-type" pick set-at ;
+! 
+! : add-attachment ( assoc name attachment -- )
+!     pick attachments> [ H{ } clone ] unless* 
+! 
+! : attach ( assoc name content-type data -- )
+!     construct-attachment H{ } clone
+
+! TODO:
+! - startkey, limit, descending, etc.
+! - loading specific revisions
+! - views
+! - attachments
+! - bulk insert/update
+! - ...?
--- a/unmaintained/synth/authors.txt
+++ b/unmaintained/synth/authors.txt
--- a/extra/jamshred/deploy.factor
+++ b/extra/jamshred/deploy.factor
@ -0,0 +1,12 @@
+USING: tools.deploy.config ;
+V{
+    { deploy-ui? t }
+    { deploy-io 1 }
+    { deploy-reflection 1 }
+    { deploy-compiler? t }
+    { deploy-math? t }
+    { deploy-word-props? f }
+    { deploy-c-types? f }
+    { "stop-after-last-window?" t }
+    { deploy-name "Jamshred" }
+}
--- a/unmaintained/synth/buffers/authors.txt
+++ b/unmaintained/synth/buffers/authors.txt
--- a/extra/jamshred/game/game.factor
+++ b/extra/jamshred/game/game.factor
@ -0,0 +1,40 @@
+! Copyright (C) 2007, 2008 Alex Chapman
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors kernel opengl arrays sequences jamshred.log jamshred.player jamshred.sound jamshred.tunnel math math.constants math.vectors ;
+IN: jamshred.game
+
+TUPLE: jamshred sounds tunnel players running quit ;
+
+: <jamshred> ( -- jamshred )
+    <sounds> <random-tunnel> "Player 1" pick <player>
+    2dup swap play-in-tunnel 1array f f jamshred boa ;
+
+: jamshred-player ( jamshred -- player )
+    ! TODO: support more than one player
+    players>> first ;
+
+: jamshred-update ( jamshred -- )
+    dup running>> [
+        jamshred-player update-player
+    ] [ drop ] if ;
+
+: toggle-running ( jamshred -- )
+    dup running>> [
+        f >>running drop
+    ] [
+        [ jamshred-player moved ]
+        [ t >>running drop ] bi
+    ] if ;
+
+: mouse-moved ( x-radians y-radians jamshred -- )
+    jamshred-player -rot turn-player ;
+
+: units-per-full-roll ( -- n ) 50 ;
+
+: jamshred-roll ( jamshred n -- )
+    [ jamshred-player ] dip 2 pi * * units-per-full-roll / roll-player ;
+        
+: mouse-scroll-x ( jamshred x -- ) jamshred-roll ;
+
+: mouse-scroll-y ( jamshred y -- )
+    neg swap jamshred-player change-player-speed ;
--- a/unmaintained/synth/example/authors.txt
+++ b/unmaintained/synth/example/authors.txt
--- a/extra/jamshred/gl/gl.factor
+++ b/extra/jamshred/gl/gl.factor
@ -0,0 +1,112 @@
+! Copyright (C) 2007, 2008 Alex Chapman
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors alien.c-types jamshred.game jamshred.oint
+jamshred.player jamshred.tunnel kernel math math.constants
+math.functions math.vectors opengl opengl.gl opengl.glu
+opengl.demo-support sequences specialized-arrays.float ;
+IN: jamshred.gl
+
+: min-vertices ( -- n ) 6 ; inline
+: max-vertices ( -- n ) 32 ; inline
+
+: n-vertices ( -- n ) 32 ; inline
+
+! render enough of the tunnel that it looks continuous
+: n-segments-ahead ( -- n ) 60 ; inline
+: n-segments-behind ( -- n ) 40 ; inline
+
+: wall-drawing-offset ( -- n )
+    #! so that we can't see through the wall, we draw it a bit further away
+    0.15 ;
+
+: wall-drawing-radius ( segment -- r )
+    radius>> wall-drawing-offset + ;
+
+: wall-up ( segment -- v )
+    [ wall-drawing-radius ] [ up>> ] bi n*v ;
+
+: wall-left ( segment -- v )
+    [ wall-drawing-radius ] [ left>> ] bi n*v ;
+
+: segment-vertex ( theta segment -- vertex )
+    [
+        [ wall-up swap sin v*n ] [ wall-left swap cos v*n ] 2bi v+
+    ] [
+        location>> v+
+    ] bi ;
+
+: segment-vertex-normal ( vertex segment -- normal )
+    location>> swap v- normalize ;
+
+: segment-vertex-and-normal ( segment theta -- vertex normal )
+    swap [ segment-vertex ] keep dupd segment-vertex-normal ;
+
+: equally-spaced-radians ( n -- seq )
+    #! return a sequence of n numbers between 0 and 2pi
+    dup [ / pi 2 * * ] curry map ;
+
+: draw-segment-vertex ( segment theta -- )
+    over color>> gl-color segment-vertex-and-normal
+    gl-normal gl-vertex ;
+
+: draw-vertex-pair ( theta next-segment segment -- )
+    rot tuck draw-segment-vertex draw-segment-vertex ;
+
+: draw-segment ( next-segment segment -- )
+    GL_QUAD_STRIP [
+        [ draw-vertex-pair ] 2curry
+        n-vertices equally-spaced-radians float-array{ 0.0 } append swap each
+    ] do-state ;
+
+: draw-segments ( segments -- )
+    1 over length pick subseq swap [ draw-segment ] 2each ;
+
+: segments-to-render ( player -- segments )
+    dup nearest-segment>> number>> dup n-segments-behind -
+    swap n-segments-ahead + rot tunnel>> sub-tunnel ;
+
+: draw-tunnel ( player -- )
+    segments-to-render draw-segments ;
+
+: init-graphics ( -- )
+    GL_DEPTH_TEST glEnable
+    GL_SCISSOR_TEST glDisable
+    1.0 glClearDepth
+    0.0 0.0 0.0 0.0 glClearColor
+    GL_PROJECTION glMatrixMode glPushMatrix
+    GL_MODELVIEW glMatrixMode glPushMatrix
+    GL_LEQUAL glDepthFunc
+    GL_LIGHTING glEnable
+    GL_LIGHT0 glEnable
+    GL_FOG glEnable
+    GL_FOG_DENSITY 0.09 glFogf
+    GL_FRONT GL_AMBIENT_AND_DIFFUSE glColorMaterial
+    GL_COLOR_MATERIAL glEnable
+    GL_LIGHT0 GL_POSITION float-array{ 0.0 0.0 0.0 1.0 } underlying>> glLightfv
+    GL_LIGHT0 GL_AMBIENT float-array{ 0.2 0.2 0.2 1.0 } underlying>> glLightfv
+    GL_LIGHT0 GL_DIFFUSE float-array{ 1.0 1.0 1.0 1.0 } underlying>> glLightfv
+    GL_LIGHT0 GL_SPECULAR float-array{ 1.0 1.0 1.0 1.0 } underlying>> glLightfv ;
+
+: cleanup-graphics ( -- )
+    GL_DEPTH_TEST glDisable
+    GL_SCISSOR_TEST glEnable
+    GL_MODELVIEW glMatrixMode glPopMatrix
+    GL_PROJECTION glMatrixMode glPopMatrix
+    GL_LIGHTING glDisable
+    GL_LIGHT0 glDisable
+    GL_FOG glDisable
+    GL_COLOR_MATERIAL glDisable ;
+
+: pre-draw ( width height -- )
+    GL_COLOR_BUFFER_BIT GL_DEPTH_BUFFER_BIT bitor glClear
+    GL_PROJECTION glMatrixMode glLoadIdentity
+    dup 0 = [ 2drop ] [ / >float 45.0 swap 0.1 100.0 gluPerspective ] if
+    GL_MODELVIEW glMatrixMode glLoadIdentity ;
+
+: player-view ( player -- )
+    [ location>> ]
+    [ [ location>> ] [ forward>> ] bi v+ ]
+    [ up>> ] tri gl-look-at ;
+
+: draw-jamshred ( jamshred width height -- )
+    pre-draw jamshred-player [ player-view ] [ draw-tunnel ] bi ;
--- a/extra/jamshred/jamshred.factor
+++ b/extra/jamshred/jamshred.factor
@ -0,0 +1,94 @@
+! Copyright (C) 2007, 2008 Alex Chapman
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors arrays calendar jamshred.game jamshred.gl jamshred.player jamshred.log kernel math math.constants math.rectangles math.vectors namespaces sequences threads ui ui.backend ui.gadgets ui.gadgets.worlds ui.gestures ui.render ;
+IN: jamshred
+
+TUPLE: jamshred-gadget < gadget { jamshred jamshred } last-hand-loc ;
+
+: <jamshred-gadget> ( jamshred -- gadget )
+    jamshred-gadget new swap >>jamshred ;
+
+: default-width ( -- x ) 800 ;
+: default-height ( -- y ) 600 ;
+
+M: jamshred-gadget pref-dim*
+    drop default-width default-height 2array ;
+
+M: jamshred-gadget draw-gadget* ( gadget -- )
+    [ jamshred>> ] [ dim>> first2 draw-jamshred ] bi ;
+
+: jamshred-loop ( gadget -- )
+    dup jamshred>> quit>> [
+        drop
+    ] [
+        [ jamshred>> jamshred-update ]
+        [ relayout-1 ]
+        [ 100 milliseconds sleep jamshred-loop ] tri 
+    ] if ;
+
+: fullscreen ( gadget -- )
+    find-world t swap set-fullscreen* ;
+
+: no-fullscreen ( gadget -- )
+    find-world f swap set-fullscreen* ;
+
+: toggle-fullscreen ( world -- )
+    [ fullscreen? not ] keep set-fullscreen* ;
+
+M: jamshred-gadget graft* ( gadget -- )
+    [ find-gl-context init-graphics ]
+    [ [ jamshred-loop ] curry in-thread ] bi ;
+
+M: jamshred-gadget ungraft* ( gadget -- )
+    dup find-gl-context cleanup-graphics jamshred>> t swap (>>quit) ;
+
+: jamshred-restart ( jamshred-gadget -- )
+    <jamshred> >>jamshred drop ;
+
+: pix>radians ( n m -- theta )
+    / pi 4 * * ; ! 2 / / pi 2 * * ;
+
+: x>radians ( x gadget -- theta )
+    #! translate motion of x pixels to an angle
+    dim>> first pix>radians neg ;
+
+: y>radians ( y gadget -- theta )
+    #! translate motion of y pixels to an angle
+    dim>> second pix>radians ;
+
+: (handle-mouse-motion) ( jamshred-gadget mouse-motion -- )
+    dupd [ first swap x>radians ] [ second swap y>radians ] 2bi
+    rot jamshred>> mouse-moved ;
+    
+: handle-mouse-motion ( jamshred-gadget -- )
+    hand-loc get [
+        over last-hand-loc>> [
+            v- (handle-mouse-motion) 
+        ] [ 2drop ] if* 
+    ] 2keep >>last-hand-loc drop ;
+
+: handle-mouse-scroll ( jamshred-gadget -- )
+    jamshred>> scroll-direction get
+    [ first mouse-scroll-x ]
+    [ second mouse-scroll-y ] 2bi ;
+
+: quit ( gadget -- )
+    [ no-fullscreen ] [ close-window ] bi ;
+
+jamshred-gadget H{
+    { T{ key-down f f "r" } [ jamshred-restart ] }
+    { T{ key-down f f " " } [ jamshred>> toggle-running ] }
+    { T{ key-down f f "f" } [ find-world toggle-fullscreen ] }
+    { T{ key-down f f "UP" } [ jamshred>> jamshred-player 1 swap change-player-speed ] }
+    { T{ key-down f f "DOWN" } [ jamshred>> jamshred-player -1 swap change-player-speed ] }
+    { T{ key-down f f "LEFT" } [ jamshred>> 1 jamshred-roll ] }
+    { T{ key-down f f "RIGHT" } [ jamshred>> -1 jamshred-roll ] }
+    { T{ key-down f f "q" } [ quit ] }
+    { motion [ handle-mouse-motion ] }
+    { mouse-scroll [ handle-mouse-scroll ] }
+} set-gestures
+
+: jamshred-window ( -- )
+    [ <jamshred> <jamshred-gadget> "Jamshred" open-window ] with-ui ;
+
+MAIN: jamshred-window
--- a/extra/jamshred/log/log.factor
+++ b/extra/jamshred/log/log.factor
@ -0,0 +1,10 @@
+USING: kernel logging ;
+IN: jamshred.log
+
+LOG: (jamshred-log) DEBUG
+
+: with-jamshred-log ( quot -- )
+    "jamshred" swap with-logging ;
+
+: jamshred-log ( message -- )
+    [ (jamshred-log) ] with-jamshred-log ; ! ugly...
--- a/extra/jamshred/oint/authors.txt
+++ b/extra/jamshred/oint/authors.txt
@ -0,0 +1 @@
+Alex Chapman
--- a/extra/jamshred/oint/oint-tests.factor
+++ b/extra/jamshred/oint/oint-tests.factor
@ -0,0 +1,8 @@
+USING: jamshred.oint tools.test ;
+IN: jamshred.oint-tests
+
+[ { 0 -1 -1 } ] [ { 0 1 -1 } { 0 -1 0 } reflect ] unit-test
+[ { 0 1 0 } ] [ { 1 1 0 } { 1 0 0 } proj-perp ] unit-test
+[ { 1 0 0 } ] [ { 1 1 0 } { 0 1 0 } proj-perp ] unit-test
+[ { 1/2 -1/2 0 } ] [ { 1 0 0 } { 1 1 0 } proj-perp ] unit-test
+[ { -1/2 1/2 0 } ] [ { 0 1 0 } { 1 1 0 } proj-perp ] unit-test
--- a/extra/jamshred/oint/oint.factor
+++ b/extra/jamshred/oint/oint.factor
@ -0,0 +1,73 @@
+! Copyright (C) 2007, 2008 Alex Chapman
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors arrays kernel locals math math.constants math.functions math.matrices math.vectors math.quaternions random sequences ;
+IN: jamshred.oint
+
+! An oint is a point with three linearly independent unit vectors
+! given relative to that point. In jamshred a player's location and
+! direction are given by the player's oint. Similarly, a tunnel
+! segment's location and orientation are given by an oint.
+
+TUPLE: oint location forward up left ;
+C: <oint> oint
+
+: rotation-quaternion ( theta axis -- quaternion )
+    swap 2 / dup cos swap sin rot n*v first3 rect> [ rect> ] dip 2array ;
+
+: rotate-vector ( q qrecip v -- v )
+    v>q swap q* q* q>v ;
+
+: rotate-oint ( oint theta axis -- )
+    rotation-quaternion dup qrecip pick
+    [ forward>> rotate-vector >>forward ]
+    [ up>> rotate-vector >>up ]
+    [ left>> rotate-vector >>left ] 3tri drop ;
+
+: left-pivot ( oint theta -- )
+    over left>> rotate-oint ;
+
+: up-pivot ( oint theta -- )
+    over up>> rotate-oint ;
+
+: forward-pivot ( oint theta -- )
+    over forward>> rotate-oint ;
+
+: random-float+- ( n -- m )
+    #! find a random float between -n/2 and n/2
+    dup 10000 * >fixnum random 10000 / swap 2 / - ;
+
+: random-turn ( oint theta -- )
+    2 / 2dup random-float+- left-pivot random-float+- up-pivot ;
+
+: location+ ( v oint -- )
+    [ location>> v+ ] [ (>>location) ] bi ;
+
+: go-forward ( distance oint -- )
+    [ forward>> n*v ] [ location+ ] bi ;
+
+: distance-vector ( oint oint -- vector )
+    [ location>> ] bi@ swap v- ;
+
+: distance ( oint oint -- distance )
+    distance-vector norm ;
+
+: scalar-projection ( v1 v2 -- n )
+    #! the scalar projection of v1 onto v2
+    tuck v. swap norm / ;
+
+: proj-perp ( u v -- w )
+    dupd proj v- ;
+
+: perpendicular-distance ( oint oint -- distance )
+    tuck distance-vector swap 2dup left>> scalar-projection abs
+    -rot up>> scalar-projection abs + ;
+
+:: reflect ( v n -- v' )
+    #! bounce v on a surface with normal n
+    v v n v. n n v. / 2 * n n*v v- ;
+
+: half-way ( p1 p2 -- p3 )
+    over v- 2 v/n v+ ;
+
+: half-way-between-oints ( o1 o2 -- p )
+    [ location>> ] bi@ half-way ;
--- a/extra/jamshred/player/authors.txt
+++ b/extra/jamshred/player/authors.txt
@ -0,0 +1 @@
+Alex Chapman
--- a/extra/jamshred/player/player.factor
+++ b/extra/jamshred/player/player.factor
@ -0,0 +1,137 @@
+! Copyright (C) 2007, 2008 Alex Chapman
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors colors.constants combinators jamshred.log jamshred.oint jamshred.sound jamshred.tunnel kernel locals math math.constants math.order math.ranges math.vectors math.matrices sequences shuffle specialized-arrays.float strings system ;
+IN: jamshred.player
+
+TUPLE: player < oint
+    { name string }
+    { sounds sounds }
+    tunnel
+    nearest-segment
+    { last-move integer }
+    { speed float } ;
+
+! speeds are in GL units / second
+: default-speed ( -- speed ) 1.0 ;
+: max-speed ( -- speed ) 30.0 ;
+
+: <player> ( name sounds -- player )
+    [ float-array{ 0 0 5 } float-array{ 0 0 -1 } float-array{ 0 1 0 } float-array{ -1 0 0 } ] 2dip
+    f f 0 default-speed player boa ;
+
+: turn-player ( player x-radians y-radians -- )
+    [ over ] dip left-pivot up-pivot ;
+
+: roll-player ( player z-radians -- )
+    forward-pivot ;
+
+: to-tunnel-start ( player -- )
+    [ tunnel>> first dup location>> ]
+    [ tuck (>>location) (>>nearest-segment) ] bi ;
+
+: play-in-tunnel ( player segments -- )
+    >>tunnel to-tunnel-start ;
+
+: update-nearest-segment ( player -- )
+    [ tunnel>> ] [ dup nearest-segment>> nearest-segment ]
+    [ (>>nearest-segment) ] tri ;
+
+: update-time ( player -- seconds-passed )
+    millis swap [ last-move>> - 1000 / ] [ (>>last-move) ] 2bi ;
+
+: moved ( player -- ) millis swap (>>last-move) ;
+
+: speed-range ( -- range )
+    max-speed [0,b] ;
+
+: change-player-speed ( inc player -- )
+    [ + speed-range clamp-to-range ] change-speed drop ;
+
+: multiply-player-speed ( n player -- )
+    [ * speed-range clamp-to-range ] change-speed drop ; 
+
+: distance-to-move ( seconds-passed player -- distance )
+    speed>> * ;
+
+: bounce ( d-left player -- d-left' player )
+    {
+        [ dup nearest-segment>> bounce-off-wall ]
+        [ sounds>> bang ]
+        [ 3/4 swap multiply-player-speed ]
+        [ ]
+    } cleave ;
+
+:: (distance) ( heading player -- current next location heading )
+    player nearest-segment>>
+    player [ tunnel>> ] [ nearest-segment>> ] bi heading heading-segment
+    player location>> heading ;
+
+: distance-to-heading-segment ( heading player -- distance )
+    (distance) distance-to-next-segment ;
+
+: distance-to-heading-segment-area ( heading player -- distance )
+    (distance) distance-to-next-segment-area ;
+
+: distance-to-collision ( player -- distance )
+    dup nearest-segment>> (distance-to-collision) ;
+
+: almost-to-collision ( player -- distance )
+    distance-to-collision 0.1 - dup 0 < [ drop 0 ] when ;
+
+: from ( player -- radius distance-from-centre )
+    [ nearest-segment>> dup radius>> swap ] [ location>> ] bi
+    distance-from-centre ;
+
+: distance-from-wall ( player -- distance ) from - ;
+: fraction-from-centre ( player -- fraction ) from swap / ;
+: fraction-from-wall ( player -- fraction )
+    fraction-from-centre 1 swap - ;
+
+: update-nearest-segment2 ( heading player -- )
+    2dup distance-to-heading-segment-area 0 <= [
+        [ tunnel>> ] [ nearest-segment>> rot heading-segment ]
+        [ (>>nearest-segment) ] tri
+    ] [
+        2drop
+    ] if ;
+
+:: move-player-on-heading ( d-left player distance heading -- d-left' player )
+    [let* | d-to-move [ d-left distance min ]
+            move-v [ d-to-move heading n*v ] |
+        move-v player location+
+        heading player update-nearest-segment2
+        d-left d-to-move - player ] ;
+
+: distance-to-move-freely ( player -- distance )
+    [ almost-to-collision ]
+    [ [ forward>> ] keep distance-to-heading-segment-area ] bi min ;
+
+: ?move-player-freely ( d-left player -- d-left' player )
+    over 0 > [
+        ! must make sure we are moving a significant distance, otherwise
+        ! we can recurse endlessly due to floating-point imprecision.
+        ! (at least I /think/ that's what causes it...)
+        dup distance-to-move-freely dup 0.1 > [
+            over forward>> move-player-on-heading ?move-player-freely
+        ] [ drop ] if
+    ] when ;
+
+: drag-heading ( player -- heading )
+    [ forward>> ] [ nearest-segment>> forward>> proj ] bi ;
+
+: drag-player ( d-left player -- d-left' player )
+    dup [ [ drag-heading ] keep distance-to-heading-segment-area ]
+    [ drag-heading move-player-on-heading ] bi ;
+
+: (move-player) ( d-left player -- d-left' player )
+    ?move-player-freely over 0 > [
+        ! bounce
+        drag-player
+        (move-player)
+    ] when ;
+
+: move-player ( player -- )
+    [ update-time ] [ distance-to-move ] [ (move-player) 2drop ] tri ;
+
+: update-player ( player -- )
+    [ move-player ] [ nearest-segment>> "white" named-color swap (>>color) ] bi ;
--- a/extra/jamshred/sound/sound.factor
+++ b/extra/jamshred/sound/sound.factor
@ -0,0 +1,15 @@
+! Copyright (C) 2008 Alex Chapman
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors io.pathnames kernel openal sequences ;
+IN: jamshred.sound
+
+TUPLE: sounds bang ;
+
+: assign-sound ( source wav-path -- )
+    resource-path create-buffer-from-wav AL_BUFFER swap set-source-param ;
+
+: <sounds> ( -- sounds )
+    init-openal 1 gen-sources first sounds boa
+    dup bang>> "extra/jamshred/sound/bang.wav" assign-sound ;
+
+: bang ( sounds -- ) bang>> source-play check-error ;
--- a/extra/jamshred/summary.txt
+++ b/extra/jamshred/summary.txt
@ -0,0 +1 @@
+A simple 3d tunnel racing game
--- a/extra/jamshred/tags.txt
+++ b/extra/jamshred/tags.txt
@ -0,0 +1,2 @@
+applications
+games
--- a/extra/jamshred/tunnel/authors.txt
+++ b/extra/jamshred/tunnel/authors.txt
@ -0,0 +1 @@
+Alex Chapman
--- a/extra/jamshred/tunnel/tunnel-tests.factor
+++ b/extra/jamshred/tunnel/tunnel-tests.factor
@ -0,0 +1,45 @@
+! Copyright (C) 2007, 2008 Alex Chapman
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors arrays jamshred.oint jamshred.tunnel kernel math.vectors sequences specialized-arrays.float tools.test ;
+IN: jamshred.tunnel.tests
+
+[ 0 ] [ T{ segment f { 0 0 0 } f f f 0 }
+        T{ segment f { 1 1 1 } f f f 1 }
+        T{ oint f { 0 0 0.25 } }
+        nearer-segment number>> ] unit-test
+
+[ 0 ] [ T{ oint f { 0 0 0 } } <straight-tunnel> find-nearest-segment number>> ] unit-test
+[ 1 ] [ T{ oint f { 0 0 -1 } } <straight-tunnel> find-nearest-segment number>> ] unit-test
+[ 2 ] [ T{ oint f { 0 0.1 -2.1 } } <straight-tunnel> find-nearest-segment number>> ] unit-test
+
+[ 3 ] [ <straight-tunnel> T{ oint f { 0 0 -3.25 } } 0 nearest-segment-forward number>> ] unit-test
+
+[ float-array{ 0 0 0 } ] [ <straight-tunnel> T{ oint f { 0 0 -0.25 } } over first nearest-segment location>> ] unit-test
+
+: test-segment-oint ( -- oint )
+    { 0 0 0 } { 0 0 -1 } { 0 1 0 } { -1 0 0 } <oint> ;
+
+[ { -1 0 0 } ] [ test-segment-oint { 1 0 0 } vector-to-centre ] unit-test
+[ { 1 0 0 } ] [ test-segment-oint { -1 0 0 } vector-to-centre ] unit-test
+[ { 0 -1 0 } ] [ test-segment-oint { 0 1 0 } vector-to-centre ] unit-test
+[ { 0 1 0 } ] [ test-segment-oint { 0 -1 0 } vector-to-centre ] unit-test
+[ { -1 0 0 } ] [ test-segment-oint { 1 0 -1 } vector-to-centre ] unit-test
+[ { 1 0 0 } ] [ test-segment-oint { -1 0 -1 } vector-to-centre ] unit-test
+[ { 0 -1 0 } ] [ test-segment-oint { 0 1 -1 } vector-to-centre ] unit-test
+[ { 0 1 0 } ] [ test-segment-oint { 0 -1 -1 } vector-to-centre ] unit-test
+
+: simplest-straight-ahead ( -- oint segment )
+    { 0 0 0 } { 0 0 -1 } { 0 1 0 } { -1 0 0 } <oint>
+    initial-segment ;
+
+[ { 0.0 0.0 0.0 } ] [ simplest-straight-ahead sideways-heading ] unit-test
+[ { 0.0 0.0 0.0 } ] [ simplest-straight-ahead sideways-relative-location ] unit-test
+
+: simple-collision-up ( -- oint segment )
+    { 0 0 0 } { 0 1 0 } { 0 0 1 } { -1 0 0 } <oint>
+    initial-segment ;
+
+[ { 0.0 1.0 0.0 } ] [ simple-collision-up sideways-heading ] unit-test
+[ { 0.0 0.0 0.0 } ] [ simple-collision-up sideways-relative-location ] unit-test
+[ { 0.0 1.0 0.0 } ]
+[ simple-collision-up collision-vector 0 0 0 3array v+ ] unit-test
--- a/extra/jamshred/tunnel/tunnel.factor
+++ b/extra/jamshred/tunnel/tunnel.factor
@ -0,0 +1,165 @@
+! Copyright (C) 2007, 2008 Alex Chapman
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors arrays colors combinators kernel locals math math.constants math.matrices math.order math.ranges math.vectors math.quadratic random sequences specialized-arrays.float vectors jamshred.oint ;
+IN: jamshred.tunnel
+
+: n-segments ( -- n ) 5000 ; inline
+
+TUPLE: segment < oint number color radius ;
+C: <segment> segment
+
+: segment-number++ ( segment -- )
+    [ number>> 1+ ] keep (>>number) ;
+
+: random-color ( -- color )
+    { 100 100 100 } [ random 100 / >float ] map first3 1.0 <rgba> ;
+
+: tunnel-segment-distance ( -- n ) 0.4 ;
+: random-rotation-angle ( -- theta ) pi 20 / ;
+
+: random-segment ( previous-segment -- segment )
+    clone dup random-rotation-angle random-turn
+    tunnel-segment-distance over go-forward
+    random-color >>color dup segment-number++ ;
+
+: (random-segments) ( segments n -- segments )
+    dup 0 > [
+        [ dup peek random-segment over push ] dip 1- (random-segments)
+    ] [ drop ] if ;
+
+: default-segment-radius ( -- r ) 1 ;
+
+: initial-segment ( -- segment )
+    float-array{ 0 0 0 } float-array{ 0 0 -1 } float-array{ 0 1 0 } float-array{ -1 0 0 }
+    0 random-color default-segment-radius <segment> ;
+
+: random-segments ( n -- segments )
+    initial-segment 1vector swap (random-segments) ;
+
+: simple-segment ( n -- segment )
+    [ float-array{ 0 0 -1 } n*v float-array{ 0 0 -1 } float-array{ 0 1 0 } float-array{ -1 0 0 } ] keep
+    random-color default-segment-radius <segment> ;
+
+: simple-segments ( n -- segments )
+    [ simple-segment ] map ;
+
+: <random-tunnel> ( -- segments )
+    n-segments random-segments ;
+
+: <straight-tunnel> ( -- segments )
+    n-segments simple-segments ;
+
+: sub-tunnel ( from to segments -- segments )
+    #! return segments between from and to, after clamping from and to to
+    #! valid values
+    [ sequence-index-range [ clamp-to-range ] curry bi@ ] keep <slice> ;
+
+: nearer-segment ( segment segment oint -- segment )
+    #! return whichever of the two segments is nearer to the oint
+    [ 2dup ] dip tuck distance [ distance ] dip < -rot ? ;
+
+: (find-nearest-segment) ( nearest next oint -- nearest ? )
+    #! find the nearest of 'next' and 'nearest' to 'oint', and return
+    #! t if the nearest hasn't changed
+    pick [ nearer-segment dup ] dip = ;
+
+: find-nearest-segment ( oint segments -- segment )
+    dup first swap rest-slice rot [ (find-nearest-segment) ] curry
+    find 2drop ;
+    
+: nearest-segment-forward ( segments oint start -- segment )
+    rot dup length swap <slice> find-nearest-segment ;
+
+: nearest-segment-backward ( segments oint start -- segment )
+    swapd 1+ 0 spin <slice> <reversed> find-nearest-segment ;
+
+: nearest-segment ( segments oint start-segment -- segment )
+    #! find the segment nearest to 'oint', and return it.
+    #! start looking at segment 'start-segment'
+    number>> over [
+        [ nearest-segment-forward ] 3keep nearest-segment-backward
+    ] dip nearer-segment ;
+
+: get-segment ( segments n -- segment )
+    over sequence-index-range clamp-to-range swap nth ;
+
+: next-segment ( segments current-segment -- segment )
+    number>> 1+ get-segment ;
+
+: previous-segment ( segments current-segment -- segment )
+    number>> 1- get-segment ;
+
+: heading-segment ( segments current-segment heading -- segment )
+    #! the next segment on the given heading
+    over forward>> v. 0 <=> {
+        { +gt+ [ next-segment ] }
+        { +lt+ [ previous-segment ] }
+        { +eq+ [ nip ] } ! current segment
+    } case ;
+
+:: distance-to-next-segment ( current next location heading -- distance )
+    [let | cf [ current forward>> ] |
+        cf next location>> v. cf location v. - cf heading v. / ] ;
+
+:: distance-to-next-segment-area ( current next location heading -- distance )
+    [let | cf [ current forward>> ]
+           h [ next current half-way-between-oints ] |
+        cf h v. cf location v. - cf heading v. / ] ;
+
+: vector-to-centre ( seg loc -- v )
+    over location>> swap v- swap forward>> proj-perp ;
+
+: distance-from-centre ( seg loc -- distance )
+    vector-to-centre norm ;
+
+: wall-normal ( seg oint -- n )
+    location>> vector-to-centre normalize ;
+
+: distant ( -- n ) 1000 ;
+
+: max-real ( a b -- c )
+    #! sometimes collision-coefficient yields complex roots, so we ignore these (hack)
+    dup real? [
+        over real? [ max ] [ nip ] if
+    ] [
+        drop dup real? [ drop distant ] unless
+    ] if ;
+
+:: collision-coefficient ( v w r -- c )
+    v norm 0 = [
+        distant
+    ] [
+        [let* | a [ v dup v. ]
+                b [ v w v. 2 * ]
+                c [ w dup v. r sq - ] |
+            c b a quadratic max-real ]
+    ] if ;
+
+: sideways-heading ( oint segment -- v )
+    [ forward>> ] bi@ proj-perp ;
+
+: sideways-relative-location ( oint segment -- loc )
+    [ [ location>> ] bi@ v- ] keep forward>> proj-perp ;
+
+: (distance-to-collision) ( oint segment -- distance )
+    [ sideways-heading ] [ sideways-relative-location ]
+    [ nip radius>> ] 2tri collision-coefficient ;
+
+: collision-vector ( oint segment -- v )
+    dupd (distance-to-collision) swap forward>> n*v ;
+
+: bounce-forward ( segment oint -- )
+    [ wall-normal ] [ forward>> swap reflect ] [ (>>forward) ] tri ;
+
+: bounce-left ( segment oint -- )
+    #! must be done after forward
+    [ forward>> vneg ] dip [ left>> swap reflect ]
+    [ forward>> proj-perp normalize ] [ (>>left) ] tri ;
+
+: bounce-up ( segment oint -- )
+    #! must be done after forward and left!
+    nip [ forward>> ] [ left>> cross ] [ (>>up) ] tri ;
+
+: bounce-off-wall ( oint segment -- )
+    swap [ bounce-forward ] [ bounce-left ] [ bounce-up ] 2tri ;
+
--- a/extra/mason/build/build-tests.factor
+++ b/extra/mason/build/build-tests.factor
@ -1,5 +1,2 @@
 USING: mason.build tools.test sequences ;
 IN: mason.build.tests
-
-{ create-build-dir enter-build-dir clone-builds-factor record-id }
-[ must-infer ] each
--- a/extra/mason/child/child-tests.factor
+++ b/extra/mason/child/child-tests.factor
@ -1,5 +1,5 @@
 IN: mason.child.tests
-USING: mason.child mason.config tools.test namespaces ;
+USING: mason.child mason.config tools.test namespaces io kernel sequences ;

 [ { "make" "winnt-x86-32" } ] [
    [
--- a/extra/mason/email/email-tests.factor
+++ b/extra/mason/email/email-tests.factor
@ -5,7 +5,6 @@ USING: mason.email mason.common mason.config namespaces tools.test ;
    [
        "linux" target-os set
        "x86.64" target-cpu set
-        status-error status set
-        subject prefix-subject
+        status-error subject prefix-subject
    ] with-scope
 ] unit-test
--- a/extra/mason/report/report.factor
+++ b/extra/mason/report/report.factor
@ -63,6 +63,7 @@ IN: mason.report
        benchmark-time-file
        html-help-time-file
    } [
+        execute( -- string )
        dup utf8 file-contents milli-seconds>time
        [XML <tr><td><-></td><td><-></td></tr> XML]
    ] map [XML <h2>Timings</h2> <table><-></table> XML] ;
--- a/extra/morse/authors.txt
+++ b/extra/morse/authors.txt
@ -0,0 +1 @@
+Alex Chapman
--- a/unmaintained/morse/morse-docs.factor
+++ b/unmaintained/morse/morse-docs.factor
--- a/unmaintained/morse/morse-tests.factor
+++ b/unmaintained/morse/morse-tests.factor
--- a/unmaintained/morse/morse.factor
+++ b/unmaintained/morse/morse.factor
@ -1,8 +1,8 @@
 ! Copyright (C) 2007, 2008 Alex Chapman
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors assocs combinators hashtables kernel lists math
+USING: accessors ascii assocs combinators hashtables kernel lists math
 namespaces make openal parser-combinators promises sequences
-strings symbols synth synth.buffers unicode.case ;
+strings synth synth.buffers unicode.case ;
 IN: morse

 <PRIVATE
@ -135,7 +135,7 @@ SYMBOLS: source dot-buffer dash-buffer intra-char-gap-buffer letter-gap-buffer ;
 : intra-char-gap ( -- ) intra-char-gap-buffer queue ;
 : letter-gap ( -- ) letter-gap-buffer queue ;

-: beep-freq 880 ;
+: beep-freq ( -- n ) 880 ;

 : <morse-buffer> ( -- buffer )
    half-sample-freq <8bit-mono-buffer> ;
@ -160,7 +160,7 @@ SYMBOLS: source dot-buffer dash-buffer intra-char-gap-buffer letter-gap-buffer ;
        init-openal 1 gen-sources first source set make-buffers
        call
        source get source-play
-    ] with-scope ;
+    ] with-scope ; inline

 : play-char ( ch -- )
    [ intra-char-gap ] [
@ -176,7 +176,7 @@ PRIVATE>
 : play-as-morse* ( str unit-length -- )
    [
        [ letter-gap ] [ ch>morse play-char ] interleave
-    ] swap playing-morse ;
+    ] swap playing-morse ; inline

 : play-as-morse ( str -- )
-    0.05 play-as-morse* ;
+    0.05 play-as-morse* ; inline
--- a/unmaintained/morse/summary.txt
+++ b/unmaintained/morse/summary.txt
--- a/unmaintained/morse/tags.txt
+++ b/unmaintained/morse/tags.txt
--- a/unmaintained/openal/authors.txt
+++ b/unmaintained/openal/authors.txt
--- a/unmaintained/openal/backend/authors.txt
+++ b/unmaintained/openal/backend/authors.txt
--- a/unmaintained/openal/backend/backend.factor
+++ b/unmaintained/openal/backend/backend.factor
--- a/unmaintained/openal/example/authors.txt
+++ b/unmaintained/openal/example/authors.txt
--- a/unmaintained/openal/example/example.factor
+++ b/unmaintained/openal/example/example.factor
--- a/unmaintained/openal/macosx/authors.txt
+++ b/unmaintained/openal/macosx/authors.txt
--- a/unmaintained/openal/macosx/macosx.factor
+++ b/unmaintained/openal/macosx/macosx.factor
@ -1,7 +1,7 @@
 ! Copyright (C) 2007 Chris Double.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: alien.c-types kernel alien alien.syntax shuffle
-combinators.lib openal.backend namespaces system ;
+openal.backend namespaces system generalizations ;
 IN: openal.macosx

 LIBRARY: alut
@ -10,5 +10,5 @@ FUNCTION: void alutLoadWAVFile ( ALbyte* fileName, ALenum* format, void** data,

 M: macosx load-wav-file ( path -- format data size frequency )
    0 <int> f <void*> 0 <int> 0 <int>
-    [ alutLoadWAVFile ] 4keep
+    [ alutLoadWAVFile ] 4 nkeep
    [ [ [ *int ] dip *void* ] dip *int ] dip *int ;
--- a/extra/openal/macosx/tags.txt
+++ b/extra/openal/macosx/tags.txt
@ -0,0 +1 @@
+unportable
--- a/unmaintained/openal/openal.factor
+++ b/unmaintained/openal/openal.factor
@ -1,8 +1,8 @@
 ! Copyright (C) 2007 Chris Double.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel arrays alien system combinators alien.syntax namespaces
+USING: kernel accessors arrays alien system combinators alien.syntax namespaces
       alien.c-types sequences vocabs.loader shuffle
-       openal.backend specialized-arrays.uint ;
+       openal.backend specialized-arrays.uint alien.libraries generalizations ;
 IN: openal

 << "alut" {
@ -245,13 +245,11 @@ SYMBOL: init
        f init set-global
    ] unless ;

-: <uint-array> ( n -- byte-array ) "ALuint" <c-array> ;
-
 : gen-sources ( size -- seq )
-    dup <uint-array> 2dup underlying>> alGenSources swap ;
+    dup <uint-array> [ alGenSources ] keep ;

 : gen-buffers ( size -- seq )
-    dup <uint-array> 2dup underlying>> alGenBuffers swap ;
+    dup <uint-array> [ alGenBuffers ] keep ;

 : gen-buffer ( -- buffer ) 1 gen-buffers first ;

@ -264,10 +262,10 @@ os macosx? "openal.macosx" "openal.other" ? require

 : create-buffer-from-wav ( filename -- buffer )
    gen-buffer dup rot load-wav-file
-    [ alBufferData ] 4keep alutUnloadWAV ;
+    [ alBufferData ] 4 nkeep alutUnloadWAV ;

 : queue-buffers ( source buffers -- )
-    [ length ] [ >uint-array underlying>> ] bi alSourceQueueBuffers ;
+    [ length ] [ >uint-array ] bi alSourceQueueBuffers ;

 : queue-buffer ( source buffer -- )
    1array queue-buffers ;
--- a/unmaintained/openal/other/authors.txt
+++ b/unmaintained/openal/other/authors.txt
--- a/unmaintained/openal/other/other.factor
+++ b/unmaintained/openal/other/other.factor
--- a/unmaintained/openal/summary.txt
+++ b/unmaintained/openal/summary.txt
--- a/unmaintained/openal/tags.txt
+++ b/unmaintained/openal/tags.txt
--- a/extra/synth/authors.txt
+++ b/extra/synth/authors.txt
@ -0,0 +1 @@
+Alex Chapman
--- a/extra/synth/buffers/authors.txt
+++ b/extra/synth/buffers/authors.txt
@ -0,0 +1 @@
+Alex Chapman
--- a/unmaintained/synth/buffers/buffers.factor
+++ b/unmaintained/synth/buffers/buffers.factor
@ -1,6 +1,6 @@
 ! Copyright (C) 2008 Alex Chapman
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors alien.c-types combinators kernel locals math math.ranges openal sequences sequences.merged ;
+USING: accessors alien.c-types combinators kernel locals math math.ranges openal sequences sequences.merged specialized-arrays.uchar specialized-arrays.short ;
 IN: synth.buffers

 TUPLE: buffer sample-freq 8bit? id ;
@ -57,11 +57,11 @@ M: 8bit-stereo-buffer buffer-data
 M: 16bit-stereo-buffer buffer-data
    interleaved-stereo-data 16bit-buffer-data ;

-: telephone-sample-freq 8000 ;
-: half-sample-freq 22050 ;
-: cd-sample-freq 44100 ;
-: digital-sample-freq 48000 ;
-: professional-sample-freq 88200 ;
+: telephone-sample-freq ( -- n ) 8000 ;
+: half-sample-freq ( -- n ) 22050 ;
+: cd-sample-freq ( -- n ) 44100 ;
+: digital-sample-freq ( -- n ) 48000 ;
+: professional-sample-freq ( -- n ) 88200 ;

 : send-buffer ( buffer -- buffer )
    {
--- a/extra/synth/example/authors.txt
+++ b/extra/synth/example/authors.txt
@ -0,0 +1 @@
+Alex Chapman
--- a/unmaintained/synth/example/example.factor
+++ b/unmaintained/synth/example/example.factor
--- a/unmaintained/synth/summary.txt
+++ b/unmaintained/synth/summary.txt
--- a/unmaintained/synth/synth.factor
+++ b/unmaintained/synth/synth.factor
--- a/vm/data_gc.c
+++ b/vm/data_gc.c
@ -149,21 +149,23 @@ void copy_roots(void)
 	copy_registered_locals();
 	copy_stack_elements(extra_roots_region,extra_roots);

-	save_stacks();
-	F_CONTEXT *stacks = stack_chain;
-
-	while(stacks)
+	if(!performing_compaction)
 	{
-		copy_stack_elements(stacks->datastack_region,stacks->datastack);
-		copy_stack_elements(stacks->retainstack_region,stacks->retainstack);
+		save_stacks();
+		F_CONTEXT *stacks = stack_chain;

-		copy_handle(&stacks->catchstack_save);
-		copy_handle(&stacks->current_callback_save);
+		while(stacks)
+		{
+			copy_stack_elements(stacks->datastack_region,stacks->datastack);
+			copy_stack_elements(stacks->retainstack_region,stacks->retainstack);
+
+			copy_handle(&stacks->catchstack_save);
+			copy_handle(&stacks->current_callback_save);

-		if(!performing_compaction)
 			mark_active_blocks(stacks);

-		stacks = stacks->next;
+			stacks = stacks->next;
+		}
 	}

 	int i;