Merge branch 'master' into redis
commit
4173f99849
|
@ -259,8 +259,9 @@ M: long-long-type box-return ( type -- )
|
||||||
[ dup c-setter '[ _ <c-object> [ 0 @ ] keep ] ] bi
|
[ dup c-setter '[ _ <c-object> [ 0 @ ] keep ] ] bi
|
||||||
(( value -- c-ptr )) define-inline ;
|
(( value -- c-ptr )) define-inline ;
|
||||||
|
|
||||||
: c-bool> ( int -- ? )
|
: >c-bool ( ? -- int ) 1 0 ? ; inline
|
||||||
0 = not ; inline
|
|
||||||
|
: c-bool> ( int -- ? ) 0 = not ; inline
|
||||||
|
|
||||||
: define-primitive-type ( type name -- )
|
: define-primitive-type ( type name -- )
|
||||||
[ typedef ]
|
[ typedef ]
|
||||||
|
@ -409,8 +410,8 @@ CONSTANT: primitive-types
|
||||||
"uchar" define-primitive-type
|
"uchar" define-primitive-type
|
||||||
|
|
||||||
<c-type>
|
<c-type>
|
||||||
[ alien-unsigned-1 zero? not ] >>getter
|
[ alien-unsigned-1 c-bool> ] >>getter
|
||||||
[ [ 1 0 ? ] 2dip set-alien-unsigned-1 ] >>setter
|
[ [ >c-bool ] 2dip set-alien-unsigned-1 ] >>setter
|
||||||
1 >>size
|
1 >>size
|
||||||
1 >>align
|
1 >>align
|
||||||
"box_boolean" >>boxer
|
"box_boolean" >>boxer
|
||||||
|
|
|
@ -4,7 +4,7 @@ IN: base64.tests
|
||||||
|
|
||||||
[ "abcdefghijklmnopqrstuvwxyz" ] [ "abcdefghijklmnopqrstuvwxyz" ascii encode >base64 base64> ascii decode
|
[ "abcdefghijklmnopqrstuvwxyz" ] [ "abcdefghijklmnopqrstuvwxyz" ascii encode >base64 base64> ascii decode
|
||||||
] unit-test
|
] 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
|
[ "a" ] [ "a" ascii encode >base64 base64> ascii decode ] unit-test
|
||||||
[ "ab" ] [ "ab" 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
|
[ "abc" ] [ "abc" ascii encode >base64 base64> ascii decode ] unit-test
|
||||||
|
|
|
@ -2,11 +2,11 @@
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: accessors assocs sequences kernel combinators make math
|
USING: accessors assocs sequences kernel combinators make math
|
||||||
math.order math.ranges system namespaces locals layouts words
|
math.order math.ranges system namespaces locals layouts words
|
||||||
alien alien.c-types literals cpu.architecture cpu.ppc.assembler
|
alien alien.accessors alien.c-types literals cpu.architecture
|
||||||
cpu.ppc.assembler.backend literals compiler.cfg.registers
|
cpu.ppc.assembler cpu.ppc.assembler.backend literals compiler.cfg.registers
|
||||||
compiler.cfg.instructions compiler.constants compiler.codegen
|
compiler.cfg.instructions compiler.constants compiler.codegen
|
||||||
compiler.codegen.fixup compiler.cfg.intrinsics
|
compiler.codegen.fixup compiler.cfg.intrinsics
|
||||||
compiler.cfg.stack-frame ;
|
compiler.cfg.stack-frame compiler.units ;
|
||||||
IN: cpu.ppc
|
IN: cpu.ppc
|
||||||
|
|
||||||
! PowerPC register assignments:
|
! PowerPC register assignments:
|
||||||
|
@ -713,4 +713,14 @@ USE: vocabs.loader
|
||||||
} cond
|
} cond
|
||||||
|
|
||||||
"complex-double" c-type t >>return-in-registers? drop
|
"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
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
! Copyright (C) 2009 Doug Coleman.
|
! Copyright (C) 2009 Doug Coleman.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! 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
|
IN: io.directories.search
|
||||||
|
|
||||||
HELP: each-file
|
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." } ;
|
{ $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
|
{ find-file find-all-files find-in-directories find-all-in-directories } related-words
|
||||||
|
|
||||||
ARTICLE: "io.directories.search" "Searching directories"
|
ARTICLE: "io.directories.search" "Searching directories"
|
||||||
|
@ -65,10 +91,13 @@ ARTICLE: "io.directories.search" "Searching directories"
|
||||||
{ $subsection recursive-directory-files }
|
{ $subsection recursive-directory-files }
|
||||||
{ $subsection recursive-directory-entries }
|
{ $subsection recursive-directory-entries }
|
||||||
{ $subsection each-file }
|
{ $subsection each-file }
|
||||||
"Finding files:"
|
"Finding files by name:"
|
||||||
{ $subsection find-file }
|
{ $subsection find-file }
|
||||||
{ $subsection find-all-files }
|
{ $subsection find-all-files }
|
||||||
{ $subsection find-in-directories }
|
{ $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"
|
ABOUT: "io.directories.search"
|
||||||
|
|
|
@ -3,7 +3,7 @@
|
||||||
USING: accessors arrays continuations deques dlists fry
|
USING: accessors arrays continuations deques dlists fry
|
||||||
io.directories io.files io.files.info io.pathnames kernel
|
io.directories io.files io.files.info io.pathnames kernel
|
||||||
sequences system vocabs.loader locals math namespaces
|
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
|
IN: io.directories.search
|
||||||
|
|
||||||
: qualified-directory-entries ( path -- seq )
|
: qualified-directory-entries ( path -- seq )
|
||||||
|
@ -106,4 +106,11 @@ ERROR: file-not-found path bfs? quot ;
|
||||||
] { } map>assoc
|
] { } map>assoc
|
||||||
] with-qualified-directory-entries sort-values ;
|
] 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
|
os windows? [ "io.directories.search.windows" require ] when
|
||||||
|
|
|
@ -616,19 +616,21 @@ M: windows-ui-backend do-events
|
||||||
GetDoubleClickTime milliseconds double-click-timeout set-global ;
|
GetDoubleClickTime milliseconds double-click-timeout set-global ;
|
||||||
|
|
||||||
: cleanup-win32-ui ( -- )
|
: cleanup-win32-ui ( -- )
|
||||||
class-name-ptr get-global [ dup f UnregisterClass drop free ] when*
|
class-name-ptr [
|
||||||
msg-obj get-global [ free ] when*
|
[ [ f UnregisterClass drop ] [ free ] bi ] when* f
|
||||||
f class-name-ptr set-global
|
] change-global
|
||||||
f msg-obj set-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 -- )
|
: get-rc ( world -- )
|
||||||
handle>> dup hDC>> dup wglCreateContext dup win32-error=0/f
|
handle>> dup hDC>> dup wglCreateContext dup win32-error=0/f
|
||||||
[ wglMakeCurrent win32-error=0/f ] keep >>hRC drop ;
|
[ wglMakeCurrent win32-error=0/f ] keep >>hRC drop ;
|
||||||
|
|
||||||
: set-pixel-format ( pixel-format hdc -- )
|
: 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 -- )
|
: setup-gl ( world -- )
|
||||||
[ get-dc ] keep
|
[ get-dc ] keep
|
||||||
|
@ -715,6 +717,7 @@ M: windows-ui-backend beep ( -- )
|
||||||
M: windows-ui-backend (grab-input) ( handle -- )
|
M: windows-ui-backend (grab-input) ( handle -- )
|
||||||
0 ShowCursor drop
|
0 ShowCursor drop
|
||||||
hWnd>> client-area>RECT ClipCursor drop ;
|
hWnd>> client-area>RECT ClipCursor drop ;
|
||||||
|
|
||||||
M: windows-ui-backend (ungrab-input) ( handle -- )
|
M: windows-ui-backend (ungrab-input) ( handle -- )
|
||||||
drop
|
drop
|
||||||
f ClipCursor drop
|
f ClipCursor drop
|
||||||
|
|
|
@ -2,8 +2,8 @@ IN: urls.encoding.tests
|
||||||
USING: urls.encoding tools.test arrays kernel assocs present accessors ;
|
USING: urls.encoding tools.test arrays kernel assocs present accessors ;
|
||||||
|
|
||||||
[ "~hello world" ] [ "%7ehello world" url-decode ] unit-test
|
[ "~hello world" ] [ "%7ehello world" url-decode ] unit-test
|
||||||
[ f ] [ "%XX%XX%XX" url-decode ] unit-test
|
[ "" ] [ "%XX%XX%XX" url-decode ] unit-test
|
||||||
[ f ] [ "%XX%XX%X" url-decode ] unit-test
|
[ "" ] [ "%XX%XX%X" url-decode ] unit-test
|
||||||
|
|
||||||
[ "hello world" ] [ "hello%20world" url-decode ] unit-test
|
[ "hello world" ] [ "hello%20world" url-decode ] unit-test
|
||||||
[ " ! " ] [ "%20%21%20" url-decode ] unit-test
|
[ " ! " ] [ "%20%21%20" url-decode ] unit-test
|
||||||
|
|
|
@ -25,12 +25,14 @@ TUPLE: url protocol username password host port path query anchor ;
|
||||||
] if ;
|
] if ;
|
||||||
|
|
||||||
: parse-host ( string -- host port )
|
: parse-host ( string -- host port )
|
||||||
|
[
|
||||||
":" split1 [ url-decode ] [
|
":" split1 [ url-decode ] [
|
||||||
dup [
|
dup [
|
||||||
string>number
|
string>number
|
||||||
dup [ "Invalid port" throw ] unless
|
dup [ "Invalid port" throw ] unless
|
||||||
] when
|
] when
|
||||||
] bi* ;
|
] bi*
|
||||||
|
] [ f f ] if* ;
|
||||||
|
|
||||||
GENERIC: >url ( obj -- url )
|
GENERIC: >url ( obj -- url )
|
||||||
|
|
||||||
|
|
|
@ -21,7 +21,7 @@ C: <rsa> rsa
|
||||||
CONSTANT: public-key 65537
|
CONSTANT: public-key 65537
|
||||||
|
|
||||||
: rsa-primes ( numbits -- p q )
|
: rsa-primes ( numbits -- p q )
|
||||||
2/ 2 unique-primes first2 ;
|
2/ 2 swap unique-primes first2 ;
|
||||||
|
|
||||||
: modulus-phi ( numbits -- n phi )
|
: modulus-phi ( numbits -- n phi )
|
||||||
#! Loop until phi is not divisible by the public key.
|
#! Loop until phi is not divisible by the public key.
|
||||||
|
|
|
@ -233,8 +233,7 @@ PRIVATE>
|
||||||
: genre ( id3 -- string/f )
|
: genre ( id3 -- string/f )
|
||||||
"TCON" find-id3-frame parse-genre ;
|
"TCON" find-id3-frame parse-genre ;
|
||||||
|
|
||||||
: find-mp3s ( path -- seq )
|
: find-mp3s ( path -- seq ) ".mp3" find-by-extension ;
|
||||||
[ >lower ".mp3" tail? ] find-all-files ;
|
|
||||||
|
|
||||||
ERROR: id3-parse-error path error ;
|
ERROR: id3-parse-error path error ;
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue