Merge branch 'master' into redis

basis/alien/c-types/c-types.factor

@@ -259,8 +259,9 @@ M: long-long-type box-return ( type -- )
     [ dup c-setter '[ _ <c-object> [ 0 @ ] keep ] ] bi
     (( value -- c-ptr )) define-inline ;
 
-: c-bool> ( int -- ? )
-    0 = not ; inline
+: >c-bool ( ? -- int ) 1 0 ? ; inline
+
+: c-bool> ( int -- ? ) 0 = not ; inline
 
 : define-primitive-type ( type name -- )
     [ typedef ]
@@ -409,8 +410,8 @@ CONSTANT: primitive-types
     "uchar" define-primitive-type
 
     <c-type>
-        [ alien-unsigned-1 zero? not ] >>getter
-        [ [ 1 0 ? ] 2dip set-alien-unsigned-1 ] >>setter
+        [ alien-unsigned-1 c-bool> ] >>getter
+        [ [ >c-bool ] 2dip set-alien-unsigned-1 ] >>setter
         1 >>size
         1 >>align
         "box_boolean" >>boxer

basis/base64/base64-tests.factor

@@ -4,7 +4,7 @@ IN: base64.tests
 
 [ "abcdefghijklmnopqrstuvwxyz" ] [ "abcdefghijklmnopqrstuvwxyz" ascii encode >base64 base64> ascii decode
 ] unit-test
-[ f ] [ "" ascii encode >base64 base64> ascii decode ] unit-test
+[ "" ] [ "" ascii encode >base64 base64> ascii decode ] unit-test
 [ "a" ] [ "a" ascii encode >base64 base64> ascii decode ] unit-test
 [ "ab" ] [ "ab" ascii encode >base64 base64> ascii decode ] unit-test
 [ "abc" ] [ "abc" ascii encode >base64 base64> ascii decode ] unit-test

basis/cpu/ppc/ppc.factor

@@ -2,11 +2,11 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors assocs sequences kernel combinators make math
 math.order math.ranges system namespaces locals layouts words
-alien alien.c-types literals cpu.architecture cpu.ppc.assembler
-cpu.ppc.assembler.backend literals compiler.cfg.registers
+alien alien.accessors alien.c-types literals cpu.architecture
+cpu.ppc.assembler cpu.ppc.assembler.backend literals compiler.cfg.registers
 compiler.cfg.instructions compiler.constants compiler.codegen
 compiler.codegen.fixup compiler.cfg.intrinsics
-compiler.cfg.stack-frame ;
+compiler.cfg.stack-frame compiler.units ;
 IN: cpu.ppc
 
 ! PowerPC register assignments:
@@ -713,4 +713,14 @@ USE: vocabs.loader
 } cond
 
 "complex-double" c-type t >>return-in-registers? drop
-"bool" c-type 4 >>size 4 >>align drop
+
+[
+    <c-type>
+        [ alien-unsigned-4 c-bool> ] >>getter
+        [ [ >c-bool ] 2dip set-alien-unsigned-4 ] >>setter
+        4 >>size
+        4 >>align
+        "box_boolean" >>boxer
+        "to_boolean" >>unboxer
+    "bool" define-primitive-type
+] with-compilation-unit

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

@@ -1,6 +1,6 @@
 ! Copyright (C) 2009 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: help.markup help.syntax kernel quotations ;
+USING: help.markup help.syntax kernel quotations sequences ;
 IN: io.directories.search
 
 HELP: each-file
@@ -57,6 +57,32 @@ HELP: find-all-in-directories
 }
 { $description "Finds all files in the input directories matching the predicate quotation in a breadth-first or depth-first traversal." } ;
 
+HELP: find-by-extension
+{ $values
+    { "path" "a pathname string" } { "extension" "a file extension" }
+    { "seq" sequence }
+}
+{ $description "Searches a directory for all files with the given extension. File extension and filenames are converted to lower-case and compared using the " { $link tail? } " word. The file extension should contain the period." }
+{ $examples
+    { $unchecked-example
+        "USING: io.directories.search ;"
+        "\"/\" \".mp3\" find-by-extension"
+    }
+} ;
+
+HELP: find-by-extensions
+{ $values
+    { "path" "a pathname string" } { "extensions" "a sequence of file extensions" }
+    { "seq" sequence }
+}
+{ $description "Searches a directory for all files in the given list of extensions. File extensions and filenames are converted to lower-case and compared using the " { $link tail? } " word. File extensions should contain the period." }
+{ $examples
+    { $unchecked-example
+        "USING: io.directories.search ;"
+        "\"/\" { \".jpg\" \".gif\" \".tiff\" \".png\" \".bmp\" } find-by-extensions"
+    }
+} ;
+
 { find-file find-all-files find-in-directories find-all-in-directories } related-words
 
 ARTICLE: "io.directories.search" "Searching directories"
@@ -65,10 +91,13 @@ ARTICLE: "io.directories.search" "Searching directories"
 { $subsection recursive-directory-files }
 { $subsection recursive-directory-entries }
 { $subsection each-file }
-"Finding files:"
+"Finding files by name:"
 { $subsection find-file }
 { $subsection find-all-files }
 { $subsection find-in-directories }
