steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Merge commit 'erg/master'

release
Slava Pestov 2007-12-07 14:24:54 -05:00
parent ab8b15693f dcec7beab2
commit 0d7ea67bcf
10 changed files with 83 additions and 24 deletions
core/io/files
extra
io
random-tester/utils
ui/windows
windows

14
core/io/files/files.factor
View File

@ -126,3 +126,17 @@ TUPLE: pathname string ;
C: <pathname> pathname
M: pathname <=> [ pathname-string ] compare ;
HOOK: library-roots io-backend ( -- seq )
HOOK: binary-roots io-backend ( -- seq )
: find-file ( seq str -- path/f )
[
[ path+ exists? ] curry find nip
] keep over [ path+ ] [ drop ] if ;
: find-library ( str -- path/f )
library-roots swap find-file ;
: find-binary ( str -- path/f )
binary-roots swap find-file ;

18
extra/io/unix/files/files.factor
View File

@ -38,3 +38,21 @@ M: unix-io make-directory ( path -- )
M: unix-io delete-directory ( path -- )
rmdir io-error ;
M: unix-io binary-roots ( -- seq )
{
"/bin" "/sbin"
"/usr/bin" "/usr/sbin"
"/usr/local/bin" "/usr/local/sbin"
"/opt/local/bin" "/opt/local/sbin"
"~/bin"
} ;
M: unix-io library-roots ( -- seq )
{
"/lib"
"/usr/lib"
"/usr/local/lib"
"/opt/local/lib"
"/lib64"
} ;

3
extra/io/windows/ce/files/files.factor
View File

@ -7,7 +7,8 @@ IN: windows.ce.files
! M: windows-ce-io normalize-pathname ( string -- string )
! dup 1 tail* CHAR: \\ = [ "*" append ] [ "\\*" append ] if ;
M: windows-ce-io CreateFile-flags ( -- DWORD ) FILE_ATTRIBUTE_NORMAL ;
M: windows-ce-io CreateFile-flags ( DWORD -- DWORD )
FILE_ATTRIBUTE_NORMAL bitor ;
M: windows-ce-io FileArgs-overlapped ( port -- f ) drop f ;
: finish-read ( port status bytes-ret -- )

2
extra/io/windows/mmap/mmap.factor
View File

