Merge git://spitspat.com/git/factor

release
Doug Coleman 2007-12-05 01:08:51 -06:00
commit 197d1e3d78
8 changed files with 159 additions and 8 deletions

View File

@ -1,5 +1,6 @@
USING: alien alien.c-types kernel libc math namespaces
windows windows.kernel32 windows.advapi32 hardware-info ;
windows windows.kernel32 windows.advapi32 hardware-info
words ;
IN: hardware-info.windows
TUPLE: wince ;
@ -53,6 +54,22 @@ M: windows cpus ( -- n )
: sse3? ( -- ? )
PF_SSE3_INSTRUCTIONS_AVAILABLE feature-present? ;
: <u16-string-object> ( n -- obj )
"ushort" <c-array> ;
: get-directory ( word -- str )
>r MAX_UNICODE_PATH [ <u16-string-object> ] keep dupd r>
execute win32-error=0/f alien>u16-string ; inline
: windows-directory ( -- str )
\ GetWindowsDirectory get-directory ;
: system-directory ( -- str )
\ GetSystemDirectory get-directory ;
: system-windows-directory ( -- str )
\ GetSystemWindowsDirectory get-directory ;
USE-IF: wince? hardware-info.windows.ce
USE-IF: winnt? hardware-info.windows.nt

View File

@ -99,5 +99,5 @@ C: <entry> entry
feed-entries [ entry, ] each
] make-xml* ;
: write-feed ( feed -- xml )
: write-feed ( feed -- )
feed>xml write-xml ;

View File

@ -11,7 +11,7 @@ TUPLE: posting author title date link body ;
: fetch-feed ( pair -- feed )
second
dup "Fetching " diagnostic
dup news-get feed-entries
dup download-feed feed-entries
swap "Done fetching " diagnostic ;
: fetch-blogroll ( blogroll -- entries )
@ -130,9 +130,9 @@ SYMBOL: last-update
[ feed-entries ] map concat sort-entries ;
: planet-feed ( -- feed )
default-blogroll get [ second news-get ] map merge-feeds
default-blogroll get [ second download-feed ] map merge-feeds
>r "[ planet-factor ]" "http://planet.factorcode.org" r> <entry>
generate-atom ;
feed>xml ;
: feed.xml planet-feed ;

View File

@ -1010,7 +1010,8 @@ FUNCTION: HANDLE GetStdHandle ( DWORD nStdHandle ) ;
! FUNCTION: GetSystemDefaultLCID
! FUNCTION: GetSystemDefaultUILanguage
! FUNCTION: GetSystemDirectoryA
! FUNCTION: GetSystemDirectoryW
FUNCTION: UINT GetSystemDirectoryW ( LPTSTR lpBuffer, UINT uSize ) ;
: GetSystemDirectory GetSystemDirectoryW ; inline
FUNCTION: void GetSystemInfo ( LPSYSTEM_INFO lpSystemInfo ) ;
! FUNCTION: GetSystemPowerStatus
! FUNCTION: GetSystemRegistryQuota
@ -1019,7 +1020,8 @@ FUNCTION: void GetSystemTime ( LPSYSTEMTIME lpSystemTime ) ;
FUNCTION: void GetSystemTimeAsFileTime ( LPFILETIME lpSystemTimeAsFileTime ) ;
! FUNCTION: GetSystemTimes
! FUNCTION: GetSystemWindowsDirectoryA
! FUNCTION: GetSystemWindowsDirectoryW
FUNCTION: UINT GetSystemWindowsDirectoryW ( LPTSTR lpBuffer, UINT uSize ) ;
: GetSystemWindowsDirectory GetSystemWindowsDirectoryW ; inline
! FUNCTION: GetSystemWow64DirectoryA
! FUNCTION: GetSystemWow64DirectoryW
! FUNCTION: GetTapeParameters
@ -1057,7 +1059,8 @@ FUNCTION: BOOL GetVersionExW ( LPOSVERSIONINFO lpVersionInfo ) ;
! FUNCTION: GetVolumePathNamesForVolumeNameW
! FUNCTION: GetVolumePathNameW
! FUNCTION: GetWindowsDirectoryA
! FUNCTION: GetWindowsDirectoryW
FUNCTION: UINT GetWindowsDirectoryW ( LPTSTR lpBuffer, UINT uSize ) ;
: GetWindowsDirectory GetWindowsDirectoryW ; inline
! FUNCTION: GetWriteWatch
! FUNCTION: GlobalAddAtomA
! FUNCTION: GlobalAddAtomW

View File

@ -6,9 +6,12 @@ USING: alien sequences ;
{ "kernel32" "kernel32.dll" "stdcall" }
{ "winsock" "ws2_32.dll" "stdcall" }
{ "mswsock" "mswsock.dll" "stdcall" }
{ "shell32" "shell32.dll" "stdcall" }
{ "libc" "msvcrt.dll" "cdecl" }
{ "libm" "msvcrt.dll" "cdecl" }
{ "gl" "opengl32.dll" "stdcall" }
{ "glu" "glu32.dll" "stdcall" }
{ "freetype" "freetype6.dll" "cdecl" }
} [ first3 add-library ] each
USING: windows.shell32 ;

View File