-{ $subsection find-all-in-directories } ;
+{ $subsection find-all-in-directories }
+"Finding files by extension:"
+{ $subsection find-by-extension }
+{ $subsection find-by-extensions } ;
 
 ABOUT: "io.directories.search"

basis/io/directories/search/search.factor

@@ -3,7 +3,7 @@
 USING: accessors arrays continuations deques dlists fry
 io.directories io.files io.files.info io.pathnames kernel
 sequences system vocabs.loader locals math namespaces
-sorting assocs calendar threads io math.parser ;
+sorting assocs calendar threads io math.parser unicode.case ;
 IN: io.directories.search
 
 : qualified-directory-entries ( path -- seq )
@@ -106,4 +106,11 @@ ERROR: file-not-found path bfs? quot ;
         ] { } map>assoc
     ] with-qualified-directory-entries sort-values ;
 
+: find-by-extensions ( path extensions -- seq )
+    [ >lower ] map
+    '[ >lower _ [ tail? ] with any? ] find-all-files ;
+    
+: find-by-extension ( path extension -- seq )
+    1array find-by-extensions ;
+
 os windows? [ "io.directories.search.windows" require ] when

basis/ui/backend/windows/windows.factor

@@ -616,19 +616,21 @@ M: windows-ui-backend do-events
     GetDoubleClickTime milliseconds double-click-timeout set-global ;
 
 : cleanup-win32-ui ( -- )
-    class-name-ptr get-global [ dup f UnregisterClass drop free ] when*
-    msg-obj get-global [ free ] when*
-    f class-name-ptr set-global
-    f msg-obj set-global ;
+    class-name-ptr [
+        [ [ f UnregisterClass drop ] [ free ] bi ] when* f
+    ] change-global
+    msg-obj change-global [ [ free ] when* f ] ;
 
-: get-dc ( world -- ) handle>> dup hWnd>> GetDC dup win32-error=0/f >>hDC drop ;
+: get-dc ( world -- )
+    handle>> dup hWnd>> GetDC dup win32-error=0/f >>hDC drop ;
 
 : get-rc ( world -- )
     handle>> dup hDC>> dup wglCreateContext dup win32-error=0/f
     [ wglMakeCurrent win32-error=0/f ] keep >>hRC drop ;
 
 : set-pixel-format ( pixel-format hdc -- )
-    swap handle>> "PIXELFORMATDESCRIPTOR" <c-object> SetPixelFormat win32-error=0/f ;
+    swap handle>>
+    "PIXELFORMATDESCRIPTOR" <c-object> SetPixelFormat win32-error=0/f ;
 
 : setup-gl ( world -- )
     [ get-dc ] keep
@@ -715,6 +717,7 @@ M: windows-ui-backend beep ( -- )
 M: windows-ui-backend (grab-input) ( handle -- )
     0 ShowCursor drop
     hWnd>> client-area>RECT ClipCursor drop ;
+
 M: windows-ui-backend (ungrab-input) ( handle -- )
     drop
     f ClipCursor drop

basis/urls/encoding/encoding-tests.factor

@@ -2,8 +2,8 @@ IN: urls.encoding.tests
 USING: urls.encoding tools.test arrays kernel assocs present accessors ;
 
 [ "~hello world" ] [ "%7ehello world" url-decode ] unit-test
-[ f ] [ "%XX%XX%XX" url-decode ] unit-test
-[ f ] [ "%XX%XX%X" url-decode ] unit-test
+[ "" ] [ "%XX%XX%XX" url-decode ] unit-test
+[ "" ] [ "%XX%XX%X" url-decode ] unit-test
 
 [ "hello world" ] [ "hello%20world" url-decode ] unit-test
 [ " ! "         ] [ "%20%21%20"     url-decode ] unit-test

basis/urls/urls.factor

@@ -25,12 +25,14 @@ TUPLE: url protocol username password host port path query anchor ;
     ] if ;
 
 : parse-host ( string -- host port )
-    ":" split1 [ url-decode ] [
-        dup [
-            string>number
-            dup [ "Invalid port" throw ] unless
-        ] when
-    ] bi* ;
+    [
+        ":" split1 [ url-decode ] [
+            dup [
+                string>number
+                dup [ "Invalid port" throw ] unless
+            ] when
+        ] bi*
+    ] [ f f ] if* ;
 
 GENERIC: >url ( obj -- url )
 

extra/crypto/rsa/rsa.factor

@@ -21,7 +21,7 @@ C: <rsa> rsa
 CONSTANT: public-key 65537
 
 : rsa-primes ( numbits -- p q )
-    2/ 2 unique-primes first2 ;
+    2/ 2 swap unique-primes first2 ;
 
 : modulus-phi ( numbits -- n phi ) 
     #! Loop until phi is not divisible by the public key.

extra/id3/id3.factor

@@ -233,8 +233,7 @@ PRIVATE>
 : genre ( id3 -- string/f )
     "TCON" find-id3-frame parse-genre ;
 
-: find-mp3s ( path -- seq )
-    [ >lower ".mp3" tail? ] find-all-files ;
+: find-mp3s ( path -- seq ) ".mp3" find-by-extension ;
 
 ERROR: id3-parse-error path error ;