@ -62,7 +62,7 @@ M: windows-ce-io with-privileges
: mmap-open ( path access-mode create-mode flProtect access -- handle handle address )
{ "SeCreateGlobalPrivilege" "SeLockMemoryPrivilege" } [
>r >r open-file dup f r> 0 0 f
>r >r 0 open-file dup f r> 0 0 f
CreateFileMapping [ win32-error=0/f ] keep
dup close-later
dup

4
extra/io/windows/nt/files/files.factor
View File

@ -3,8 +3,8 @@ io.windows.nt io.windows.nt.backend kernel libc math
threads windows windows.kernel32 ;
IN: io.windows.nt.files
M: windows-nt-io CreateFile-flags ( -- DWORD )
FILE_FLAG_OVERLAPPED ;
M: windows-nt-io CreateFile-flags ( DWORD -- DWORD )
FILE_FLAG_OVERLAPPED bitor ;
M: windows-nt-io FileArgs-overlapped ( port -- overlapped )
make-overlapped ;

30
extra/io/windows/windows.factor
View File

@ -4,13 +4,23 @@ USING: alien alien.c-types arrays destructors io io.backend
io.buffers io.files io.nonblocking io.sockets io.binary
io.sockets.impl windows.errors strings io.streams.duplex kernel
math namespaces sequences windows windows.kernel32
windows.winsock splitting ;
windows.shell32 windows.winsock splitting ;
IN: io.windows
TUPLE: windows-nt-io ;
TUPLE: windows-ce-io ;
UNION: windows-io windows-nt-io windows-ce-io ;
M: windows-io library-roots ( -- seq )
[
windows ,
] { } make ;
M: windows-io binary-roots ( -- seq )
[
windows ,
] { } make ;
M: windows-io destruct-handle CloseHandle drop ;
M: windows-io destruct-socket closesocket drop ;
@ -23,7 +33,7 @@ TUPLE: win32-file handle ptr overlapped ;
: <win32-duplex-stream> ( in out -- stream )
>r f <win32-file> r> f <win32-file> handle>duplex-stream ;
HOOK: CreateFile-flags io-backend ( -- DWORD )
HOOK: CreateFile-flags io-backend ( DWORD -- DWORD )
HOOK: FileArgs-overlapped io-backend ( port -- overlapped/f )
HOOK: add-completion io-backend ( port -- )
@ -31,7 +41,8 @@ M: windows-io normalize-directory ( string -- string )
"\\" ?tail drop "\\*" append ;
: share-mode ( -- fixnum )
FILE_SHARE_READ FILE_SHARE_WRITE bitor ; inline
FILE_SHARE_READ FILE_SHARE_WRITE bitor
FILE_SHARE_DELETE bitor ; foldable
M: win32-file init-handle ( handle -- )
drop ;
@ -40,24 +51,25 @@ M: win32-file close-handle ( handle -- )
win32-file-handle CloseHandle drop ;
! Clean up resources (open handle) if add-completion fails
: open-file ( path access-mode create-mode -- handle )
: open-file ( path access-mode create-mode flags -- handle )
[
>r share-mode f r> CreateFile-flags f CreateFile
>r >r >r normalize-pathname r>
share-mode f r> r> CreateFile-flags f CreateFile
dup invalid-handle? dup close-later
dup add-completion
] with-destructors ;
: open-pipe-r/w ( path -- handle )
GENERIC_READ GENERIC_WRITE bitor OPEN_EXISTING open-file ;
GENERIC_READ GENERIC_WRITE bitor OPEN_EXISTING 0 open-file ;
: open-read ( path -- handle length )
normalize-pathname GENERIC_READ OPEN_EXISTING open-file 0 ;
GENERIC_READ OPEN_EXISTING 0 open-file 0 ;
: open-write ( path -- handle length )
normalize-pathname GENERIC_WRITE CREATE_ALWAYS open-file 0 ;
GENERIC_WRITE CREATE_ALWAYS 0 open-file 0 ;
: (open-append) ( path -- handle )
normalize-pathname GENERIC_WRITE OPEN_ALWAYS open-file ;
GENERIC_WRITE OPEN_ALWAYS 0 open-file ;
: set-file-pointer ( handle length -- )
dupd d>w/w <uint> FILE_BEGIN SetFilePointer

13
extra/random-tester/utils/utils.factor
View File

@ -1,5 +1,5 @@
USING: arrays assocs combinators.lib continuations kernel
math math.functions namespaces quotations random sequences
math math.functions memoize namespaces quotations random sequences
sequences.private shuffle ;
IN: random-tester.utils
@ -93,3 +93,14 @@ C: <p-list> p-list
>r make-p-list r> (each-permutation) ;
: builder-permutations ( n -- seq )
{ [ compose ] [ swap curry ] } swap permutations
[ concat ] map ; foldable
: all-quot-permutations ( seq -- newseq )
dup length 1- builder-permutations
swap [ 1quotation ] map dup length permutations
[ swap [ >r seq>stack r> call ] curry* map ] curry* map ;
! clear { map sq 10 } all-quot-permutations [ [ [ [ [ call ] keep datastack length 2 = [ . .s nl ] when ] catch ] in-thread drop ] each ] each
! clear { map sq sq 10 } all-quot-permutations [ [ [ [ [ call ] keep datastack length 2 = [ . .s nl ] when ] catch ] in-thread drop ] each ] each

4
extra/ui/windows/windows.factor
View File

@ -4,8 +4,8 @@ USING: alien alien.c-types arrays assocs ui ui.gadgets
ui.backend ui.clipboards ui.gadgets.worlds ui.gestures io kernel
math math.vectors namespaces prettyprint sequences strings
vectors words windows.kernel32 windows.gdi32 windows.user32
windows.opengl32 windows.messages windows.types windows.nt
windows threads timers libc combinators continuations
windows.opengl32 windows.messages windows.types
windows.nt windows threads timers libc combinators continuations
command-line shuffle opengl ui.render ;
IN: ui.windows

2
extra/windows/nt/nt.factor
View File

@ -13,5 +13,3 @@ USING: alien sequences ;
{ "glu" "glu32.dll" "stdcall" }
{ "freetype" "freetype6.dll" "cdecl" }
} [ first3 add-library ] each
USING: windows.shell32 ;

17
extra/windows/shell32/shell32.factor
View File

@ -1,5 +1,5 @@
USING: alien alien.c-types alien.syntax combinators
kernel windows ;
kernel windows windows.user32 ;
IN: windows.shell32
: CSIDL_DESKTOP HEX: 00 ; inline
@ -67,25 +67,27 @@ IN: windows.shell32
: CSIDL_FLAG_CREATE HEX: 8000 ; inline
: CSIDL_FLAG_MASK HEX: ff00 ; inline
: S_OK 0 ; inline
: S_FALSE 1 ; inline
: E_FAIL HEX: 80004005 ; inline
: E_INVALIDARG HEX: 80070057 ; inline
: ERROR_FILE_NOT_FOUND 2 ; inline
: SHGFP_TYPE_CURRENT 0 ; inline
: SHGFP_TYPE_DEFAULT 1 ; inline
LIBRARY: shell32
TYPEDEF: void* PIDLIST_ABSOLUTE
FUNCTION: HRESULT SHGetFolderPathW ( HWND hwndOwner, int nFolder, HANDLE hToken, DWORD dwReserved, LPTSTR pszPath ) ;
! SHGetSpecialFolderLocation
! SHGetSpecialFolderPath
: SHGetFolderPath SHGetFolderPathW ; inline
FUNCTION: HINSTANCE ShellExecuteW ( HWND hwnd, LPCTSTR lpOperation, LPCTSTR lpFile, LPCTSTR lpParameters, LPCTSTR lpDirectory, INT nShowCmd ) ;
: ShellExecute ShellExecuteW ; inline
: open-in-explorer ( dir -- )
f "open" rot f f SW_SHOWNORMAL ShellExecute drop ;
: shell32-error ( n -- )
dup S_OK = [
drop
@ -111,6 +113,9 @@ FUNCTION: HRESULT SHGetFolderPathW ( HWND hwndOwner, int nFolder, HANDLE hToken,
: application-data ( -- str )
CSIDL_APPDATA shell32-directory ;
: windows ( -- str )
CSIDL_WINDOWS shell32-directory ;
: programs ( -- str )
CSIDL_PROGRAMS shell32-directory ;