From 86070337fd372fff42d6685e2d962c5224ecc11e Mon Sep 17 00:00:00 2001 From: "U-EE860\\Administrator" Date: Sat, 24 Nov 2007 02:17:40 +0100 Subject: [PATCH 01/10] Refactor open-file to allow flags and attributes as the fourth parameter --- extra/io/windows/ce/files/files.factor | 3 ++- extra/io/windows/mmap/mmap.factor | 2 +- extra/io/windows/nt/files/files.factor | 4 ++-- extra/io/windows/windows.factor | 18 ++++++++++-------- 4 files changed, 15 insertions(+), 12 deletions(-) diff --git a/extra/io/windows/ce/files/files.factor b/extra/io/windows/ce/files/files.factor index df5dc65094..c4f5b2ef9e 100755 --- a/extra/io/windows/ce/files/files.factor +++ b/extra/io/windows/ce/files/files.factor @@ -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 -- ) diff --git a/extra/io/windows/mmap/mmap.factor b/extra/io/windows/mmap/mmap.factor index ca5d2bbd9a..27587e8340 100755 --- a/extra/io/windows/mmap/mmap.factor +++ b/extra/io/windows/mmap/mmap.factor @@ -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 diff --git a/extra/io/windows/nt/files/files.factor b/extra/io/windows/nt/files/files.factor index d53f5fcb40..5eed39224c 100755 --- a/extra/io/windows/nt/files/files.factor +++ b/extra/io/windows/nt/files/files.factor @@ -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 ; diff --git a/extra/io/windows/windows.factor b/extra/io/windows/windows.factor index ac0ede0e06..b0ec7f8436 100755 --- a/extra/io/windows/windows.factor +++ b/extra/io/windows/windows.factor @@ -23,7 +23,7 @@ TUPLE: win32-file handle ptr overlapped ; : ( in out -- stream ) >r f r> f 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 +31,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 +41,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 FILE_BEGIN SetFilePointer From 3d0304e61445c8fc345aab1a96545c7548fe5bb2 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 5 Dec 2007 01:44:20 -0600 Subject: [PATCH 02/10] Fix bootstrap --- extra/windows/nt/nt.factor | 2 -- 1 file changed, 2 deletions(-) diff --git a/extra/windows/nt/nt.factor b/extra/windows/nt/nt.factor index a485beba00..8a709416d8 100644 --- a/extra/windows/nt/nt.factor +++ b/extra/windows/nt/nt.factor @@ -13,5 +13,3 @@ USING: alien sequences ; { "glu" "glu32.dll" "stdcall" } { "freetype" "freetype6.dll" "cdecl" } } [ first3 add-library ] each - -USING: windows.shell32 ; From 244558f48d79a02ee076f74262dca585b9235d7d Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 5 Dec 2007 08:46:18 -0600 Subject: [PATCH 03/10] Add open-in-explorer --- extra/windows/shell32/shell32.factor | 21 ++++++++++++++++++++- 1 file changed, 20 insertions(+), 1 deletion(-) diff --git a/extra/windows/shell32/shell32.factor b/extra/windows/shell32/shell32.factor index a6599df637..98ad6b0bd9 100644 --- a/extra/windows/shell32/shell32.factor +++ b/extra/windows/shell32/shell32.factor @@ -67,13 +67,27 @@ IN: windows.shell32 : CSIDL_FLAG_CREATE HEX: 8000 ; inline : CSIDL_FLAG_MASK HEX: ff00 ; inline +: SW_HIDE 0 ; inline +: SW_SHOWNORMAL 1 ; inline +: SW_NORMAL 1 ; inline +: SW_SHOWMINIMIZED 2 ; inline +: SW_SHOWMAXIMIZED 3 ; inline +: SW_MAXIMIZE 3 ; inline +: SW_SHOWNOACTIVATE 4 ; inline +: SW_SHOW 5 ; inline +: SW_MINIMIZE 6 ; inline +: SW_SHOWMINNOACTIVE 7 ; inline +: SW_SHOWNA 8 ; inline +: SW_RESTORE 9 ; inline +: SW_SHOWDEFAULT 10 ; inline +: SW_MAX 10 ; 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 @@ -83,6 +97,11 @@ TYPEDEF: void* PIDLIST_ABSOLUTE FUNCTION: HRESULT SHGetFolderPathW ( HWND hwndOwner, int nFolder, HANDLE hToken, DWORD dwReserved, LPTSTR pszPath ) ; ! SHGetSpecialFolderLocation ! SHGetSpecialFolderPath +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 ; : SHGetFolderPath SHGetFolderPathW ; inline From 9143e843b110f39a55253b72ae98331a36569a2f Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 5 Dec 2007 09:00:15 -0600 Subject: [PATCH 04/10] Force windows.shell32 to load when UI loads Remove duplicated code --- extra/ui/windows/windows.factor | 4 ++-- extra/windows/shell32/shell32.factor | 16 +--------------- 2 files changed, 3 insertions(+), 17 deletions(-) diff --git a/extra/ui/windows/windows.factor b/extra/ui/windows/windows.factor index 3d95e281aa..9ee9994d95 100755 --- a/extra/ui/windows/windows.factor +++ b/extra/ui/windows/windows.factor @@ -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.shell32 windows.opengl32 windows.messages windows.types +windows.nt windows threads timers libc combinators continuations command-line shuffle opengl ui.render ; IN: ui.windows diff --git a/extra/windows/shell32/shell32.factor b/extra/windows/shell32/shell32.factor index 98ad6b0bd9..25d265479e 100644 --- a/extra/windows/shell32/shell32.factor +++ b/extra/windows/shell32/shell32.factor @@ -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,20 +67,6 @@ IN: windows.shell32 : CSIDL_FLAG_CREATE HEX: 8000 ; inline : CSIDL_FLAG_MASK HEX: ff00 ; inline -: SW_HIDE 0 ; inline -: SW_SHOWNORMAL 1 ; inline -: SW_NORMAL 1 ; inline -: SW_SHOWMINIMIZED 2 ; inline -: SW_SHOWMAXIMIZED 3 ; inline -: SW_MAXIMIZE 3 ; inline -: SW_SHOWNOACTIVATE 4 ; inline -: SW_SHOW 5 ; inline -: SW_MINIMIZE 6 ; inline -: SW_SHOWMINNOACTIVE 7 ; inline -: SW_SHOWNA 8 ; inline -: SW_RESTORE 9 ; inline -: SW_SHOWDEFAULT 10 ; inline -: SW_MAX 10 ; inline : S_OK 0 ; inline : S_FALSE 1 ; inline From 6ffd6456c4b892ff7a8ea63cc5cb17f7d6907765 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 5 Dec 2007 09:42:08 -0600 Subject: [PATCH 05/10] Add some code to build up all possible quotations with random-tester --- extra/random-tester/utils/utils.factor | 12 +++++++++++- 1 file changed, 11 insertions(+), 1 deletion(-) diff --git a/extra/random-tester/utils/utils.factor b/extra/random-tester/utils/utils.factor index ef3d66ad2d..91aefabe6f 100644 --- a/extra/random-tester/utils/utils.factor +++ b/extra/random-tester/utils/utils.factor @@ -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,13 @@ C: p-list >r make-p-list r> (each-permutation) ; +MEMO: builder-permutations ( n -- seq ) + { compose curry } swap permutations + [ >quotation ] 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 From 70299ba86a26d7721d47ff4852cc0732f77d7589 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 5 Dec 2007 09:49:39 -0600 Subject: [PATCH 06/10] Fix bug curry -> swap curry --- extra/random-tester/utils/utils.factor | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/extra/random-tester/utils/utils.factor b/extra/random-tester/utils/utils.factor index 91aefabe6f..1c591a11e9 100644 --- a/extra/random-tester/utils/utils.factor +++ b/extra/random-tester/utils/utils.factor @@ -93,9 +93,9 @@ C: p-list >r make-p-list r> (each-permutation) ; -MEMO: builder-permutations ( n -- seq ) - { compose curry } swap permutations - [ >quotation ] map ; foldable +: builder-permutations ( n -- seq ) + { [ compose ] [ swap curry ] } swap permutations + [ concat ] map ; foldable : all-quot-permutations ( seq -- newseq ) dup length 1- builder-permutations @@ -103,3 +103,4 @@ MEMO: builder-permutations ( n -- seq ) [ 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 From ddd55ac4faab03e1c3ec2b7e7c1e2ecdc374bd58 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 5 Dec 2007 18:09:08 -0600 Subject: [PATCH 07/10] Experimental find-binary and find-library words --- core/io/files/files.factor | 14 ++++++++++++++ extra/io/windows/windows.factor | 12 +++++++++++- 2 files changed, 25 insertions(+), 1 deletion(-) diff --git a/core/io/files/files.factor b/core/io/files/files.factor index 1dd4259bb6..03bcb77731 100755 --- a/core/io/files/files.factor +++ b/core/io/files/files.factor @@ -126,3 +126,17 @@ TUPLE: pathname string ; C: 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 ; diff --git a/extra/io/windows/windows.factor b/extra/io/windows/windows.factor index d112a99cae..2defa48298 100755 --- a/extra/io/windows/windows.factor +++ b/extra/io/windows/windows.factor @@ -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 ; From 583b3abd7417d66eaa5a972b2fe26bbbdc71ae79 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 5 Dec 2007 18:10:55 -0600 Subject: [PATCH 08/10] Add windows word to shell32 --- extra/windows/shell32/shell32.factor | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/extra/windows/shell32/shell32.factor b/extra/windows/shell32/shell32.factor index 25d265479e..501f49edfe 100644 --- a/extra/windows/shell32/shell32.factor +++ b/extra/windows/shell32/shell32.factor @@ -79,18 +79,15 @@ IN: windows.shell32 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 ; -: SHGetFolderPath SHGetFolderPathW ; inline - : shell32-error ( n -- ) dup S_OK = [ drop @@ -116,6 +113,9 @@ FUNCTION: HINSTANCE ShellExecuteW ( HWND hwnd, LPCTSTR lpOperation, LPCTSTR lpFi : application-data ( -- str ) CSIDL_APPDATA shell32-directory ; +: windows ( -- str ) + CSIDL_WINDOWS shell32-directory ; + : programs ( -- str ) CSIDL_PROGRAMS shell32-directory ; From 7d30e47bca9eec18d00def7a6e9905f31b4bec5c Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 5 Dec 2007 19:49:29 -0600 Subject: [PATCH 09/10] Add library-roots and binary-roots for linux/mac --- extra/io/unix/files/files.factor | 18 ++++++++++++++++++ 1 file changed, 18 insertions(+) diff --git a/extra/io/unix/files/files.factor b/extra/io/unix/files/files.factor index f9d642d661..8f1d05876d 100755 --- a/extra/io/unix/files/files.factor +++ b/extra/io/unix/files/files.factor @@ -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" + } ; From dcec7beab2211ae14ad266fcf8a6a211d1b2e218 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Thu, 6 Dec 2007 01:12:02 -0600 Subject: [PATCH 10/10] Fix 'windows' shadowing --- extra/ui/windows/windows.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/ui/windows/windows.factor b/extra/ui/windows/windows.factor index 9ee9994d95..0146deed98 100755 --- a/extra/ui/windows/windows.factor +++ b/extra/ui/windows/windows.factor @@ -4,7 +4,7 @@ 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.shell32 windows.opengl32 windows.messages windows.types +windows.opengl32 windows.messages windows.types windows.nt windows threads timers libc combinators continuations command-line shuffle opengl ui.render ; IN: ui.windows