@ -0,0 +1,127 @@
USING: alien alien.c-types alien.syntax combinators
kernel windows ;
IN: windows.shell32
: CSIDL_DESKTOP HEX: 00 ; inline
: CSIDL_INTERNET HEX: 01 ; inline
: CSIDL_PROGRAMS HEX: 02 ; inline
: CSIDL_CONTROLS HEX: 03 ; inline
: CSIDL_PRINTERS HEX: 04 ; inline
: CSIDL_PERSONAL HEX: 05 ; inline
: CSIDL_FAVORITES HEX: 06 ; inline
: CSIDL_STARTUP HEX: 07 ; inline
: CSIDL_RECENT HEX: 08 ; inline
: CSIDL_SENDTO HEX: 09 ; inline
: CSIDL_BITBUCKET HEX: 0a ; inline
: CSIDL_STARTMENU HEX: 0b ; inline
: CSIDL_MYDOCUMENTS HEX: 0c ; inline
: CSIDL_MYMUSIC HEX: 0d ; inline
: CSIDL_MYVIDEO HEX: 0e ; inline
: CSIDL_DESKTOPDIRECTORY HEX: 10 ; inline
: CSIDL_DRIVES HEX: 11 ; inline
: CSIDL_NETWORK HEX: 12 ; inline
: CSIDL_NETHOOD HEX: 13 ; inline
: CSIDL_FONTS HEX: 14 ; inline
: CSIDL_TEMPLATES HEX: 15 ; inline
: CSIDL_COMMON_STARTMENU HEX: 16 ; inline
: CSIDL_COMMON_PROGRAMS HEX: 17 ; inline
: CSIDL_COMMON_STARTUP HEX: 18 ; inline
: CSIDL_COMMON_DESKTOPDIRECTORY HEX: 19 ; inline
: CSIDL_APPDATA HEX: 1a ; inline
: CSIDL_PRINTHOOD HEX: 1b ; inline
: CSIDL_LOCAL_APPDATA HEX: 1c ; inline
: CSIDL_ALTSTARTUP HEX: 1d ; inline
: CSIDL_COMMON_ALTSTARTUP HEX: 1e ; inline
: CSIDL_COMMON_FAVORITES HEX: 1f ; inline
: CSIDL_INTERNET_CACHE HEX: 20 ; inline
: CSIDL_COOKIES HEX: 21 ; inline
: CSIDL_HISTORY HEX: 22 ; inline
: CSIDL_COMMON_APPDATA HEX: 23 ; inline
: CSIDL_WINDOWS HEX: 24 ; inline
: CSIDL_SYSTEM HEX: 25 ; inline
: CSIDL_PROGRAM_FILES HEX: 26 ; inline
: CSIDL_MYPICTURES HEX: 27 ; inline
: CSIDL_PROFILE HEX: 28 ; inline
: CSIDL_SYSTEMX86 HEX: 29 ; inline
: CSIDL_PROGRAM_FILESX86 HEX: 2a ; inline
: CSIDL_PROGRAM_FILES_COMMON HEX: 2b ; inline
: CSIDL_PROGRAM_FILES_COMMONX86 HEX: 2c ; inline
: CSIDL_COMMON_TEMPLATES HEX: 2d ; inline
: CSIDL_COMMON_DOCUMENTS HEX: 2e ; inline
: CSIDL_COMMON_ADMINTOOLS HEX: 2f ; inline
: CSIDL_ADMINTOOLS HEX: 30 ; inline
: CSIDL_CONNECTIONS HEX: 31 ; inline
: CSIDL_COMMON_MUSIC HEX: 35 ; inline
: CSIDL_COMMON_PICTURES HEX: 36 ; inline
: CSIDL_COMMON_VIDEO HEX: 37 ; inline
: CSIDL_RESOURCES HEX: 38 ; inline
: CSIDL_RESOURCES_LOCALIZED HEX: 39 ; inline
: CSIDL_COMMON_OEM_LINKS HEX: 3a ; inline
: CSIDL_CDBURN_AREA HEX: 3b ; inline
: CSIDL_COMPUTERSNEARME HEX: 3d ; inline
: CSIDL_PROFILES HEX: 3e ; inline
: CSIDL_FOLDER_MASK HEX: ff ; inline
: CSIDL_FLAG_PER_USER_INIT HEX: 800 ; inline
: CSIDL_FLAG_NO_ALIAS HEX: 1000 ; inline
: CSIDL_FLAG_DONT_VERIFY HEX: 4000 ; inline
: 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
: shell32-error ( n -- )
dup S_OK = [
drop
] [
{
! { ERROR_FILE_NOT_FOUND [ "file not found" throw ] }
! { E_INVALIDARG [ "invalid arg" throw ] }
[ (win32-error-string) throw ]
} case
] if ;
: shell32-directory ( n -- str )
f swap f SHGFP_TYPE_DEFAULT
MAX_UNICODE_PATH "ushort" <c-array>
[ SHGetFolderPath shell32-error ] keep alien>u16-string ;
: desktop ( -- str )
CSIDL_DESKTOPDIRECTORY shell32-directory ;
: my-documents ( -- str )
CSIDL_PERSONAL shell32-directory ;
: application-data ( -- str )
CSIDL_APPDATA shell32-directory ;
: programs ( -- str )
CSIDL_PROGRAMS shell32-directory ;
: program-files ( -- str )
CSIDL_PROGRAM_FILES shell32-directory ;
: program-files-x86 ( -- str )
CSIDL_PROGRAM_FILESX86 shell32-directory ;
: program-files-common ( -- str )
CSIDL_PROGRAM_FILES_COMMON shell32-directory ;
: program-files-common-x86 ( -- str )
CSIDL_PROGRAM_FILES_COMMONX86 shell32-directory ;

View File

@ -7,6 +7,7 @@ IN: windows
: lo-word ( wparam -- lo ) <short> *short ; inline
: hi-word ( wparam -- hi ) -16 shift lo-word ; inline
: MAX_UNICODE_PATH 32768 ; inline
! You must LocalFree the return value!
FUNCTION: void* error_message ( DWORD id ) ;