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

db4
Slava Pestov 2009-05-10 21:36:38 -05:00
commit dec89ac4fd
4 changed files with 50 additions and 12 deletions

View File

@ -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"

View File

@ -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

View File

@ -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

View File

@ -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 ;