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

basis/db/postgresql/postgresql.factor

@@ -140,7 +140,7 @@ M: postgresql-db bind# ( spec object -- )
 
 : create-function-sql ( class -- statement )
     [
-        [ remove-id ] dip
+        [ dup remove-id ] dip
         "create function add_" 0% dup 0%
         "(" 0%
         over [ "," 0% ]
@@ -157,7 +157,9 @@ M: postgresql-db bind# ( spec object -- )
         ") values(" 0%
         swap [ ", " 0% ] [ drop bind-name% ] interleave
         "); " 0%
-        "select currval(''" 0% 0% "_id_seq'');' language sql;" 0%
+        "select currval(''" 0% 0% "_" 0%
+        find-primary-key first column-name>> 0%
+        "_seq'');' language sql;" 0%
     ] query-make ;
 
 M: postgresql-db create-sql-statement ( class -- seq )

basis/io/windows/files/files.factor

@@ -274,7 +274,7 @@ M: winnt file-system-info ( path -- file-system-info )
         swap *ulonglong >>total-bytes
         swap *ulonglong >>free-space
         swap >>type
-        swap >>name ;
+        swap >>mount-point ;
 
 : find-first-volume ( word -- string handle )
     MAX_PATH 1+ <byte-array> dup length

basis/unix/statfs/freebsd/freebsd.factor

@@ -1,7 +1,8 @@
 ! Copyright (C) 2008 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien.syntax kernel unix io.files math accessors
+USING: alien.syntax kernel unix math accessors
-combinators system io.backend alien.c-types ;
+combinators system io.backend alien.c-types unix.statfs 
+io.files ;
 IN: unix.statfs.freebsd
 
 : ST_RDONLY       1 ; inline

basis/unix/statfs/linux/64/64.factor

@@ -1,8 +1,8 @@
 ! Copyright (C) 2008 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien.c-types combinators kernel io.files unix.stat
+USING: alien.c-types combinators kernel unix.stat
 math accessors system unix io.backend layouts vocabs.loader
-alien.syntax ;
+alien.syntax unix.statfs io.files ;
 IN: unix.statfs.linux
 
 C-STRUCT: statfs64

basis/unix/statfs/linux/linux.factor

@@ -37,7 +37,7 @@ M: linux mounted
         [ mount-point>> file-system-info ] keep
         {
             [ file-system-name>> >>device-name ]
-            [ mount-point>> >>name ]
+            [ mount-point>> >>mount-point ]
             [ type>> >>type ]
         } cleave
     ] map ;

basis/unix/statfs/macosx/macosx.factor

@@ -135,7 +135,7 @@ M: macosx >file-system-info ( byte-array -- file-system-info )
             [ statfs64-f_bavail ] [ statfs64-f_bsize ] bi *
             >>free-space
         ]
-        [ statfs64-f_mntonname utf8 alien>string >>name ]
+        [ statfs64-f_mntonname utf8 alien>string >>mount-point ]
         [ statfs64-f_bsize >>block-size ]
 
         [ statfs64-f_iosize >>io-size ]

basis/unix/statfs/netbsd/netbsd.factor

@@ -69,7 +69,7 @@ M: netbsd >file-system-info ( byte-array -- netbsd-file-system-info )
         [ statvfs-f_owner >>owner ]
         [ statvfs-f_spare >>spare ]
         [ statvfs-f_fstypename utf8 alien>string >>file-system-type-name ]
-        [ statvfs-f_mntonname utf8 alien>string >>name ]
+        [ statvfs-f_mntonname utf8 alien>string >>mount-point ]
         [ statvfs-f_mntfromname utf8 alien>string >>mount-from ]
     } cleave ;
 

basis/unix/statfs/openbsd/openbsd.factor

@@ -1,7 +1,8 @@
 ! Copyright (C) 2008 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien.syntax accessors combinators kernel io.files
+USING: alien.syntax accessors combinators kernel
-unix.types math system io.backend alien.c-types unix ;
+unix.types math system io.backend alien.c-types unix
+unix.statfs io.files ;
 IN: unix.statfs.openbsd
 
 C-STRUCT: statvfs

core/io/files/files.factor

@@ -184,7 +184,7 @@ SYMBOL: +unknown+
 
 ! File-system
 
-TUPLE: file-system-info device-name name type free-space ;
+TUPLE: file-system-info device-name mount-point type free-space ;
 
 HOOK: file-system-info os ( path -- file-system-info )
 

