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

* 'master' of git://factorcode.org/git/factor: (73 commits) Fix ui.gadgets.scrollers unit tests Browser tool now saves scroll bar position in history Rename scroll word to set-scroll-position and make it public Rename scroll word to set-scroll-position and make it public Move models.history to extra Clear button in search field is now positioned correctly Fix prettyprint of CONSTANT: and ALIAS: Fix prettyprinting of URLs Fix alien unit tests Fixes for recent changes Fix mailbox-get-all, and make mailbox timeouts throw a wait-timeout error instead of a string Oops dead code Fixing this for Windows mason.test: check if boot image is out of date, and refuse to build if so Fix documentation for map-index Fix alien hashcode for expired aliens opengl.textures: pad image up to a power of 2 using glTexSubImage2D instead of doing it in Factor code Don't call glFlush, it's useless Simplify do-matrix Add hashcode method for simple-alien; improves performance of malloc and free ...
2009-04-06 00:52:15 -04:00 · 2009-04-06 00:52:15 -04:00 · 1546f4230b
parent 8201139dc7 cb6030778f
commit 1546f4230b
131 changed files with 2535 additions and 566 deletions
--- a/README.txt
+++ b/README.txt
@ -113,12 +113,6 @@ the command prompt using the console application:

  factor.com -i=boot.<cpu>.image

-Before bootstrapping, you will need to download the DLLs for the Pango
-text rendering library. The required DLLs are listed in
-build-support/dlls.txt and are available from the following location:
-
-  <http://factorcode.org/dlls>
-
 Once bootstrapped, double-clicking factor.exe or factor.com starts
 the Factor UI.

--- a/basis/alien/destructors/destructors.factor
+++ b/basis/alien/destructors/destructors.factor
@ -1,6 +1,7 @@
 ! Copyright (C) 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: functors destructors accessors kernel parser words ;
+USING: functors destructors accessors kernel parser words
+effects generalizations sequences ;
 IN: alien.destructors

 SLOT: alien
@ -11,6 +12,7 @@ F-destructor DEFINES-CLASS ${F}-destructor
 <F-destructor> DEFINES <${F}-destructor>
 &F DEFINES &${F}
 |F DEFINES |${F}
+N [ F stack-effect out>> length ]

 WHERE

@ -18,7 +20,7 @@ TUPLE: F-destructor alien disposed ;

 : <F-destructor> ( alien -- destructor ) f F-destructor boa ; inline

-M: F-destructor dispose* alien>> F ;
+M: F-destructor dispose* alien>> F N ndrop ;

 : &F ( alien -- alien ) dup <F-destructor> &dispose drop ; inline

--- a/basis/combinators/smart/smart.factor
+++ b/basis/combinators/smart/smart.factor
@ -4,6 +4,9 @@ USING: accessors fry generalizations kernel macros math.order
 stack-checker math ;
 IN: combinators.smart

+MACRO: drop-outputs ( quot -- quot' )
+    dup infer out>> '[ @ _ ndrop ] ;
+
 MACRO: output>sequence ( quot exemplar -- newquot )
    [ dup infer out>> ] dip
    '[ @ _ _ nsequence ] ;
--- a/basis/concurrency/conditions/conditions.factor
+++ b/basis/concurrency/conditions/conditions.factor
@ -20,10 +20,12 @@ IN: concurrency.conditions
        ]
    ] dip later ;

