Merge branch 'master' of git://factorcode.org/git/factor
						commit
						ef6debeced
					
				| 
						 | 
				
			
			@ -1,15 +1,17 @@
 | 
			
		|||
! Copyright (C) 2008 Doug Coleman.
 | 
			
		||||
! See http://factorcode.org/license.txt for BSD license.
 | 
			
		||||
USING: alien.strings fry io.encodings.utf16 kernel
 | 
			
		||||
splitting windows windows.kernel32 ;
 | 
			
		||||
splitting windows windows.kernel32 system environment
 | 
			
		||||
alien.c-types sequences windows.errors io.streams.memory
 | 
			
		||||
io.encodings io ;
 | 
			
		||||
IN: environment.winnt
 | 
			
		||||
 | 
			
		||||
M: winnt os-env ( key -- value )
 | 
			
		||||
    MAX_UNICODE_PATH "TCHAR" <c-array>
 | 
			
		||||
    [ GetEnvironmentVariable ] keep over 0 = [
 | 
			
		||||
    [ dup length GetEnvironmentVariable ] keep over 0 = [
 | 
			
		||||
        2drop f
 | 
			
		||||
    ] [
 | 
			
		||||
        nip utf16 alien>string
 | 
			
		||||
        nip utf16n alien>string
 | 
			
		||||
    ] if ;
 | 
			
		||||
 | 
			
		||||
M: winnt set-os-env ( value key -- )
 | 
			
		||||
| 
						 | 
				
			
			@ -22,4 +24,10 @@ M: winnt unset-os-env ( key -- )
 | 
			
		|||
    ] when ;
 | 
			
		||||
 | 
			
		||||
M: winnt (os-envs) ( -- seq )
 | 
			
		||||
    GetEnvironmentStrings [ "\0" split ] [ FreeEnvironmentStrings ] bi ;
 | 
			
		||||
    GetEnvironmentStrings [
 | 
			
		||||
        <memory-stream> [
 | 
			
		||||
            utf16n decode-input
 | 
			
		||||
            [ "\0" read-until drop dup empty? not ]
 | 
			
		||||
            [ ] [ drop ] produce
 | 
			
		||||
        ] with-input-stream*
 | 
			
		||||
    ] [ FreeEnvironmentStrings win32-error=0/f ] bi ;
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -4,6 +4,7 @@ IN: windows.errors
 | 
			
		|||
: ERROR_SUCCESS 0 ; inline
 | 
			
		||||
: ERROR_HANDLE_EOF 38 ; inline
 | 
			
		||||
: ERROR_BROKEN_PIPE 109 ; inline
 | 
			
		||||
: ERROR_ENVVAR_NOT_FOUND 203 ; inline
 | 
			
		||||
: ERROR_IO_INCOMPLETE 996 ; inline
 | 
			
		||||
: ERROR_IO_PENDING 997 ; inline
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -838,7 +838,8 @@ ALIAS: FindNextFile FindNextFileW
 | 
			
		|||
! FUNCTION: FormatMessageW
 | 
			
		||||
! FUNCTION: FreeConsole
 | 
			
		||||
! FUNCTION: FreeEnvironmentStringsA
 | 
			
		||||
! FUNCTION: FreeEnvironmentStringsW
 | 
			
		||||
FUNCTION: BOOL FreeEnvironmentStringsW ( LPTCH lpszEnvironmentBlock ) ;
 | 
			
		||||
ALIAS: FreeEnvironmentStrings FreeEnvironmentStringsW
 | 
			
		||||
! FUNCTION: FreeLibrary
 | 
			
		||||
! FUNCTION: FreeLibraryAndExitThread
 | 
			
		||||
! FUNCTION: FreeResource
 | 
			
		||||
| 
						 | 
				
			
			@ -933,11 +934,12 @@ FUNCTION: HANDLE GetCurrentThread ( ) ;
 | 
			
		|||
! FUNCTION: GetDllDirectoryW
 | 
			
		||||
! FUNCTION: GetDriveTypeA
 | 
			
		||||
! FUNCTION: GetDriveTypeW
 | 
			
		||||
FUNCTION: LPTCH GetEnvironmentStrings ( ) ;
 | 
			
		||||
FUNCTION: void* GetEnvironmentStringsW ( ) ;
 | 
			
		||||
! FUNCTION: GetEnvironmentStringsA
 | 
			
		||||
ALIAS: GetEnvironmentStrings GetEnvironmentStringsW
 | 
			
		||||
! FUNCTION: GetEnvironmentVariableA
 | 
			
		||||
! FUNCTION: GetEnvironmentVariableW
 | 
			
		||||
FUNCTION: DWORD GetEnvironmentVariableW ( LPCTSTR lpName, LPTSTR lpBuffer, DWORD nSize ) ;
 | 
			
		||||
ALIAS: GetEnvironmentVariable GetEnvironmentVariableW
 | 
			
		||||
FUNCTION: BOOL GetExitCodeProcess ( HANDLE hProcess, LPDWORD lpExitCode ) ;
 | 
			
		||||
! FUNCTION: GetExitCodeThread
 | 
			
		||||
! FUNCTION: GetExpandedNameA
 | 
			
		||||
| 
						 | 
				
			
			@ -1418,7 +1420,8 @@ ALIAS: SetCurrentDirectory SetCurrentDirectoryW
 | 
			
		|||
! FUNCTION: SetDllDirectoryW
 | 
			
		||||
FUNCTION: BOOL SetEndOfFile ( HANDLE hFile ) ;
 | 
			
		||||
! FUNCTION: SetEnvironmentVariableA
 | 
			
		||||
! FUNCTION: SetEnvironmentVariableW
 | 
			
		||||
FUNCTION: BOOL SetEnvironmentVariableW ( LPCTSTR key, LPCTSTR value ) ;
 | 
			
		||||
ALIAS: SetEnvironmentVariable SetEnvironmentVariableW
 | 
			
		||||
! FUNCTION: SetErrorMode
 | 
			
		||||
! FUNCTION: SetEvent
 | 
			
		||||
! FUNCTION: SetFileApisToANSI
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -64,13 +64,12 @@ TYPEDEF: ulonglong   DWORD64
 | 
			
		|||
TYPEDEF: longlong    LARGE_INTEGER
 | 
			
		||||
TYPEDEF: LARGE_INTEGER* PLARGE_INTEGER
 | 
			
		||||
 | 
			
		||||
TYPEDEF: WCHAR       TCHAR
 | 
			
		||||
TYPEDEF: TCHAR*      LPTCH
 | 
			
		||||
TYPEDEF: TCHAR       TBYTE
 | 
			
		||||
TYPEDEF: wchar_t*  LPCSTR
 | 
			
		||||
TYPEDEF: wchar_t*  LPWSTR
 | 
			
		||||
 | 
			
		||||
 | 
			
		||||
TYPEDEF: WCHAR       TCHAR
 | 
			
		||||
TYPEDEF: LPWSTR      LPTCH
 | 
			
		||||
TYPEDEF: LPWSTR      PTCH
 | 
			
		||||
TYPEDEF: TCHAR       TBYTE
 | 
			
		||||
 | 
			
		||||
TYPEDEF: WORD                ATOM
 | 
			
		||||
TYPEDEF: BYTE                BOOLEAN
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
		Loading…
	
		Reference in New Issue