extra/cap/cap.factor

@@ -0,0 +1,31 @@
+USING: accessors arrays byte-arrays kernel math namespaces
+opengl.gl sequences math.vectors ui graphics.bitmap graphics.viewer
+models opengl.framebuffers ui.gadgets.worlds ui.gadgets fry ;
+IN: cap
+
+: screenshot-array ( world -- byte-array )
+    dim>> product 3 * <byte-array> ;
+
+: gl-screenshot ( gadget -- byte-array )
+    [
+        GL_BACK glReadBuffer
+        GL_PACK_ALIGNMENT 1 glPixelStorei
+        0 0
+    ] dip
+    [ dim>> first2 GL_BGR GL_UNSIGNED_BYTE ]
+    [ screenshot-array ] bi
+    [ glReadPixels ] keep ;
+
+: screenshot ( window -- bitmap )
+    [ gl-screenshot ]
+    [ dim>> first2 ] bi
+    bgr>bitmap ;
+
+: save-screenshot ( window path -- )
+    [ screenshot ] dip save-bitmap ;
+
+: screenshot. ( window -- )
+    [ screenshot <graphics-gadget> ] [ title>> ] bi open-window ;
+
+
+

extra/dns/forwarding/forwarding.factor

@@ -2,7 +2,8 @@
 USING: kernel sequences combinators accessors locals random
        combinators.short-circuit
        io.sockets
-       dns dns.util dns.cache.rr dns.cache.nx ;
+       dns dns.util dns.cache.rr dns.cache.nx
+       dns.resolver ;
 
 IN: dns.forwarding
 
@@ -99,7 +100,9 @@ IN: dns.forwarding
    MSG additional-section>> [ cache-add ] each
    MSG ;
 
-: answer-from-server ( msg servers -- msg ) random ask-server cache-message ;
+! : answer-from-server ( msg servers -- msg ) random ask-server cache-message ;
+
+: answer-from-server ( msg servers -- msg ) ask-servers cache-message ;
 
 :: find-answer ( MSG SERVERS -- msg )
    { [ MSG answer-from-cache ] [ MSG SERVERS answer-from-server ] } 0|| ;

extra/dns/resolver/resolver.factor

@@ -60,7 +60,7 @@ IN: dns.resolver
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
-: dns-ip ( name -- ips )
+: dns-ip4 ( name -- ips )
   fully-qualified
   [let | MSG [ A IN query boa query->message dns-servers ask-servers ] |
     MSG rcode>> NO-ERROR =
@@ -68,3 +68,5 @@ IN: dns.resolver
       [ "dns-ip: rcode = " MSG rcode>> unparse append throw        ]
     if ] ;
 
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+

extra/graphics/bitmap/bitmap.factor

@@ -15,6 +15,14 @@ TUPLE: bitmap magic size reserved offset header-length width
     height planes bit-count compression size-image
     x-pels y-pels color-used color-important rgb-quads color-index array ;
 
+: bgr>bitmap ( array height width -- bitmap )
+    bitmap new
+        2over * 3 * >>size-image
+        swap >>height
+        swap >>width
+        swap [ >>array ] [ >>color-index ] bi
+        24 >>bit-count ;
+
 : raw-bitmap>string ( str n -- str )
     {
         { 32 [ "32bit" throw ] }
@@ -74,7 +82,7 @@ M: bitmap-magic summary
 
 : save-bitmap ( bitmap path -- )
     binary [
-        "BM" write
+        "BM" >byte-array write
         dup array>> length 14 + 40 + 4 >le write
         0 4 >le write
         54 4 >le write
@@ -87,10 +95,10 @@ M: bitmap-magic summary
             [ bit-count>> 24 or 2 >le write ]
             [ compression>> 0 or 4 >le write ]
             [ size-image>> 4 >le write ]
-            [ x-pels>> 4 >le write ]
+            [ x-pels>> 0 or 4 >le write ]
-            [ y-pels>> 4 >le write ]
+            [ y-pels>> 0 or 4 >le write ]
-            [ color-used>> 4 >le write ]
+            [ color-used>> 0 or 4 >le write ]
-            [ color-important>> 4 >le write ]
+            [ color-important>> 0 or 4 >le write ]
             [ rgb-quads>> write ]
             [ color-index>> write ]
         } cleave