+ERROR: wait-timeout ;
+
 : wait ( queue timeout status -- )
    over [
        [ queue-timeout [ drop ] ] dip suspend
-        [ "Timeout" throw ] [ cancel-alarm ] if
+        [ wait-timeout ] [ cancel-alarm ] if
    ] [
        [ drop '[ _ push-front ] ] dip suspend drop
    ] if ;
--- a/basis/concurrency/mailboxes/mailboxes-tests.factor
+++ b/basis/concurrency/mailboxes/mailboxes-tests.factor
@ -1,6 +1,6 @@
 IN: concurrency.mailboxes.tests
-USING: concurrency.mailboxes concurrency.count-downs vectors
-sequences threads tools.test math kernel strings namespaces
+USING: concurrency.mailboxes concurrency.count-downs concurrency.conditions
+vectors sequences threads tools.test math kernel strings namespaces
 continuations calendar destructors ;

 { 1 1 } [ [ integer? ] mailbox-get? ] must-infer-as
@ -75,3 +75,15 @@ continuations calendar destructors ;
 [ ] [ "d" get 5 seconds await-timeout ] unit-test

 [ ] [ "m" get dispose ] unit-test
+
+[ { "foo" "bar" } ] [
+    <mailbox>
+    "foo" over mailbox-put
+    "bar" over mailbox-put
+    mailbox-get-all
+] unit-test
+
+[
+    <mailbox> 1 seconds mailbox-get-timeout
+] [ wait-timeout? ] must-fail-with
+    
--- a/basis/concurrency/mailboxes/mailboxes.factor
+++ b/basis/concurrency/mailboxes/mailboxes.factor
@ -49,7 +49,7 @@ M: mailbox dispose* threads>> notify-all ;

 : mailbox-get-all-timeout ( mailbox timeout -- array )
    block-if-empty
-    [ dup mailbox-empty? ]
+    [ dup mailbox-empty? not ]
    [ dup data>> pop-back ]
    produce nip ;

--- a/basis/core-graphics/core-graphics-docs.factor
+++ b/basis/core-graphics/core-graphics-docs.factor
--- a/basis/help/html/html.factor
+++ b/basis/help/html/html.factor
@ -60,7 +60,7 @@ M: topic url-of topic>filename ;
 : help>html ( topic -- xml )
    [ article-title ]
    [ drop help-stylesheet ]
-    [ [ help ] with-html-writer ]
+    [ [ print-topic ] with-html-writer ]
    tri simple-page ;
          
 : generate-help-file ( topic -- )
--- a/basis/help/tips/tips-docs.factor
+++ b/basis/help/tips/tips-docs.factor
@ -1,6 +1,6 @@
 IN: help.tips
 USING: help.markup help.syntax debugger prettyprint see help help.vocabs
-help.apropos tools.time stack-checker editors ;
+help.apropos tools.time stack-checker editors memory ;

 TIP: "To look at the most recent error, run " { $link :error } ". To look at the most recent error's callstack, run " { $link :c } "." ;

@ -20,7 +20,9 @@ TIP: "Power tools: " { $links see edit help about apropos time infer. } ;

 TIP: "Tips of the day implement the " { $link "definition-protocol" } " and new tips of the day can be defined using the " { $link POSTPONE: TIP: } " parsing word." ;

-TIP: "Try some simple demo applications, then look at the source code in " { $snippet "extra/" } ": " { $code "\"demos\" run" } ;
+TIP: "Try some simple demo applications, then look at the source code in " { $snippet "extra/" } ": " { $snippet "\"demos\" run" } ;
+
+TIP: "To save time on reloading big libraries such as the " { $vocab-link "furnace" } " web framework, save the image after loading them using the " { $link save } " word." ;

 HELP: TIP:
 { $syntax "TIP: content ;" }
--- a/basis/images/images.factor
+++ b/basis/images/images.factor
@ -1,11 +1,13 @@
 ! Copyright (C) 2009 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: combinators kernel ;
+USING: combinators kernel accessors ;
 IN: images

 SINGLETONS: L BGR RGB BGRA RGBA ABGR ARGB RGBX XRGB BGRX XBGR
 R16G16B16 R32G32B32 R16G16B16A16 R32G32B32A32 ;

+UNION: alpha-channel BGRA RGBA ABGR ARGB R16G16B16A16 R32G32B32A32 ;
+
 : bytes-per-pixel ( component-order -- n )
    {
        { L [ 1 ] }
@ -29,4 +31,6 @@ TUPLE: image dim component-order upside-down? bitmap ;

 : <image> ( -- image ) image new ; inline

+: has-alpha? ( image -- ? ) component-order>> alpha-channel? ;
+
 GENERIC: load-image* ( path tuple -- image )
--- a/basis/images/normalization/normalization.factor
+++ b/basis/images/normalization/normalization.factor
@ -61,6 +61,18 @@ M: ARGB normalize-component-order*
 M: ABGR normalize-component-order*
    drop ARGB>RGBA BGRA>RGBA ;

+: fix-XBGR ( bitmap -- bitmap' )
+    dup 4 <sliced-groups> [ [ 255 0 ] dip set-nth ] each ;
+
+M: XBGR normalize-component-order*
+    drop fix-XBGR ABGR normalize-component-order* ;
+
+: fix-BGRX ( bitmap -- bitmap' )
+    dup 4 <sliced-groups> [ [ 255 3 ] dip set-nth ] each ;
+
+M: BGRX normalize-component-order*
+    drop fix-BGRX BGRA normalize-component-order* ;
+
 : normalize-scan-line-order ( image -- image )
    dup upside-down?>> [
        dup dim>> first 4 * '[
--- a/basis/math/functions/functions.factor
+++ b/basis/math/functions/functions.factor
@ -111,7 +111,7 @@ PRIVATE>
 : lcm ( a b -- c )
    [ * ] 2keep gcd nip /i ; foldable

-: divisor? ( x y -- ? )
+: divisor? ( m n -- ? )
    mod 0 = ;

 : mod-inv ( x n -- y )
--- a/basis/models/models-docs.factor
+++ b/basis/models/models-docs.factor
@ -133,7 +133,6 @@ $nl
 { $subsection "models-impl" }
 { $subsection "models.arrow" }
 { $subsection "models.product" }
-{ $subsection "models-history" }
 { $subsection "models-range" }
 { $subsection "models-delay" } ;

--- a/basis/opengl/opengl-docs.factor
+++ b/basis/opengl/opengl-docs.factor
@ -15,8 +15,8 @@ HELP: do-enabled
 { $description "Wraps a quotation in " { $link glEnable } "/" { $link glDisable } " calls." } ;

 HELP: do-matrix
-{ $values { "mode" { $link GL_MODELVIEW } " or " { $link GL_PROJECTION } } { "quot" quotation } }
-{ $description "Saves and restores the matrix specified by " { $snippet "mode" } " before and after calling the quotation." } ;
+{ $values { "quot" quotation } }
+{ $description "Saves and restores the current matrix before and after calling the quotation." } ;

 HELP: gl-line
 { $values { "a" "a pair of integers" } { "b" "a pair of integers" } }
--- a/basis/opengl/opengl.factor
+++ b/basis/opengl/opengl.factor
@ -44,9 +44,8 @@ MACRO: all-enabled ( seq quot -- )
 MACRO: all-enabled-client-state ( seq quot -- )
    [ words>values ] dip '[ _ _ (all-enabled-client-state) ] ;

-: do-matrix ( mode quot -- )
-    swap [ glMatrixMode glPushMatrix call ] keep
-    glMatrixMode glPopMatrix ; inline
+: do-matrix ( quot -- )
+    glPushMatrix call glPopMatrix ; inline

 : gl-material ( face pname params -- )
    float-array{ } like glMaterialfv ;
@ -165,7 +164,7 @@ MACRO: set-draw-buffers ( buffers -- )
 : delete-dlist ( id -- ) 1 glDeleteLists ;

 : with-translation ( loc quot -- )
-    GL_MODELVIEW [ [ gl-translate ] dip call ] do-matrix ; inline
+    [ [ gl-translate ] dip call ] do-matrix ; inline

 : fix-coordinates ( point1 point2 -- x1 y2 x2 y2 )
    [ first2 [ >fixnum ] bi@ ] bi@ ;
@ -177,6 +176,7 @@ MACRO: set-draw-buffers ( buffers -- )
    fix-coordinates glViewport ;

 : init-matrices ( -- )
+    #! Leaves with matrix mode GL_MODELVIEW
    GL_PROJECTION glMatrixMode
    glLoadIdentity
    GL_MODELVIEW glMatrixMode
--- a/basis/opengl/textures/textures-tests.factor
+++ b/basis/opengl/textures/textures-tests.factor
@ -5,56 +5,6 @@ opengl.textures.private images kernel namespaces accessors
 sequences ;
 IN: opengl.textures.tests

-[ ] [
-    T{ image
-       { dim { 3 5 } }
-       { component-order RGB }
-       { bitmap
-         B{
-             1 2 3 4 5 6 7 8 9
-             10 11 12 13 14 15 16 17 18
-             19 20 21 22 23 24 25 26 27
-             28 29 30 31 32 33 34 35 36
-             37 38 39 40 41 42 43 44 45
-         }
-       }
-    } "image" set
-] unit-test
-
-[
-    T{ image
-        { dim { 4 8 } }
-        { component-order RGB }
-        { bitmap
-          B{
-              1 2 3 4 5 6 7 8 9 7 8 9
-              10 11 12 13 14 15 16 17 18 16 17 18
-              19 20 21 22 23 24 25 26 27 25 26 27
-              28 29 30 31 32 33 34 35 36 34 35 36
-              37 38 39 40 41 42 43 44 45 43 44 45
-              37 38 39 40 41 42 43 44 45 43 44 45
-              37 38 39 40 41 42 43 44 45 43 44 45
-              37 38 39 40 41 42 43 44 45 43 44 45
-          }
-        }
-    }
-] [
-    "image" get power-of-2-image
-] unit-test
-
-[
-    T{ image
-       { dim { 0 0 } }
-       { component-order R32G32B32 }
-       { bitmap B{ } } }
-] [
-    T{ image
-       { dim { 0 0 } }
-       { component-order R32G32B32 }
-       { bitmap B{ } }
-    } power-of-2-image
-] unit-test
-
 [
    {
        { { 0 0 } { 10 0 } }
--- a/basis/opengl/textures/textures.factor
+++ b/basis/opengl/textures/textures.factor
@ -2,8 +2,8 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors assocs cache colors.constants destructors fry kernel
 opengl opengl.gl combinators images images.tesselation grouping
-specialized-arrays.float locals sequences math math.vectors
-math.matrices generalizations fry columns ;
+specialized-arrays.float sequences math math.vectors
+math.matrices generalizations fry arrays ;
 IN: opengl.textures

 : gen-texture ( -- id ) [ glGenTextures ] (gen-gl-object) ;
@ -17,60 +17,42 @@ M: BGR component-order>format drop GL_BGR GL_UNSIGNED_BYTE ;
 M: RGBA component-order>format drop GL_RGBA GL_UNSIGNED_BYTE ;
 M: ARGB component-order>format drop GL_BGRA_EXT GL_UNSIGNED_INT_8_8_8_8_REV ;
 M: BGRA component-order>format drop GL_BGRA_EXT GL_UNSIGNED_BYTE ;
+M: BGRX component-order>format drop GL_BGRA_EXT GL_UNSIGNED_BYTE ;

-GENERIC: draw-texture ( texture -- )
+SLOT: display-list
+
+: draw-texture ( texture -- ) display-list>> [ glCallList ] when* ;

 GENERIC: draw-scaled-texture ( dim texture -- )

 <PRIVATE

-TUPLE: single-texture loc dim texture-coords texture display-list disposed ;
+TUPLE: single-texture image dim loc texture-coords texture display-list disposed ;

-: repeat-last ( seq n -- seq' )
-    over peek pad-tail concat ;
+: (tex-image) ( image -- )
+    [ GL_TEXTURE_2D 0 GL_RGBA ] dip
+    [ dim>> first2 [ next-power-of-2 ] bi@ 0 ]
+    [ component-order>> component-order>format f ] bi
+    glTexImage2D ;

-: power-of-2-bitmap ( rows dim size -- bitmap dim )
-    '[
-        first2
-        [ [ _ ] dip '[ _ group _ repeat-last ] map ]
-        [ repeat-last ]
-        bi*
-    ] keep ;
+: (tex-sub-image) ( image -- )
+    [ GL_TEXTURE_2D 0 0 0 ] dip
+    [ dim>> first2 ] [ component-order>> component-order>format ] [ bitmap>> ] tri
+    glTexSubImage2D ;

-: image-rows ( image -- rows )
-    [ bitmap>> ]
-    [ dim>> first ]
-    [ component-order>> bytes-per-pixel ]
-    tri * group ; inline
-
-: power-of-2-image ( image -- image )
-    dup dim>> [ 0 = ] all? [
-        clone dup
-        [ image-rows ]
-        [ dim>> [ next-power-of-2 ] map ]
-        [ component-order>> bytes-per-pixel ] tri
-        power-of-2-bitmap
-        [ >>bitmap ] [ >>dim ] bi*
-    ] unless ;
-
-:: make-texture ( image -- id )
+: make-texture ( image -- id )
+    #! We use glTexSubImage2D to work around the power of 2 texture size
+    #! limitation
    gen-texture [
        GL_TEXTURE_BIT [
            GL_TEXTURE_2D swap glBindTexture
-            GL_TEXTURE_2D
-            0
-            GL_RGBA
-            image dim>> first2
-            0
-            image component-order>> component-order>format
-            image bitmap>>
-            glTexImage2D
+            [ (tex-image) ] [ (tex-sub-image) ] bi
        ] do-attribs
    ] keep ;

 : init-texture ( -- )
-    GL_TEXTURE_2D GL_TEXTURE_MAG_FILTER GL_LINEAR glTexParameteri
-    GL_TEXTURE_2D GL_TEXTURE_MIN_FILTER GL_LINEAR glTexParameteri
+    GL_TEXTURE_2D GL_TEXTURE_MAG_FILTER GL_NEAREST glTexParameteri
+    GL_TEXTURE_2D GL_TEXTURE_MIN_FILTER GL_NEAREST glTexParameteri
    GL_TEXTURE_2D GL_TEXTURE_WRAP_S GL_REPEAT glTexParameteri
    GL_TEXTURE_2D GL_TEXTURE_WRAP_T GL_REPEAT glTexParameteri ;

@ -92,26 +74,29 @@ TUPLE: single-texture loc dim texture-coords texture display-list disposed ;

 : draw-textured-rect ( dim texture -- )
    [
-        (draw-textured-rect)
-        GL_TEXTURE_2D 0 glBindTexture
+        [ image>> has-alpha? [ GL_BLEND glDisable ] unless ]
+        [ (draw-textured-rect) GL_TEXTURE_2D 0 glBindTexture ]
+        [ image>> has-alpha? [ GL_BLEND glEnable ] unless ]
+        tri
    ] with-texturing ;

-: texture-coords ( dim -- coords )
-    [ dup next-power-of-2 /f ] map
-    { { 0 0 } { 1 0 } { 1 1 } { 0 1 } } [ v* ] with map
-    float-array{ } join ;
+: texture-coords ( texture -- coords )
+    [ [ dim>> ] [ image>> dim>> [ next-power-of-2 ] map ] bi v/ ]
+    [
+        image>> upside-down?>>
+        { { 0 1 } { 1 1 } { 1 0 } { 0 0 } }
+        { { 0 0 } { 1 0 } { 1 1 } { 0 1 } } ?
+    ] bi
+    [ v* ] with map float-array{ } join ;

 : make-texture-display-list ( texture -- dlist )
    GL_COMPILE [ [ dim>> ] keep draw-textured-rect ] make-dlist ;

 : <single-texture> ( image loc -- texture )
-   single-texture new swap >>loc
-    swap
-    [ dim>> >>dim ] keep
-    [ dim>> product 0 = ] keep '[
-        _
-        [ dim>> texture-coords >>texture-coords ]
-        [ power-of-2-image make-texture >>texture ] bi
+    single-texture new swap >>loc swap [ >>image ] [ dim>> >>dim ] bi
+    dup image>> dim>> product 0 = [
+        dup texture-coords >>texture-coords
+        dup image>> make-texture >>texture
        dup make-texture-display-list >>display-list
    ] unless ;

@ -119,15 +104,13 @@ M: single-texture dispose*
    [ texture>> [ delete-texture ] when* ]
    [ display-list>> [ delete-dlist ] when* ] bi ;

-M: single-texture draw-texture display-list>> [ glCallList ] when* ;
-
 M: single-texture draw-scaled-texture
    dup texture>> [ draw-textured-rect ] [ 2drop ] if ;

 TUPLE: multi-texture grid display-list loc disposed ;

 : image-locs ( image-grid -- loc-grid )
-    [ first [ dim>> first ] map ] [ 0 <column> [ dim>> second ] map ] bi
+    [ first [ dim>> first ] map ] [ [ first dim>> second ] map ] bi
    [ 0 [ + ] accumulate nip ] bi@
    cross-zip flip ;

@ -138,14 +121,15 @@ TUPLE: multi-texture grid display-list loc disposed ;
 : draw-textured-grid ( grid -- )
    [ [ [ dim>> ] keep (draw-textured-rect) ] each ] each ;

+: grid-has-alpha? ( grid -- ? )
+    first first image>> has-alpha? ;
+
 : make-textured-grid-display-list ( grid -- dlist )
    GL_COMPILE [
        [
-            [
-                [
-                    [ dim>> ] keep (draw-textured-rect)
-                ] each
-            ] each
+            [ grid-has-alpha? [ GL_BLEND glDisable ] unless ]
+            [ [ [ [ dim>> ] keep (draw-textured-rect) ] each ] each ]
+            [ grid-has-alpha? [ GL_BLEND glEnable ] unless ] tri
            GL_TEXTURE_2D 0 glBindTexture
        ] with-texturing
    ] make-dlist ;
@ -159,11 +143,9 @@ TUPLE: multi-texture grid display-list loc disposed ;
        f multi-texture boa
    ] with-destructors ;

-M: multi-texture draw-texture display-list>> [ glCallList ] when* ;
-
 M: multi-texture dispose* grid>> [ [ dispose ] each ] each ;

-CONSTANT: max-texture-size { 256 256 }
+CONSTANT: max-texture-size { 512 512 }

 PRIVATE>

--- a/basis/pack/pack.factor
+++ b/basis/pack/pack.factor
@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: alien alien.c-types arrays assocs byte-arrays io
 io.binary io.streams.string kernel math math.parser namespaces
-make parser prettyprint quotations sequences strings vectors
+make parser quotations sequences strings vectors
 words macros math.functions math.bitwise fry generalizations
 combinators.smart io.streams.byte-array io.encodings.binary
 math.vectors combinators multiline endian ;
--- a/basis/see/see-tests.factor
+++ b/basis/see/see-tests.factor
@ -0,0 +1,11 @@
+IN: see.tests
+USING: see tools.test io.streams.string math ;
+
+CONSTANT: test-const 10
+[ "IN: see.tests\nCONSTANT: test-const 10 inline\n" ]
+[ [ \ test-const see ] with-string-writer ] unit-test
+
+ALIAS: test-alias +
+
+[ "USING: math ;\nIN: see.tests\nALIAS: test-alias + inline\n" ]
+[ [ \ test-alias see ] with-string-writer ] unit-test
--- a/basis/see/see.factor
+++ b/basis/see/see.factor
@ -7,7 +7,7 @@ definitions effects generic generic.standard io io.pathnames
 io.streams.string io.styles kernel make namespaces prettyprint
 prettyprint.backend prettyprint.config prettyprint.custom
 prettyprint.sections sequences sets sorting strings summary
-words words.symbol ;
+words words.symbol words.constant words.alias ;
 IN: see

 GENERIC: synopsis* ( defspec -- )
@ -29,8 +29,16 @@ GENERIC: see* ( defspec -- )
 : comment. ( text -- )
    H{ { font-style italic } } styled-text ;

+GENERIC: print-stack-effect? ( word -- ? )
+
+M: parsing-word print-stack-effect? drop f ;
+M: symbol print-stack-effect? drop f ;
+M: constant print-stack-effect? drop f ;
+M: alias print-stack-effect? drop f ;
+M: word print-stack-effect? drop t ;
+
 : stack-effect. ( word -- )
-    [ [ parsing-word? ] [ symbol? ] bi or not ] [ stack-effect ] bi and
+    [ print-stack-effect? ] [ stack-effect ] bi and
    [ effect>string comment. ] when* ;

 <PRIVATE
--- a/basis/sorting/functor/authors.txt
+++ b/basis/sorting/functor/authors.txt
@ -0,0 +1 @@
+Doug Coleman
--- a/basis/sorting/functor/functor.factor
+++ b/basis/sorting/functor/functor.factor
@ -0,0 +1,16 @@
+! Copyright (C) 2009 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: functors kernel math.order sequences sorting ;
+IN: sorting.functor
+
+FUNCTOR: define-sorting ( NAME QUOT -- )
+
+NAME<=> DEFINES ${NAME}<=>
+NAME>=< DEFINES ${NAME}>=<
+
+WHERE
+
+: NAME<=> ( obj1 obj2 -- <=> ) QUOT bi@ <=> ;
+: NAME>=< ( obj1 obj2 -- >=< ) NAME<=> invert-comparison ;
+
+;FUNCTOR
--- a/basis/sorting/human/human-docs.factor
+++ b/basis/sorting/human/human-docs.factor
@ -25,46 +25,11 @@ HELP: human>=<
 }
 { $description "Compares two objects using the " { $link human<=> } " word and inverts the result." } ;

-HELP: human-compare
-{ $values
-     { "obj1" object } { "obj2" object } { "quot" quotation }
-     { "<=>" "an ordering specifier" }
-}
-{ $description "Compares the results of applying the quotation to both objects via <=>." } ;
-
-HELP: human-sort
-{ $values
-     { "seq" sequence }
-     { "seq'" sequence }
-}
-{ $description "Sorts a sequence of objects by comparing the magnitude of any integers in the input string using the <=> word." } ;
-
-HELP: human-sort-keys
-{ $values
-     { "seq" "an alist" }
-     { "sortedseq" "a new sorted sequence" }
-}
-{ $description "Sorts the elements comparing first elements of pairs using the " { $link human<=> } " word." } ;
-
-HELP: human-sort-values
-{ $values
-     { "seq" "an alist" }
-     { "sortedseq" "a new sorted sequence" }
-}
-{ $description "Sorts the elements comparing second elements of pairs using the " { $link human<=> } " word." } ;
-
-{ <=> >=< human-compare human-sort human-sort-keys human-sort-values } related-words
-
 ARTICLE: "sorting.human" "Human-friendly sorting"
 "The " { $vocab-link "sorting.human" } " vocabulary sorts by numbers as a human would -- by comparing their magnitudes -- rather than in a lexicographic way. For example, sorting a1, a10, a03, a2 with human sort returns a1, a2, a03, a10, while sorting with natural sort returns a03, a1, a10, a2." $nl
 "Comparing two objects:"
 { $subsection human<=> }
 { $subsection human>=< }
-{ $subsection human-compare }
-"Sort a sequence:"
-{ $subsection human-sort }
-{ $subsection human-sort-keys }
-{ $subsection human-sort-values }
 "Splitting a string into substrings and integers:"
 { $subsection find-numbers } ;

--- a/basis/sorting/human/human-tests.factor
+++ b/basis/sorting/human/human-tests.factor
@ -1,6 +1,4 @@
-USING: sorting.human tools.test ;
+USING: sorting.human tools.test sorting.slots ;
 IN: sorting.human.tests

-\ human-sort must-infer
-
-[ { "x1y" "x2" "x10y" } ] [ { "x1y" "x10y" "x2" } human-sort ] unit-test
+[ { "x1y" "x2" "x10y" } ] [ { "x1y" "x10y" "x2" } { human<=> } sort-by ] unit-test
--- a/basis/sorting/human/human.factor
+++ b/basis/sorting/human/human.factor
@ -1,22 +1,9 @@
 ! Copyright (C) 2008 Doug Coleman, Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: peg.ebnf math.parser kernel assocs sorting fry
-math.order sequences ascii splitting.monotonic ;
+USING: math.parser peg.ebnf sorting.functor ;
 IN: sorting.human

 : find-numbers ( string -- seq )
    [EBNF Result = ([0-9]+ => [[ string>number ]] | (!([0-9]) .)+)* EBNF] ;

-: human<=> ( obj1 obj2 -- <=> ) [ find-numbers ] bi@ <=> ;
-
-: human>=< ( obj1 obj2 -- >=< ) human<=> invert-comparison ; inline
-
-: human-compare ( obj1 obj2 quot -- <=> ) bi@ human<=> ; inline
-
-: human-sort ( seq -- seq' ) [ human<=> ] sort ;
-
-: human-sort-keys ( seq -- sortedseq )
-    [ [ first ] human-compare ] sort ;
-
-: human-sort-values ( seq -- sortedseq )
-    [ [ second ] human-compare ] sort ;
+<< "human" [ find-numbers ] define-sorting >>
--- a/basis/sorting/slots/slots-docs.factor
+++ b/basis/sorting/slots/slots-docs.factor
@ -14,7 +14,7 @@ HELP: compare-slots
 HELP: sort-by-slots
 { $values
     { "seq" sequence } { "sort-specs" "a sequence of accessors ending with a comparator" }
-     { "seq'" sequence }
+     { "sortedseq" sequence }
 }
 { $description "Sorts a sequence of tuples by the sort-specs in " { $snippet "sort-spec" } ". A sort-spec is a sequence of slot accessors ending in a comparator." }
 { $examples
@ -39,11 +39,20 @@ HELP: split-by-slots
 }
 { $description "Splits a sequence of tuples into a sequence of slices of tuples that have the same values in all slots in the accessor sequence. This word is only useful for splitting a sorted sequence, but is more efficient than partitioning in such a case." } ;

+HELP: sort-by
+{ $values
+    { "seq" sequence } { "sort-seq" "a sequence of comparators" }
+    { "sortedseq" sequence }
+}
+{ $description "Sorts a sequence by comparing elements by comparators, using subsequent comparators when there is a tie." } ;
+
 ARTICLE: "sorting.slots" "Sorting by slots"
 "The " { $vocab-link "sorting.slots" } " vocabulary can sort tuples by slot in ascending or descending order, using subsequent slots as tie-breakers." $nl
 "Comparing two objects by a sequence of slots:"
 { $subsection compare-slots }
-"Sorting a sequence by a sequence of slots:"
-{ $subsection sort-by-slots } ;
+"Sorting a sequence of tuples by a slot/comparator pairs:"
+{ $subsection sort-by-slots }
+"Sorting a sequence by a sequence of comparators:"
+{ $subsection sort-by } ;

 ABOUT: "sorting.slots"
--- a/basis/sorting/slots/slots-tests.factor
+++ b/basis/sorting/slots/slots-tests.factor
@ -1,7 +1,8 @@
 ! Copyright (C) 2009 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors math.order sorting.slots tools.test
-sorting.human arrays sequences kernel assocs multiline ;
+sorting.human arrays sequences kernel assocs multiline
+sorting.functor ;
 IN: sorting.literals.tests

 TUPLE: sort-test a b c tuple2 ;
@ -76,6 +77,9 @@ TUPLE: tuple2 d ;
 [ { } ]
 [ { } { { a>> <=> } { b>> >=< } { c>> <=> } } sort-by-slots ] unit-test

+[ { } ]
+[ { } { } sort-by-slots ] unit-test
+
 [
    {
        T{ sort-test { a 6 } { tuple2 T{ tuple2 { d 1 } } } }
@ -143,3 +147,15 @@ TUPLE: tuple2 d ;
        T{ sort-test { a 5 } { tuple2 T{ tuple2 { d 4 } } } }
    } { { tuple2>> d>> } { a>> } } split-by-slots [ >array ] map
 ] unit-test
+
+
+[ { "a" "b" "c" } ] [ { "b" "c" "a" } { <=> <=> } sort-by ] unit-test
+[ { "b" "c" "a" } ] [ { "b" "c" "a" } { } sort-by ] unit-test
+
+<< "length-test" [ length ] define-sorting >>
+
+[ { { 1 } { 1 2 3 } { 1 3 2 } { 3 2 1 } } ]
+[
+    { { 3 2 1 } { 1 2 3 } { 1 3 2 } { 1 } }
+    { length-test<=> <=> } sort-by
+] unit-test
--- a/basis/sorting/slots/slots.factor
+++ b/basis/sorting/slots/slots.factor
@ -7,13 +7,16 @@ IN: sorting.slots

 <PRIVATE

+: short-circuit-comparator ( obj1 obj2 word --  comparator/? )
+    execute dup +eq+ eq? [ drop f ] when ; inline
+
 : slot-comparator ( seq -- quot )
    [
        but-last-slice
        [ '[ [ _ execute ] bi@ ] ] map concat
    ] [
        peek
-        '[ @ _ execute dup +eq+ eq? [ drop f ] when ]
+        '[ @ _ short-circuit-comparator ]
    ] bi ;

 PRIVATE>
@ -22,8 +25,20 @@ MACRO: compare-slots ( sort-specs -- <=> )
    #! sort-spec: { accessors comparator }
    [ slot-comparator ] map '[ _ 2|| +eq+ or ] ;

-: sort-by-slots ( seq sort-specs -- seq' )
-    '[ _ compare-slots ] sort ;
+MACRO: sort-by-slots ( sort-specs -- quot )
+    '[ [ _ compare-slots ] sort ] ;
+
+MACRO: compare-seq ( seq -- quot )
+    [ '[ _ short-circuit-comparator ] ] map '[ _ 2|| +eq+ or ] ;
+
+MACRO: sort-by ( sort-seq -- quot )
+    '[ [ _ compare-seq ] sort ] ;
+
+MACRO: sort-keys-by ( sort-seq -- quot )
+    '[ [ first ] bi@ _ compare-seq ] sort ;
+
+MACRO: sort-values-by ( sort-seq -- quot )
+    '[ [ second ] bi@ _ compare-seq ] sort ;

 MACRO: split-by-slots ( accessor-seqs -- quot )
    [ [ '[ [ _ execute ] bi@ ] ] map concat [ = ] compose ] map
--- a/basis/sorting/title/authors.txt
+++ b/basis/sorting/title/authors.txt
@ -0,0 +1 @@
+Doug Coleman
--- a/basis/sorting/title/title-tests.factor
+++ b/basis/sorting/title/title-tests.factor
@ -0,0 +1,40 @@
+! Copyright (C) 2009 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: tools.test sorting.title sorting.slots ;
+IN: sorting.title.tests
+
+: sort-me ( -- seq )
+    {
+        "The Beatles"
+        "A river runs through it"
+        "Another"
+        "la vida loca"
+        "Basketball"
+        "racquetball"
+        "Los Fujis"
+        "los Fujis"
+        "La cucaracha"
+        "a day to remember"
+        "of mice and men"
+        "on belay"
+        "for the horde"
+    } ;
+[
+    {
+        "Another"
+        "Basketball"
+        "The Beatles"
+        "La cucaracha"
+        "a day to remember"
+        "for the horde"
+        "Los Fujis"
+        "los Fujis"
+        "of mice and men"
+        "on belay"
+        "racquetball"
+        "A river runs through it"
+        "la vida loca"
+    }
+] [
+    sort-me { title<=> } sort-by
+] unit-test
--- a/basis/sorting/title/title.factor
+++ b/basis/sorting/title/title.factor
@ -0,0 +1,7 @@
+! Copyright (C) 2009 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: sorting.functor regexp kernel accessors sequences
+unicode.case ;
+IN: sorting.title
+
+<< "title" [ >lower dup R/ ^(the|a|an|el|la|los|las|il) / first-match [ to>> tail-slice ] when* ] define-sorting >>
--- a/basis/stack-checker/known-words/known-words.factor
+++ b/basis/stack-checker/known-words/known-words.factor
@ -605,6 +605,8 @@ M: object infer-call*

 \ fflush { alien } { } define-primitive

+\ fseek { alien integer integer } { } define-primitive
+
 \ fclose { alien } { } define-primitive

 \ <wrapper> { object } { wrapper } define-primitive
--- a/basis/tools/deploy/macosx/macosx.factor
+++ b/basis/tools/deploy/macosx/macosx.factor
@ -42,11 +42,12 @@ IN: tools.deploy.macosx

 : create-app-dir ( vocab bundle-name -- vm )
    [
-        nip
-        [ copy-dll ]
-        [ copy-nib ]
-        [ "Contents/Resources" append-path make-directories ]
-        tri
+        nip {
+            [ copy-dll ]
+            [ copy-nib ]
+            [ "Contents/Resources" append-path make-directories ]
+            [ "Contents/Resources" copy-theme ]
+        } cleave
    ]
    [ create-app-plist ]
    [ "Contents/MacOS/" append-path copy-vm ] 2tri
--- a/basis/tools/deploy/shaker/shaker.factor
+++ b/basis/tools/deploy/shaker/shaker.factor
@ -157,7 +157,8 @@ IN: tools.deploy.shaker
                "specializer"
                "step-into"
                "step-into?"
-                "superclass"
+                ! UI needs this
+                ! "superclass"
                "transform-n"
                "transform-quot"
                "tuple-dispatch-generic"
@ -276,7 +277,6 @@ IN: tools.deploy.shaker
                lexer-factory
                print-use-hook
                root-cache
-                vocab-roots
                vocabs:dictionary
                vocabs:load-vocab-hook
                word
--- a/basis/tools/deploy/windows/windows.factor
+++ b/basis/tools/deploy/windows/windows.factor
@ -9,11 +9,6 @@ IN: tools.deploy.windows
 : copy-dll ( bundle-name -- )
    "resource:factor.dll" swap copy-file-into ;

-: copy-pango ( bundle-name -- )
-    "resource:build-support/dlls.txt" ascii file-lines
-    [ "resource:" prepend-path ] map
-    swap copy-files-into ;
-
 :: copy-vm ( executable bundle-name extension -- vm )
    vm "." split1-last drop extension append
    bundle-name executable ".exe" append append-path
@ -22,9 +17,7 @@ IN: tools.deploy.windows
 : create-exe-dir ( vocab bundle-name -- vm )
    dup copy-dll
    deploy-ui? get [
-        [ copy-pango ]
-        [ "" copy-theme ]
-        [ ".exe" copy-vm ] tri
+        [ "" copy-theme ] [ ".exe" copy-vm ] bi
    ] [ ".com" copy-vm ] if ;

 M: winnt deploy*
--- a/basis/ui/backend/backend.factor
+++ b/basis/ui/backend/backend.factor
@ -29,6 +29,6 @@ HOOK: offscreen-pixels ui-backend ( world -- alien w h )

 : with-gl-context ( handle quot -- )
    swap [ select-gl-context call ] keep
-    glFlush flush-gl-context gl-error ; inline
+    flush-gl-context gl-error ; inline

 HOOK: (with-ui) ui-backend ( quot -- )
--- a/basis/ui/backend/windows/windows.factor
+++ b/basis/ui/backend/windows/windows.factor
@ -1,16 +1,16 @@
 ! Copyright (C) 2005, 2006 Doug Coleman.
 ! Portions copyright (C) 2007, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien alien.c-types alien.strings arrays assocs ui
-ui.private ui.gadgets ui.gadgets.private ui.backend
-ui.clipboards ui.gadgets.worlds ui.gestures ui.event-loop io
-kernel math math.vectors namespaces make sequences strings
-vectors words windows.kernel32 windows.gdi32 windows.user32
-windows.opengl32 windows.messages windows.types windows.nt
-windows threads libc combinators fry combinators.short-circuit
-continuations command-line shuffle opengl ui.render ascii
-math.bitwise locals accessors math.rectangles math.order ascii
-calendar io.encodings.utf16n ;
+USING: alien alien.c-types alien.strings arrays assocs ui ui.private
+ui.gadgets ui.gadgets.private ui.backend ui.clipboards
+ui.gadgets.worlds ui.gestures ui.event-loop io kernel math
+math.vectors namespaces make sequences strings vectors words
+windows.kernel32 windows.gdi32 windows.user32 windows.opengl32
+windows.messages windows.types windows.offscreen windows.nt windows
+threads libc combinators fry combinators.short-circuit continuations
+command-line shuffle opengl ui.render ascii math.bitwise locals
+accessors math.rectangles math.order ascii calendar
+io.encodings.utf16n ;
 IN: ui.backend.windows

 SINGLETON: windows-ui-backend
@ -433,12 +433,7 @@ M: windows-ui-backend do-events
    style 0 ex-style AdjustWindowRectEx win32-error=0/f ;

 : make-RECT ( world -- RECT )
-    [ window-loc>> dup ] [ dim>> ] bi v+
-    "RECT" <c-object>
-    over first over set-RECT-right
-    swap second over set-RECT-bottom
-    over first over set-RECT-left
-    swap second over set-RECT-top ;
+    [ window-loc>> ] [ dim>> ] bi <RECT> ;

 : default-position-RECT ( RECT -- )
    dup get-RECT-dimensions [ 2drop ] 2dip
@ -501,35 +496,12 @@ M: windows-ui-backend (open-window) ( world -- )
    hWnd>> show-window ;

 M: win-base select-gl-context ( handle -- )
-    [ hDC>> ] keep hRC>> wglMakeCurrent win32-error=0/f
+    [ hDC>> ] [ hRC>> ] bi wglMakeCurrent win32-error=0/f
    GdiFlush drop ;

 M: win-base flush-gl-context ( handle -- )
    hDC>> SwapBuffers win32-error=0/f ;

-: (bitmap-info) ( dim -- BITMAPINFO )
-    "BITMAPINFO" <c-object> [
-        BITMAPINFO-bmiHeader {
-            [ nip "BITMAPINFOHEADER" heap-size swap set-BITMAPINFOHEADER-biSize ]
-            [ [ first ] dip set-BITMAPINFOHEADER-biWidth ]
-            [ [ second ] dip set-BITMAPINFOHEADER-biHeight ]
-            [ nip 1 swap set-BITMAPINFOHEADER-biPlanes ]
-            [ nip 32 swap set-BITMAPINFOHEADER-biBitCount ]
-            [ nip BI_RGB swap set-BITMAPINFOHEADER-biCompression ]
-            [ [ first2 * 4 * ] dip set-BITMAPINFOHEADER-biSizeImage ]
-            [ nip 72 swap set-BITMAPINFOHEADER-biXPelsPerMeter ]
-            [ nip 72 swap set-BITMAPINFOHEADER-biYPelsPerMeter ]
-            [ nip 0 swap set-BITMAPINFOHEADER-biClrUsed ]
-            [ nip 0 swap set-BITMAPINFOHEADER-biClrImportant ]
-        } 2cleave
-    ] keep ;
-
-: make-offscreen-dc-and-bitmap ( dim -- hDC hBitmap bits )
-    f CreateCompatibleDC
-    dup rot (bitmap-info) DIB_RGB_COLORS f <void*>
-    [ f 0 CreateDIBSection ] keep *void*
-    [ 2dup SelectObject drop ] dip ;
-
 : setup-offscreen-gl ( dim -- hDC hRC hBitmap bits )
    make-offscreen-dc-and-bitmap [
        [ dup offscreen-pfd-dwFlags setup-pixel-format ]
@ -548,13 +520,12 @@ M: windows-ui-backend (close-offscreen-buffer) ( handle -- )
 ! each pixel; it's left as zero

 : (make-opaque) ( byte-array -- byte-array' )
-    [ length 4 / ]
+    [ length 4 /i ]
    [ '[ 255 swap 4 * 3 + _ set-nth ] each ]
    [ ] tri ;

 : (opaque-pixels) ( world -- pixels )
-    [ handle>> bits>> ] [ dim>> first2 * 4 * ] bi
-    memory>byte-array (make-opaque) ;
+    [ handle>> bits>> ] [ dim>> ] bi bitmap>byte-array (make-opaque) ;

 M: windows-ui-backend offscreen-pixels ( world -- alien w h )
    [ (opaque-pixels) ] [ dim>> first2 ] bi ;
--- a/basis/ui/gadgets/editors/editors.factor
+++ b/basis/ui/gadgets/editors/editors.factor
@ -141,7 +141,7 @@ M: editor ungraft*
 : scroll>caret ( editor -- )
    dup graft-state>> second [
        [
-            [ caret-loc ] [ caret-dim { 1 0 } v+ ] bi <rect>
+            [ caret-loc ] [ caret-dim { 2 1 } v+ ] bi <rect>
        ] keep scroll>rect
    ] [ drop ] if ;

--- a/basis/ui/gadgets/line-support/line-support.factor
+++ b/basis/ui/gadgets/line-support/line-support.factor
@ -30,6 +30,9 @@ M: line-gadget line-height font>> font-metrics height>> ceiling ;
 : validate-line ( m gadget -- n )
    control-value [ drop f ] [ length 1- min 0 max ] if-empty ;

+: valid-line? ( n gadget -- ? )
+    control-value length 1- 0 swap between? ;
+
 : visible-line ( gadget quot -- n )
    '[
        [ clip get @ origin get [ second ] bi@ - ] dip
--- a/basis/ui/gadgets/scrollers/scrollers-docs.factor
+++ b/basis/ui/gadgets/scrollers/scrollers-docs.factor
@ -11,11 +11,11 @@ HELP: find-scroller
 { $values { "gadget" gadget } { "scroller/f" { $maybe scroller } } }
 { $description "Finds the first parent of " { $snippet "gadget" } " which is a " { $link scroller } ". Outputs " { $link f } " if the gadget is not contained in a " { $link scroller } "." } ;

-HELP: scroller-value
+HELP: scroll-position
 { $values { "scroller" scroller } { "loc" "a pair of integers" } }
 { $description "Outputs the offset of the top-left corner of the scroller's " { $link viewport } "'s child." } ;

-{ scroller-value scroll scroll>bottom scroll>top scroll>rect } related-words
+{ scroll-position set-scroll-position scroll>bottom scroll>top scroll>rect } related-words

 HELP: <scroller>
 { $values { "gadget" gadget } { "scroller" "a new " { $link scroller } } }
@ -23,7 +23,7 @@ HELP: <scroller>

 { <viewport> <scroller> } related-words

-HELP: scroll
+HELP: set-scroll-position
 { $values { "scroller" scroller } { "value" "a pair of integers" } }
 { $description "Sets the offset of the top-left corner of the scroller's " { $link viewport } "'s child." } ;

@ -48,8 +48,8 @@ ARTICLE: "ui.gadgets.scrollers" "Scroller gadgets"
 { $subsection scroller }
 { $subsection <scroller> }
 "Getting and setting the scroll position:"
-{ $subsection scroller-value }
-{ $subsection scroll }
+{ $subsection scroll-position }
+{ $subsection set-scroll-position }
 "Writing scrolling-aware gadgets:"
 { $subsection scroll>bottom }
 { $subsection scroll>top }
--- a/basis/ui/gadgets/scrollers/scrollers-tests.factor
+++ b/basis/ui/gadgets/scrollers/scrollers-tests.factor
@ -45,13 +45,13 @@ IN: ui.gadgets.scrollers.tests

    [ { 100 100 } ] [ "s" get viewport>> gadget-child pref-dim ] unit-test

-    [ ] [ { 0 0 } "s" get scroll ] unit-test
+    [ ] [ { 0 0 } "s" get set-scroll-position ] unit-test

    [ { 0 0 } ] [ "s" get model>> range-min-value ] unit-test

    [ { 100 100 } ] [ "s" get model>> range-max-value ] unit-test

-    [ ] [ { 10 20 } "s" get scroll ] unit-test
+    [ ] [ { 10 20 } "s" get set-scroll-position ] unit-test

    [ { 10 20 } ] [ "s" get model>> range-value ] unit-test

@ -74,7 +74,7 @@ dup layout
        drop
        "g2" get scroll>gadget
        "s" get layout
-        "s" get scroller-value
+        "s" get scroll-position
    ] map [ { 0 0 } = ] all?
 ] unit-test

--- a/basis/ui/gadgets/scrollers/scrollers.factor
+++ b/basis/ui/gadgets/scrollers/scrollers.factor
@ -29,6 +29,13 @@ M: gadget viewport-column-header drop f ;

 : scroll-down-line ( scroller -- ) y>> 1 swap slide-by-line ;

+: set-scroll-position ( value scroller -- )
+    [
+        viewport>> [ dim>> { 0 0 } ] [ gadget-child pref-dim ] bi
+        4array flip
+    ] keep
+    2dup control-value = [ 2drop ] [ set-control-value ] if ;
+
 <PRIVATE

 : do-mouse-scroll ( scroller -- )
@ -46,21 +53,14 @@ scroller H{

 M: viewport pref-dim* gadget-child pref-viewport-dim ;

-: scroll ( value scroller -- )
-    [
-        viewport>> [ dim>> { 0 0 } ] [ gadget-child pref-dim ] bi
-        4array flip
-    ] keep
-    2dup control-value = [ 2drop ] [ set-control-value ] if ;
-
 : (scroll>rect) ( rect scroller -- )
-    [ [ loc>> ] [ dim>> { 1 1 } v+ ] bi <rect> ] dip
    {
-        [ scroller-value vneg offset-rect ]
+        [ scroll-position vneg offset-rect ]
        [ viewport>> dim>> rect-min ]
+        [ viewport>> loc>> offset-rect ]
        [ viewport>> [ v- { 0 0 } vmin ] [ v- { 0 0 } vmax ] with-rect-extents v+ ]
-        [ scroller-value v+ ]
-        [ scroll ]
+        [ scroll-position v+ ]
+        [ set-scroll-position ]
    } cleave ;

 : relative-scroll-rect ( rect gadget scroller -- newrect )
@ -72,7 +72,7 @@ M: viewport pref-dim* gadget-child pref-viewport-dim ;
    2&& ;

 : (update-scroller) ( scroller -- )
-    [ scroller-value ] keep scroll ;
+    [ scroll-position ] keep set-scroll-position ;

 : (scroll>gadget) ( gadget scroller -- )
    2dup swap child? [
@ -82,7 +82,8 @@ M: viewport pref-dim* gadget-child pref-viewport-dim ;
    ] [ f >>follows (update-scroller) drop ] if ;

 : (scroll>bottom) ( scroller -- )
-    [ viewport>> gadget-child pref-dim { 0 1 } v* ] keep scroll ;
+    [ viewport>> gadget-child pref-dim { 0 1 } v* ] keep
+    set-scroll-position ;

 GENERIC: update-scroller ( scroller follows -- )

--- a/basis/ui/gadgets/search-tables/search-tables-tests.factor
+++ b/basis/ui/gadgets/search-tables/search-tables-tests.factor
@ -0,0 +1,3 @@
+IN: ui.gadgets.search-tables.tests
+USING: ui.gadgets.search-tables sequences tools.test ;
+[ [ second ] <search-table> ] must-infer
--- a/basis/ui/gadgets/search-tables/search-tables.factor
+++ b/basis/ui/gadgets/search-tables/search-tables.factor
@ -28,6 +28,7 @@ TUPLE: search-field < track field ;

 : <search-field> ( model -- gadget )
    horizontal search-field new-track
+        0 >>fill
        { 5 5 } >>gap
        +baseline+ >>align
        swap <model-field> 10 >>min-cols >>field
--- a/basis/ui/gadgets/tables/tables.factor
+++ b/basis/ui/gadgets/tables/tables.factor
@ -268,12 +268,13 @@ M: table model-changed
 : mouse-row ( table -- n )
    [ hand-rel second ] keep y>line ;

+: if-mouse-row ( table true: ( table mouse-index -- ) false: ( table -- ) -- )
+    [ [ mouse-row ] keep 2dup valid-line? ]
+    [ ] [ '[ nip @ ] ] tri* if ; inline
+
 : table-button-down ( table -- )
    dup takes-focus?>> [ dup request-focus ] when
-    dup control-value empty? [ drop ] [
-        dup [ mouse-row ] keep validate-line
-        [ >>mouse-index ] [ (select-row) ] bi
-    ] if ;
+    [ swap [ >>mouse-index ] [ (select-row) ] bi ] [ drop ] if-mouse-row ;

 PRIVATE>

@ -283,11 +284,14 @@ PRIVATE>
    [ 2drop ]
    if ;

+: row-action? ( table -- ? )
+    [ [ mouse-row ] keep valid-line? ]
+    [ single-click?>> hand-click# get 2 = or ] bi and ;
+
 <PRIVATE

 : table-button-up ( table -- )
-    dup single-click?>> hand-click# get 2 = or
-    [ row-action ] [ update-selected-value ] if ;
+    dup row-action? [ row-action ] [ update-selected-value ] if ;

 : select-row ( table n -- )
    over validate-line
@ -320,13 +324,6 @@ PRIVATE>
 : next-page ( table -- )
    1 prev/next-page ;

-: valid-row? ( row table -- ? )
-    control-value length 1- 0 swap between? ;
-
-: if-mouse-row ( table true false -- )
-    [ [ mouse-row ] keep 2dup valid-row? ]
-    [ ] [ '[ nip @ ] ] tri* if ; inline
-
 : show-mouse-help ( table -- )
    [
        swap
--- a/basis/ui/gadgets/viewports/viewports.factor
+++ b/basis/ui/gadgets/viewports/viewports.factor
@ -23,7 +23,7 @@ M: viewport layout*
 M: viewport focusable-child*
    gadget-child ;

-: scroller-value ( scroller -- loc )
+: scroll-position ( scroller -- loc )
    model>> range-value [ >integer ] map ;

 M: viewport model-changed
@ -31,7 +31,7 @@ M: viewport model-changed
    [ relayout-1 ]
    [
        [ gadget-child ]
-        [ scroller-value vneg ]
+        [ scroll-position vneg ]
        [ constraint>> ]
        tri v* >>loc drop
    ] bi ;
--- a/basis/ui/images/images.factor
+++ b/basis/ui/images/images.factor
--- a/basis/ui/text/core-text/core-text.factor
+++ b/basis/ui/text/core-text/core-text.factor
@ -10,9 +10,6 @@ IN: ui.text.core-text

 SINGLETON: core-text-renderer

-M: core-text-renderer init-text-rendering
-    <cache-assoc> >>text-handle drop ;
-
 M: core-text-renderer string-dim
    [ " " string-dim { 0 1 } v* ]
    [ cached-line dim>> ]
@ -22,9 +19,9 @@ M: core-text-renderer flush-layout-cache
    cached-lines get purge-cache ;

 : rendered-line ( font string -- texture )
-    world get world-text-handle
-    [ cached-line [ image>> ] [ loc>> ] bi <texture> ]
-    2cache ;
+    world get world-text-handle [
+        cached-line [ image>> ] [ loc>> ] bi <texture>
+    ] 2cache ;

 M: core-text-renderer draw-string ( font string -- )
    rendered-line draw-texture ;
--- a/basis/ui/text/pango/pango.factor
+++ b/basis/ui/text/pango/pango.factor
@ -7,9 +7,6 @@ IN: ui.text.pango

 SINGLETON: pango-renderer

-M: pango-renderer init-text-rendering
-    <cache-assoc> >>text-handle drop ;
-
 M: pango-renderer string-dim
    [ " " string-dim { 0 1 } v* ]
    [ cached-layout logical-rect>> dim>> [ >integer ] map ] if-empty ;
@ -18,9 +15,9 @@ M: pango-renderer flush-layout-cache
    cached-layouts get purge-cache ;

 : rendered-layout ( font string -- texture )
-    world get world-text-handle
-    [ cached-layout [ image>> ] [ text-position vneg ] bi <texture> ]
-    2cache ;
+    world get world-text-handle [
+        cached-layout [ image>> ] [ text-position vneg ] bi <texture>
+    ] 2cache ;

 M: pango-renderer draw-string ( font string -- )
    rendered-layout draw-texture ;
--- a/basis/ui/text/pango/summary.txt
+++ b/basis/ui/text/pango/summary.txt
@ -0,0 +1 @@
+UI text rendering implementation using cross-platform Pango library
--- a/basis/ui/text/text-tests.factor
+++ b/basis/ui/text/text-tests.factor
@ -1,6 +1,22 @@
 ! Copyright (C) 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: tools.test ui.text fonts ;
+USING: tools.test ui.text fonts math accessors kernel sequences ;
 IN: ui.text.tests

-[ 0.0 ] [ 0 sans-serif-font "aaa" offset>x ] unit-test
+[ t ] [ 0 sans-serif-font "aaa" offset>x zero? ] unit-test
+[ t ] [ 1 sans-serif-font "aaa" offset>x 0.0 > ] unit-test
+[ t ] [ 3 sans-serif-font "aaa" offset>x 0.0 > ] unit-test
+[ t ] [ 1 monospace-font "a" offset>x 0.0 > ] unit-test
+[ 0 ] [ 0 sans-serif-font "aaa" x>offset ] unit-test
+[ 3 ] [ 100 sans-serif-font "aaa" x>offset ] unit-test
+[ 0 ] [ 0 sans-serif-font "" x>offset ] unit-test
+
+[ t ] [
+    sans-serif-font "aaa" line-metrics
+    [ [ ascent>> ] [ descent>> ] bi + ] [ height>> ] bi =
+] unit-test
+
+[ f ] [ sans-serif-font "\0a" text-dim first zero? ] unit-test
+[ t ] [ sans-serif-font "" text-dim first zero? ] unit-test
+
+[ f ] [ sans-serif-font font-metrics height>> zero? ] unit-test
--- a/basis/ui/text/text.factor
+++ b/basis/ui/text/text.factor
@ -1,17 +1,16 @@
 ! Copyright (C) 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel arrays sequences math math.order opengl opengl.gl
-strings fonts colors accessors namespaces ui.gadgets.worlds ;
+USING: kernel arrays sequences math math.order cache opengl
+opengl.gl strings fonts colors accessors namespaces
+ui.gadgets.worlds ;
 IN: ui.text

 <PRIVATE

 SYMBOL: font-renderer

-HOOK: init-text-rendering font-renderer ( world -- )
-
 : world-text-handle ( world -- handle )
-    dup text-handle>> [ dup init-text-rendering ] unless
+    dup text-handle>> [ <cache-assoc> >>text-handle ] unless
    text-handle>> ;

 HOOK: flush-layout-cache font-renderer ( -- )
@ -67,7 +66,7 @@ M: string draw-text draw-string ;
 M: selection draw-text draw-string ;

 M: array draw-text
-    GL_MODELVIEW [
+    [
        [
            [ draw-string ]
            [ [ 0.0 ] 2dip string-height 0.0 glTranslated ] 2bi
@ -79,7 +78,7 @@ USING: vocabs.loader namespaces system combinators ;
 "ui-backend" get [
    {
        { [ os macosx? ] [ "core-text" ] }
-        { [ os windows? ] [ "pango" ] }
+        { [ os windows? ] [ "uniscribe" ] }
        { [ os unix? ] [ "pango" ] }
    } cond
 ] unless* "ui.text." prepend require
--- a/basis/ui/text/uniscribe/authors.txt
+++ b/basis/ui/text/uniscribe/authors.txt
@ -0,0 +1 @@
+Slava Pestov
--- a/basis/ui/text/uniscribe/summary.txt
+++ b/basis/ui/text/uniscribe/summary.txt
@ -0,0 +1 @@
+UI text rendering implementation using the MS Windows Uniscribe library
--- a/basis/ui/text/uniscribe/tags.txt
+++ b/basis/ui/text/uniscribe/tags.txt
@ -0,0 +1 @@
+unportable
--- a/basis/ui/text/uniscribe/uniscribe.factor
+++ b/basis/ui/text/uniscribe/uniscribe.factor
@ -0,0 +1,42 @@
+! Copyright (C) 2009 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors assocs cache kernel math math.vectors sequences fonts
+namespaces opengl.textures ui.text ui.text.private ui.gadgets.worlds 
+windows.uniscribe ;
+IN: ui.text.uniscribe
+
+SINGLETON: uniscribe-renderer
+
+M: uniscribe-renderer string-dim
+    [ " " string-dim { 0 1 } v* ]
+    [ cached-script-string size>> ] if-empty ;
+
+M: uniscribe-renderer flush-layout-cache
+    cached-script-strings get purge-cache ;
+
+: rendered-script-string ( font string -- texture )
+    world get world-text-handle
+    [ cached-script-string image>> { 0 0 } <texture> ]
+    2cache ;
+
+M: uniscribe-renderer draw-string ( font string -- )
+    dup dup selection? [ string>> ] when empty?
+    [ 2drop ] [ rendered-script-string draw-texture ] if ;
+
+M: uniscribe-renderer x>offset ( x font string -- n )
+    [ 2drop 0 ] [
+        cached-script-string x>line-offset 0 = [ 1+ ] unless
+    ] if-empty ;
+
+M: uniscribe-renderer offset>x ( n font string -- x )
+    [ 2drop 0 ] [ cached-script-string line-offset>x ] if-empty ;
+
+M: uniscribe-renderer font-metrics ( font -- metrics )
+    " " cached-script-string metrics>> clone f >>width ;
+
+M: uniscribe-renderer line-metrics ( font string -- metrics )
+    [ " " line-metrics clone 0 >>width ]
+    [ cached-script-string metrics>> 50 >>width 10 >>cap-height 10 >>x-height ]
+    if-empty ;
+
+uniscribe-renderer font-renderer set-global
--- a/basis/ui/tools/browser/browser.factor
+++ b/basis/ui/tools/browser/browser.factor
@ -1,23 +1,33 @@
 ! Copyright (C) 2006, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: debugger help help.topics help.crossref help.home kernel
-models compiler.units assocs words vocabs accessors fry
-combinators.short-circuit namespaces sequences models
-models.history help.apropos combinators ui.commands ui.gadgets
-ui.gadgets.panes ui.gadgets.scrollers ui.gadgets.tracks
-ui.gestures ui.gadgets.buttons ui.gadgets.packs
-ui.gadgets.editors ui.gadgets.labels ui.gadgets.status-bar
-ui.gadgets.glass ui.gadgets.borders ui.tools.common
-ui.tools.browser.popups ui ;
+USING: debugger help help.topics help.crossref help.home kernel models
+compiler.units assocs words vocabs accessors fry arrays
+combinators.short-circuit namespaces sequences models help.apropos
+combinators ui ui.commands ui.gadgets ui.gadgets.panes
+ui.gadgets.scrollers ui.gadgets.tracks ui.gestures ui.gadgets.buttons
+ui.gadgets.packs ui.gadgets.editors ui.gadgets.labels
+ui.gadgets.status-bar ui.gadgets.glass ui.gadgets.borders ui.gadgets.viewports
+ui.tools.common ui.tools.browser.popups ui.tools.browser.history ;
 IN: ui.tools.browser

-TUPLE: browser-gadget < tool pane scroller search-field popup ;
+TUPLE: browser-gadget < tool history pane scroller search-field popup ;

 { 650 400 } browser-gadget set-tool-dim

+M: browser-gadget history-value
+    [ control-value ] [ scroller>> scroll-position ]
+    bi 2array ;
+
+M: browser-gadget set-history-value
+    [ first2 ] dip
+    [ set-control-value ] [ scroller>> set-scroll-position ]
+    bi-curry bi* ;
+
 : show-help ( link browser-gadget -- )
-    [ >link ] [ model>> ] bi*
-    [ [ add-recent ] [ add-history ] bi* ] [ set-model ] 2bi ;
+    [ >link ] dip
+    [ [ add-recent ] [ history>> add-history ] bi* ]
+    [ model>> set-model ]
+    2bi ;

 : <help-pane> ( browser-gadget -- gadget )
    model>> [ '[ _ print-topic ] try ] <pane-control> ;
@ -41,7 +51,8 @@ TUPLE: browser-gadget < tool pane scroller search-field popup ;
 : <browser-gadget> ( link -- gadget )
    vertical browser-gadget new-track
        1 >>fill
-        swap >link <history> >>model
+        swap >link <model> >>model
+        dup <history> >>history
        dup <search-field> >>search-field
        dup <browser-toolbar> { 3 3 } <border> { 1 0 } >>fill f track-add
        dup <help-pane> >>pane
@ -93,9 +104,9 @@ M: browser-gadget focusable-child* search-field>> ;

 \ show-browser H{ { +nullary+ t } } define-command

-: com-back ( browser -- ) model>> go-back ;
+: com-back ( browser -- ) history>> go-back ;

-: com-forward ( browser -- ) model>> go-forward ;
+: com-forward ( browser -- ) history>> go-forward ;

 : com-home ( browser -- ) "help.home" swap show-help ;

--- a/basis/ui/tools/browser/history/authors.txt
+++ b/basis/ui/tools/browser/history/authors.txt
@ -0,0 +1 @@
+Slava Pestov
--- a/basis/ui/tools/browser/history/history-tests.factor
+++ b/basis/ui/tools/browser/history/history-tests.factor
@ -0,0 +1,36 @@
+USING: namespaces ui.tools.browser.history sequences tools.test ;
+IN: ui.tools.browser.history.tests
+
+f <history> "history" set
+
+"history" get add-history
+
+[ t ] [ "history" get back>> empty? ] unit-test
+[ t ] [ "history" get forward>> empty? ] unit-test
+
+"history" get add-history
+"history" get 3 >>value drop
+
+[ t ] [ "history" get back>> empty? ] unit-test
+[ t ] [ "history" get forward>> empty? ] unit-test
+
+"history" get add-history
+"history" get 4 >>value drop
+
+[ f ] [ "history" get back>> empty? ] unit-test
+[ t ] [ "history" get forward>> empty? ] unit-test
+
+"history" get go-back
+
+[ 3 ] [ "history" get value>> ] unit-test
+
+[ t ] [ "history" get back>> empty? ] unit-test
+[ f ] [ "history" get forward>> empty? ] unit-test
+
+"history" get go-forward
+
+[ 4 ] [ "history" get value>> ] unit-test
+
+[ f ] [ "history" get back>> empty? ] unit-test
+[ t ] [ "history" get forward>> empty? ] unit-test
+
--- a/basis/ui/tools/browser/history/history.factor
+++ b/basis/ui/tools/browser/history/history.factor
@ -0,0 +1,32 @@
+! Copyright (C) 2009 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: kernel accessors sequences locals ;
+IN: ui.tools.browser.history
+
+TUPLE: history owner back forward ;
+
+: <history> ( owner -- history )
+    V{ } clone V{ } clone history boa ;
+
+GENERIC: history-value ( object -- value )
+
+GENERIC: set-history-value ( value object -- )
+
+: (add-history) ( history to -- )
+    swap owner>> history-value dup [ swap push ] [ 2drop ] if ;
+
+:: go-back/forward ( history to from -- )
+    from empty? [
+        history to (add-history)
+        from pop history owner>> set-history-value
+    ] unless ;
+
+: go-back ( history -- )
+    dup [ forward>> ] [ back>> ] bi go-back/forward ;
+
+: go-forward ( history -- )
+    dup [ back>> ] [ forward>> ] bi go-back/forward ;
+
+: add-history ( history -- )
+    dup forward>> delete-all
+    dup back>> (add-history) ;
--- a/basis/ui/tools/listener/completion/completion.factor
+++ b/basis/ui/tools/listener/completion/completion.factor
@ -141,6 +141,7 @@ GENERIC# accept-completion-hook 1 ( item popup -- )
        t >>selection-required?
        t >>single-click?
        30 >>min-cols
+        10 >>min-rows
        10 >>max-rows
        dup '[ _ accept-completion ] >>action ;

--- a/basis/urls/prettyprint/prettyprint.factor
+++ b/basis/urls/prettyprint/prettyprint.factor
@ -1,6 +1,9 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel present prettyprint.custom prettyprint.backend urls ;
+USING: kernel present prettyprint.custom prettyprint.sections
+prettyprint.backend urls ;
 IN: urls.prettyprint

-M: url pprint* dup present "URL\" " "\"" pprint-string ;
+M: url pprint*
+    \ URL" record-vocab
+    dup present "URL\" " "\"" pprint-string ;
--- a/basis/urls/urls-tests.factor
+++ b/basis/urls/urls-tests.factor
@ -1,5 +1,5 @@
 IN: urls.tests
-USING: urls urls.private tools.test
+USING: urls urls.private tools.test prettyprint
 arrays kernel assocs present accessors ;

 CONSTANT: urls
@ -227,3 +227,5 @@ urls [
 [ "http://localhost/?foo=bar" >url ] unit-test

 [ "/" ] [ "http://www.jedit.org" >url path>> ] unit-test
+
+[ "USING: urls ;\nURL\" foo\"" ] [ URL" foo" unparse-use ] unit-test
--- a/basis/windows/fonts/fonts.factor
+++ b/basis/windows/fonts/fonts.factor
@ -0,0 +1,37 @@
+USING: assocs memoize locals kernel accessors init fonts math
+combinators windows windows.types windows.gdi32 ;
+IN: windows.fonts
+
+: windows-font-name ( string -- string' )
+    H{
+        { "sans-serif" "Tahoma" }
+        { "serif" "Times New Roman" }
+        { "monospace" "Courier New" }
+    } at-default ;
+    
+MEMO:: (cache-font) ( font -- HFONT )
+    font size>> neg ! nHeight
+    0 0 0 ! nWidth, nEscapement, nOrientation
+    font bold?>> FW_BOLD FW_NORMAL ? ! fnWeight
+    font italic?>> TRUE FALSE ? ! fdwItalic
+    FALSE ! fdwUnderline
+    FALSE ! fdWStrikeOut
+    DEFAULT_CHARSET ! fdwCharSet
+    OUT_OUTLINE_PRECIS ! fdwOutputPrecision
+    CLIP_DEFAULT_PRECIS ! fdwClipPrecision
+    DEFAULT_QUALITY ! fdwQuality
+    DEFAULT_PITCH ! fdwPitchAndFamily
+    font name>> windows-font-name
+    CreateFont
+    dup win32-error=0/f ;
+
+: cache-font ( font -- HFONT ) strip-font-colors (cache-font) ;
+
+[ \ (cache-font) reset-memoized ] "windows.fonts" add-init-hook
+
+: TEXTMETRIC>metrics ( TEXTMETRIC -- metrics )
+    [ metrics new 0 >>width ] dip {
+        [ TEXTMETRICW-tmHeight >>height ]
+        [ TEXTMETRICW-tmAscent >>ascent ]
+        [ TEXTMETRICW-tmDescent >>descent ]
+    } cleave ;
--- a/basis/windows/gdi32/gdi32.factor
+++ b/basis/windows/gdi32/gdi32.factor
--- a/basis/windows/offscreen/authors.txt
+++ b/basis/windows/offscreen/authors.txt
@ -0,0 +1 @@
+Slava Pestov
--- a/basis/windows/offscreen/offscreen-tests.factor
+++ b/basis/windows/offscreen/offscreen-tests.factor
@ -0,0 +1,5 @@
+IN: windows.offscreen.tests
+USING: windows.offscreen effects tools.test kernel images ;
+
+{ 1 1 } [ [ [ ] make-bitmap-image ] with-memory-dc ] must-infer-as
+[ t ] [ [ { 10 10 } swap [ ] make-bitmap-image ] with-memory-dc image? ] unit-test
--- a/basis/windows/offscreen/offscreen.factor
+++ b/basis/windows/offscreen/offscreen.factor
@ -0,0 +1,53 @@
+! Copyright (C) 2009 Joe Groff, Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: alien.c-types kernel combinators sequences
+math windows.gdi32 windows.types images destructors
+accessors fry locals ;
+IN: windows.offscreen
+
+: (bitmap-info) ( dim -- BITMAPINFO )
+    "BITMAPINFO" <c-object> [
+        BITMAPINFO-bmiHeader {
+            [ nip "BITMAPINFOHEADER" heap-size swap set-BITMAPINFOHEADER-biSize ]
+            [ [ first ] dip set-BITMAPINFOHEADER-biWidth ]
+            [ [ second ] dip set-BITMAPINFOHEADER-biHeight ]
+            [ nip 1 swap set-BITMAPINFOHEADER-biPlanes ]
+            [ nip 32 swap set-BITMAPINFOHEADER-biBitCount ]
+            [ nip BI_RGB swap set-BITMAPINFOHEADER-biCompression ]
+            [ [ first2 * 4 * ] dip set-BITMAPINFOHEADER-biSizeImage ]
+            [ nip 72 swap set-BITMAPINFOHEADER-biXPelsPerMeter ]
+            [ nip 72 swap set-BITMAPINFOHEADER-biYPelsPerMeter ]
+            [ nip 0 swap set-BITMAPINFOHEADER-biClrUsed ]
+            [ nip 0 swap set-BITMAPINFOHEADER-biClrImportant ]
+        } 2cleave
+    ] keep ;
+
+: make-bitmap ( dim dc -- hBitmap bits )
+    [ nip ]
+    [
+        swap (bitmap-info) DIB_RGB_COLORS f <void*>
+        [ f 0 CreateDIBSection ] keep *void*
+    ] 2bi
+    [ [ SelectObject drop ] keep ] dip ;
+
+: make-offscreen-dc-and-bitmap ( dim -- dc hBitmap bits )
+    [ f CreateCompatibleDC ] dip over make-bitmap ;
+
+: bitmap>byte-array ( bits dim -- byte-array )
+    product 4 * memory>byte-array ;
+
+: bitmap>image ( bits dim -- image )
+    [ bitmap>byte-array ] keep
+    <image>
+        swap >>dim
+        swap >>bitmap
+        BGRX >>component-order
+        t >>upside-down? ;
+
+: with-memory-dc ( quot: ( hDC -- ) -- )
+    [ [ f CreateCompatibleDC &DeleteDC ] dip call ] with-destructors ; inline
+
+:: make-bitmap-image ( dim dc quot -- image )
+    dim dc make-bitmap [ &DeleteObject drop ] dip
+    quot dip
+    dim bitmap>image ; inline
--- a/basis/windows/offscreen/summary.txt
+++ b/basis/windows/offscreen/summary.txt
@ -0,0 +1 @@
+Utility words for memory DCs and bitmaps
--- a/basis/windows/offscreen/tags.txt
+++ b/basis/windows/offscreen/tags.txt
@ -0,0 +1 @@
+unportable
--- a/basis/windows/types/types.factor
+++ b/basis/windows/types/types.factor
@ -1,6 +1,7 @@
 ! Copyright (C) 2005, 2006 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien alien.syntax namespaces kernel words ;
+USING: alien alien.c-types alien.syntax namespaces kernel words
+sequences math math.bitwise math.vectors colors ;
 IN: windows.types

 TYPEDEF: char                CHAR
@ -244,14 +245,14 @@ C-STRUCT: RECT
    { "LONG" "right" }
    { "LONG" "bottom" } ;

-! C-STRUCT: PAINTSTRUCT
-    ! { "HDC" " hdc" }
-    ! { "BOOL" "fErase" }
-    ! { "RECT" "rcPaint" }
-    ! { "BOOL" "fRestore" }
-    ! { "BOOL" "fIncUpdate" }
-    ! { "BYTE[32]" "rgbReserved" }
-! ;
+C-STRUCT: PAINTSTRUCT
+    { "HDC" " hdc" }
+    { "BOOL" "fErase" }
+    { "RECT" "rcPaint" }
+    { "BOOL" "fRestore" }
+    { "BOOL" "fIncUpdate" }
+    { "BYTE[32]" "rgbReserved" }
+;

 C-STRUCT: BITMAPINFOHEADER
    { "DWORD"  "biSize" }
@ -283,6 +284,10 @@ C-STRUCT: POINT
    { "LONG" "x" }
    { "LONG" "y" } ; 

+C-STRUCT: SIZE
+    { "LONG" "cx" }
+    { "LONG" "cy" } ; 
+
 C-STRUCT: MSG
    { "HWND" "hWnd" }
    { "UINT" "message" }
@ -327,6 +332,14 @@ C-STRUCT: RECT
    { "LONG" "right" }
    { "LONG" "bottom" } ;

+: <RECT> ( loc dim -- RECT )
+    over v+
+    "RECT" <c-object>
+    over first over set-RECT-right
+    swap second over set-RECT-bottom
+    over first over set-RECT-left
+    swap second over set-RECT-top ;
+
 TYPEDEF: RECT* PRECT
 TYPEDEF: RECT* LPRECT
 TYPEDEF: PIXELFORMATDESCRIPTOR PFD
@ -363,3 +376,36 @@ C-STRUCT: ACCEL
    { "WORD" "key" }
    { "WORD" "cmd" } ;
 TYPEDEF: ACCEL* LPACCEL
+
+TYPEDEF: DWORD COLORREF
+TYPEDEF: DWORD* LPCOLORREF
+
+: RGB ( r g b -- COLORREF )
+    { 16 8 0 } bitfield ; inline
+
+: color>RGB ( color -- COLORREF )
+    >rgba-components drop [ 255 * >integer ] tri@ RGB ;
+
+C-STRUCT: TEXTMETRICW
+    { "LONG" "tmHeight" }
+    { "LONG" "tmAscent" }
+    { "LONG" "tmDescent" }
+    { "LONG" "tmInternalLeading" }
+    { "LONG" "tmExternalLeading" }
+    { "LONG" "tmAveCharWidth" }
+    { "LONG" "tmMaxCharWidth" }
+    { "LONG" "tmWeight" }
+    { "LONG" "tmOverhang" }
+    { "LONG" "tmDigitizedAspectX" }
+    { "LONG" "tmDigitizedAspectY" }
+    { "WCHAR" "tmFirstChar" }
+    { "WCHAR" "tmLastChar" }
+    { "WCHAR" "tmDefaultChar" }
+    { "WCHAR" "tmBreakChar" }
+    { "BYTE" "tmItalic" }
+    { "BYTE" "tmUnderlined" }
+    { "BYTE" "tmStruckOut" }
+    { "BYTE" "tmPitchAndFamily" }
+    { "BYTE" "tmCharSet" } ;
+
+TYPEDEF: TEXTMETRICW* LPTEXTMETRIC
--- a/basis/windows/uniscribe/authors.txt
+++ b/basis/windows/uniscribe/authors.txt
@ -0,0 +1 @@
+Slava Pestov
--- a/basis/windows/uniscribe/summary.txt
+++ b/basis/windows/uniscribe/summary.txt
@ -0,0 +1 @@
+High-level wrapper around Uniscribe binding
--- a/basis/windows/uniscribe/tags.txt
+++ b/basis/windows/uniscribe/tags.txt
@ -0,0 +1 @@
+unportable
--- a/basis/windows/uniscribe/uniscribe.factor
+++ b/basis/windows/uniscribe/uniscribe.factor
@ -0,0 +1,115 @@
+! Copyright (C) 2009 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: kernel assocs math sequences fry io.encodings.string
+io.encodings.utf16n accessors arrays combinators destructors locals
+cache namespaces init images.normalization fonts alien.c-types
+windows windows.usp10 windows.offscreen windows.gdi32
+windows.ole32 windows.types windows.fonts opengl.textures ;
+IN: windows.uniscribe
+
+TUPLE: script-string font string metrics ssa size image disposed ;
+
+: line-offset>x ( n script-string -- x )
+    2dup string>> length = [
+        ssa>> ! ssa
+        swap 1- ! icp
+        TRUE ! fTrailing
+    ] [
+        ssa>>
+        swap ! icp
+        FALSE ! fTrailing
+    ] if
+    0 <int> [ ScriptStringCPtoX ole32-error ] keep *int ;
+
+: x>line-offset ( x script-string -- n trailing )
+    ssa>> ! ssa
+    swap ! iX
+    0 <int> ! pCh
+    0 <int> ! piTrailing
+    [ ScriptStringXtoCP ole32-error ] 2keep [ *int ] bi@ ;
+
+<PRIVATE
+
+: make-script-string ( dc string -- script-string )
+    dup selection? [ string>> ] when
+    [ utf16n encode ] ! pString
+    [ length ] bi ! cString
+    dup 1.5 * 16 + >integer ! cGlyphs -- MSDN says this is "recommended size"
+    -1 ! iCharset -- Unicode
+    SSA_GLYPHS ! dwFlags
+    0 ! iReqWidth
+    f ! psControl
+    f ! psState
+    f ! piDx
+    f ! pTabdef
+    f ! pbInClass
+    f <void*> ! pssa
+    [ ScriptStringAnalyse ] keep
+    [ ole32-error ] [ |ScriptStringFree *void* ] bi* ;
+
+: set-dc-colors ( dc font -- )
+    [ background>> color>RGB SetBkColor drop ]
+    [ foreground>> color>RGB SetTextColor drop ] 2bi ;
+
+: selection-start/end ( script-string -- iMinSel iMaxSel )
+    string>> dup selection? [ [ start>> ] [ end>> ] bi ] [ drop 0 0 ] if ;
+
+: (draw-script-string) ( script-string -- )
+    [
+        ssa>> ! ssa
+        0 ! iX
+        0 ! iY
+        0 ! uOptions
+        f ! prc
+    ]
+    [ selection-start/end ] bi
+    ! iMinSel
+    ! iMaxSel
+    FALSE ! fDisabled
+    ScriptStringOut ole32-error ;
+
+: draw-script-string ( dc script-string -- )
+    [ font>> set-dc-colors ] keep (draw-script-string) ;
+
+:: make-script-string-image ( dc script-string -- image )
+    script-string size>> dc
+    [ dc script-string draw-script-string ] make-bitmap-image ;
+
+: set-dc-font ( dc font -- )
+    cache-font SelectObject win32-error=0/f ;
+
+: script-string-size ( script-string -- dim )
+    ssa>> ScriptString_pSize
+    dup win32-error=0/f
+    [ SIZE-cx ] [ SIZE-cy ] bi 2array ;
+
+: dc-metrics ( dc -- metrics )
+    "TEXTMETRICW" <c-object>
+    [ GetTextMetrics drop ] keep
+    TEXTMETRIC>metrics ;
+
+: <script-string> ( font string -- script-string )
+    [ script-string new ] 2dip
+        [ >>font ] [ >>string ] bi*
+    [
+        {
+            [ over font>> set-dc-font ]
+            [ dc-metrics >>metrics ]
+            [ over string>> make-script-string >>ssa ]
+            [ drop dup script-string-size >>size ]
+            [ over make-script-string-image >>image ]
+        } cleave
+    ] with-memory-dc ;
+
+PRIVATE>
+
+M: script-string dispose*
+    ssa>> <void*> ScriptStringFree ole32-error ;
+
+SYMBOL: cached-script-strings
+
+: cached-script-string ( string font -- script-string )
+    cached-script-strings get-global [ <script-string> ] 2cache ;
+
+[ <cache-assoc> cached-script-strings set-global ]
+"windows.uniscribe" add-init-hook
--- a/basis/windows/usp10/usp10.factor
+++ b/basis/windows/usp10/usp10.factor
@ -1,6 +1,6 @@
 ! Copyright (C) 2009 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien.syntax ;
+USING: alien.syntax alien.destructors ;
 IN: windows.usp10

 LIBRARY: usp10
@ -262,6 +262,8 @@ FUNCTION: HRESULT ScriptStringFree (
    SCRIPT_STRING_ANALYSIS* pssa
 ) ;

+DESTRUCTOR: ScriptStringFree
+
 FUNCTION: SIZE* ScriptString_pSize ( SCRIPT_STRING_ANALYSIS ssa ) ;

 FUNCTION: int* ScriptString_pcOutChars ( SCRIPT_STRING_ANALYSIS ssa ) ;
--- a/basis/windows/windows.factor
+++ b/basis/windows/windows.factor
@ -1,7 +1,7 @@
 ! Copyright (C) 2005, 2006 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: alien alien.syntax alien.c-types alien.strings arrays
-combinators kernel math namespaces parser prettyprint sequences
+combinators kernel math namespaces parser sequences
 windows.errors windows.types windows.kernel32 words
 io.encodings.utf16n ;
 IN: windows
--- a/build-support/dlls.txt
+++ b/build-support/dlls.txt
@ -1,12 +0,0 @@
-libcairo-2.dll
-libgio-2.0-0.dll
-libglib-2.0-0.dll
-libgmodule-2.0-0.dll
-libgobject-2.0-0.dll
-libgthread-2.0-0.dll
-libpango-1.0-0.dll
-libpangocairo-1.0-0.dll
-libpangowin32-1.0-0.dll
-libpng12-0.dll
-libtiff3.dll
-zlib1.dll
--- a/build-support/factor.sh
+++ b/build-support/factor.sh
@ -445,16 +445,6 @@ get_url() {
    check_ret $DOWNLOADER
 }

-maybe_download_dlls() {
-    if [[ $OS == winnt ]] ; then
-	for file in `cat build-support/dlls.txt`; do
-	    get_url http://factorcode.org/dlls/$file
-            chmod 777 *.dll
-            check_ret chmod
-	done
-    fi
-}
-
 get_config_info() {
    find_build_info
    check_installed_programs
@ -472,7 +462,6 @@ install() {
    cd_factor
    make_factor
    get_boot_image
-    maybe_download_dlls
    bootstrap
 }

@ -547,7 +536,6 @@ case "$1" in
    update) update; update_bootstrap ;;
    bootstrap) get_config_info; bootstrap ;;
    report) find_build_info ;;
-    dlls) get_config_info; maybe_download_dlls;;
    net-bootstrap) get_config_info; update_boot_images; bootstrap ;;
    make-target) ECHO=false; find_build_info; echo $MAKE_TARGET ;;
    *) usage ;;
--- a/core/alien/alien-tests.factor
+++ b/core/alien/alien-tests.factor
@ -1,6 +1,6 @@
 USING: accessors alien alien.accessors alien.syntax byte-arrays arrays
 kernel kernel.private namespaces tools.test sequences libc math
-system prettyprint layouts alien.libraries ;
+system prettyprint layouts alien.libraries sets ;
 IN: alien.tests

 [ t ] [ -1 <alien> alien-address 0 > ] unit-test
@ -86,3 +86,5 @@ f initialize-test set-global
 [ ] [ initialize-test get BAD-ALIEN >>alien drop ] unit-test

 [ 7575 ] [ initialize-test [ 7575 ] initialize-alien ] unit-test
+
+[ V{ BAD-ALIEN } ] [ { BAD-ALIEN BAD-ALIEN BAD-ALIEN } prune ] unit-test
--- a/core/alien/alien.factor
+++ b/core/alien/alien.factor
@ -49,6 +49,8 @@ M: alien equal?
        2drop f
    ] if ;

+M: simple-alien hashcode* nip dup expired>> [ drop 1234 ] [ alien-address ] if ;
+
 ERROR: alien-callback-error ;

 : alien-callback ( return parameters abi quot -- alien )
--- a/core/bootstrap/primitives.factor
+++ b/core/bootstrap/primitives.factor
@ -510,6 +510,7 @@ tuple
    { "fputc" "io.streams.c" (( ch alien -- )) }
    { "fwrite" "io.streams.c" (( string alien -- )) }
    { "fflush" "io.streams.c" (( alien -- )) }
+    { "fseek" "io.streams.c" (( alien offset whence -- )) }
    { "fclose" "io.streams.c" (( alien -- )) }
    { "<wrapper>" "kernel" (( obj -- wrapper )) }
    { "(clone)" "kernel" (( obj -- newobj )) }
--- a/core/io/streams/c/c.factor
+++ b/core/io/streams/c/c.factor
@ -1,11 +1,24 @@
-! Copyright (C) 2004, 2008 Slava Pestov.
+! Copyright (C) 2004, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel kernel.private namespaces make io io.encodings
 sequences math generic threads.private classes io.backend
-io.files continuations destructors byte-arrays accessors ;
+io.files continuations destructors byte-arrays accessors
+combinators ;
 IN: io.streams.c

-TUPLE: c-writer handle disposed ;
+TUPLE: c-stream handle disposed ;
+
+M: c-stream dispose* handle>> fclose ;
+
+M: c-stream stream-seek
+    handle>> swap {
+        { seek-absolute [ 0 ] }
+        { seek-relative [ 1 ] }
+        { seek-end [ 2 ] }
+        [ bad-seek-type ]
+    } case fseek ;
+
+TUPLE: c-writer < c-stream ;

 : <c-writer> ( handle -- stream ) f c-writer boa ;

@ -17,9 +30,7 @@ M: c-writer stream-write dup check-disposed handle>> fwrite ;

 M: c-writer stream-flush dup check-disposed handle>> fflush ;

-M: c-writer dispose* handle>> fclose ;
-
-TUPLE: c-reader handle disposed ;
+TUPLE: c-reader < c-stream ;

 : <c-reader> ( handle -- stream ) f c-reader boa ;

@ -43,9 +54,6 @@ M: c-reader stream-read-until
    [ swap read-until-loop ] B{ } make swap
    over empty? over not and [ 2drop f f ] when ;

-M: c-reader dispose*
-    handle>> fclose ;
-
 M: c-io-backend init-io ;

 : stdin-handle ( -- alien ) 11 getenv ;
--- a/core/sequences/sequences-docs.factor
+++ b/core/sequences/sequences-docs.factor
@ -311,7 +311,7 @@ HELP: each-index

 HELP: map-index
 { $values
-     { "seq" sequence } { "quot" quotation } }
+  { "seq" sequence } { "quot" quotation } { "newseq" sequence } }
 { $description "Calls the quotation with the element of the sequence and its index on the stack, with the index on the top of the stack. Collects the outputs of the quotation and outputs them in a sequence of the same type as the input sequence." }
 { $examples { $example "USING: sequences prettyprint math ;"
 "{ 10 20 30 } [ + ] map-index ."
--- a/core/sequences/sequences.factor
+++ b/core/sequences/sequences.factor
@ -506,7 +506,7 @@ PRIVATE>
    [ [ 0 = ] 2dip if ] 2curry
    each-index ; inline

-: map-index ( seq quot -- )
+: map-index ( seq quot -- newseq )
    prepare-index 2map ; inline

 : reduce-index ( seq identity quot -- )
--- a/core/words/alias/alias.factor
+++ b/core/words/alias/alias.factor
@ -1,6 +1,6 @@
 ! Copyright (C) 2008 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: quotations effects accessors sequences words kernel ;
+USING: quotations effects accessors sequences words kernel definitions ;
 IN: words.alias

 PREDICATE: alias < word "alias" word-prop ;
@ -12,5 +12,6 @@ PREDICATE: alias < word "alias" word-prop ;
 M: alias reset-word
    [ call-next-method ] [ f "alias" set-word-prop ] bi ;

-M: alias stack-effect
-    def>> first stack-effect ;
+M: alias definer drop \ ALIAS: f ;
+
+M: alias definition def>> first 1quotation ;
--- a/core/words/constant/constant-tests.factor
+++ b/core/words/constant/constant-tests.factor
@ -0,0 +1,14 @@
+IN: words.constant.tests
+USING: tools.test math ;
+
+CONSTANT: a +
+
+[ + ] [ a ] unit-test
+
+CONSTANT: b \ +
+
+[ \ + ] [ b ] unit-test
+
+CONSTANT: c { 1 2 3 }
+
+[ { 1 2 3 } ] [ c ] unit-test
--- a/core/words/constant/constant.factor
+++ b/core/words/constant/constant.factor
@ -1,6 +1,6 @@
-! Copyright (C) 2008 Slava Pestov.
+! Copyright (C) 2008, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors kernel sequences words ;
+USING: accessors kernel sequences words definitions quotations ;
 IN: words.constant

 PREDICATE: constant < word ( obj -- ? )
@ -8,3 +8,7 @@ PREDICATE: constant < word ( obj -- ? )

 : define-constant ( word value -- )
    [ ] curry (( -- value )) define-inline ;
+
+M: constant definer drop \ CONSTANT: f ;
+
+M: constant definition def>> first literalize 1quotation ;
--- a/extra/c/preprocessor/preprocessor-tests.factor
+++ b/extra/c/preprocessor/preprocessor-tests.factor
@ -1,6 +1,6 @@
 ! Copyright (C) 2009 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: tools.test c.preprocessor kernel accessors ;
+USING: tools.test c.preprocessor kernel accessors multiline ;
 IN: c.preprocessor.tests

 [ "vocab:c/tests/test1/test1.c" start-preprocess-file ]
@ -9,8 +9,18 @@ IN: c.preprocessor.tests
 [ "yo\n\n\n\nyo4\n" ]
 [ "vocab:c/tests/test2/test2.c" start-preprocess-file nip ] unit-test

+/*
 [ "vocab:c/tests/test3/test3.c" start-preprocess-file ]
 [ "\"BOO\"" = ] must-fail-with
+*/

 [ V{ "\"omg\"" "\"lol\"" } ]
 [ "vocab:c/tests/test4/test4.c" start-preprocess-file drop warnings>> ] unit-test
+
+
+/*
+f(2 * (y+1)) + f(2 * (f(2 * (z[0])))) % f(2 * (0)) + t(1); 
+f(2 * (2+(3,4)-0,1)) | f(2 * (~ 5)) & f(2 * (0,1))^m(0,1); 
+int i[] = { 1, 23, 4, 5, }; 
+char c[2][6] = { "hello", "" }; 
+*/
--- a/extra/c/preprocessor/preprocessor.factor
+++ b/extra/c/preprocessor/preprocessor.factor
@ -3,24 +3,41 @@
 USING: html.parser.state io io.encodings.utf8 io.files
 io.streams.string kernel combinators accessors io.pathnames
 fry sequences arrays locals namespaces io.directories
-assocs math splitting make ;
+assocs math splitting make unicode.categories
+combinators.short-circuit ;
 IN: c.preprocessor

 : initial-library-paths ( -- seq )
    V{ "/usr/include" } clone ;

+: initial-symbol-table ( -- hashtable )
+    H{
+        { "__APPLE__" "" }
+        { "__amd64__" "" }
+        { "__x86_64__" "" }
+    } clone ;
+
 TUPLE: preprocessor-state library-paths symbol-table
 include-nesting include-nesting-max processing-disabled?
-ifdef-nesting warnings ;
+ifdef-nesting warnings errors
+pragmas
+include-nexts
+ifs elifs elses ;

 : <preprocessor-state> ( -- preprocessor-state )
    preprocessor-state new
        initial-library-paths >>library-paths
-        H{ } clone >>symbol-table
+        initial-symbol-table >>symbol-table
        0 >>include-nesting
        200 >>include-nesting-max
        0 >>ifdef-nesting
-        V{ } clone >>warnings ;
+        V{ } clone >>warnings
+        V{ } clone >>errors
+        V{ } clone >>pragmas
+        V{ } clone >>include-nexts
+        V{ } clone >>ifs
+        V{ } clone >>elifs
+        V{ } clone >>elses ;

 DEFER: preprocess-file

@ -64,8 +81,13 @@ ERROR: header-file-missing path ;

 : readlns ( -- string ) [ (readlns) ] { } make concat ;

+: take-define-identifier ( state-parser -- string )
+    skip-whitespace
+    [ current { [ blank? ] [ CHAR: ( = ] } 1|| ] take-until ;
+
 : handle-define ( preprocessor-state state-parser -- )
-    [ take-token ] [ take-rest ] bi 
+    [ take-define-identifier ]
+    [ skip-whitespace take-rest ] bi 
    "\\" ?tail [ readlns append ] when
    spin symbol-table>> set-at ;

@ -86,9 +108,25 @@ ERROR: header-file-missing path ;
 : handle-endif ( preprocessor-state state-parser -- )
    drop [ 1 - ] change-ifdef-nesting drop ;

+: handle-if ( preprocessor-state state-parser -- )
+    [ [ 1 + ] change-ifdef-nesting ] dip
+    skip-whitespace take-rest swap ifs>> push ;
+
+: handle-elif ( preprocessor-state state-parser -- )
+    skip-whitespace take-rest swap elifs>> push ;
+
+: handle-else ( preprocessor-state state-parser -- )
+    skip-whitespace take-rest swap elses>> push ;
+
+: handle-pragma ( preprocessor-state state-parser -- )
+    skip-whitespace take-rest swap pragmas>> push ;
+
+: handle-include-next ( preprocessor-state state-parser -- )
+    skip-whitespace take-rest swap include-nexts>> push ;
+
 : handle-error ( preprocessor-state state-parser -- )
-    skip-whitespace
-    nip take-rest throw ;
+    skip-whitespace take-rest swap errors>> push ;
+    ! nip take-rest throw ;

 : handle-warning ( preprocessor-state state-parser -- )
    skip-whitespace
@ -104,11 +142,11 @@ ERROR: header-file-missing path ;
        { "ifdef" [ handle-ifdef ] }
        { "ifndef" [ handle-ifndef ] }
        { "endif" [ handle-endif ] }
-        { "if" [ 2drop ] }
-        { "elif" [ 2drop ] }
-        { "else" [ 2drop ] }
-        { "pragma" [ 2drop ] }
-        { "include_next" [ 2drop ] }
+        { "if" [ handle-if ] }
+        { "elif" [ handle-elif ] }
+        { "else" [ handle-else ] }
+        { "pragma" [ handle-pragma ] }
+        { "include_next" [ handle-include-next ] }
        [ unknown-c-preprocessor ]
    } case ;

--- a/extra/c/tests/test10/test10.c
+++ b/extra/c/tests/test10/test10.c
@ -0,0 +1,3 @@
+/*
+# lol
+*/
--- a/extra/c/tests/test11/foo.h
+++ b/extra/c/tests/test11/foo.h
@ -0,0 +1 @@
+foo.h ftw
--- a/extra/c/tests/test11/test11.c
+++ b/extra/c/tests/test11/test11.c
@ -0,0 +1,2 @@
+#define FOO_H "foo.h"
+#include FOO_H
--- a/extra/c/tests/test12/test12.c
+++ b/extra/c/tests/test12/test12.c
@ -0,0 +1,3 @@
+#if 4 > (5 - 4++)
+#error "Umm"
+#endif
--- a/extra/c/tests/test13/test13.c
+++ b/extra/c/tests/test13/test13.c
@ -0,0 +1,2 @@
+#if 10
+#error "Umm"
--- a/extra/c/tests/test14/test14.c
+++ b/extra/c/tests/test14/test14.c
@ -0,0 +1,15 @@
+#if 4 > (1 + 2) 
+good
+#endif
+
+#if 4 > 1 + 2
+good
+#endif
+
+#if (4 > 1) - 1
+bad
+#endif
+
+#if (4 > 1) - 2
+good
+#endif
--- a/extra/c/tests/test5/test5.c
+++ b/extra/c/tests/test5/test5.c
@ -0,0 +1,3 @@
+#define TABSIZE 100
+
+int table[TABSIZE];
--- a/extra/c/tests/test6/test6.c
+++ b/extra/c/tests/test6/test6.c
@ -0,0 +1 @@
+#define max(a, b) ((a) > (b) ? (a) : (b))
--- a/extra/c/tests/test7/test7.c
+++ b/extra/c/tests/test7/test7.c
@ -0,0 +1,19 @@
+#define x 3 
+#define f(a) f(x * (a)) 
+#undef x 
+#define x 2 
+#define g f 
+#define z z[0] 
+#define h g(~ 
+#define m(a) a(w) 
+#define w 0,1 
+#define t(a) a 
+#define p() int 
+#define q(x) x 
+#define r(x,y) x ## y 
+#define str(x) # x 
+f(y+1) + f(f(z)) % t(t(g)(0) + t)(1); 
+g(x+(3,4)-w) | h 5) & m 
+(f)^m(m); 
+p() i[q()] = { q(1), r(2,3), r(4,), r(,5), r(,) }; 
+char c[2][6] = { str(hello), str() }; 
--- a/extra/c/tests/test8/test8.c
+++ b/extra/c/tests/test8/test8.c
@ -0,0 +1,15 @@
+#define str(s) #s 
+#define xstr(s) str(s) 
+#define debug(s, t) printf("x" # s "= %d, x" # t "= %s", \ 
+x ## s, x ## t) 
+#define INCFILE(n) vers ## n 
+#define glue(a, b) a## b 
+#define xglue(a, b) glue(a, b) 
+#define HIGHLOW "hello" 
+#define LOW LOW ", world" 
+debug(1, 2); 
+fputs(str(strncmp("abc\0d", "abc", '\4') //this goes away 
+== 0) str(: @\n), s); 
+#include xstr(INCFILE(2).h) 
+glue(HIGH, LOW); 
+xglue(HIGH, LOW) 
--- a/Show More
+++ b/Show More
				`@ -0,0 +1 @@`
				`UI text rendering implementation using cross-platform Pango library`