basis/windows/windows.factor

   1 ! Copyright (C) 2005, 2006 Doug Coleman.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: alien alien.syntax alien.c-types alien.strings arrays
   4 combinators kernel math namespaces parser prettyprint sequences
   5 windows.errors windows.types windows.kernel32 words
   6 io.encodings.utf16n ;
   7 IN: windows
   8
   9 : lo-word ( wparam -- lo ) <short> *short ; inline
  10 : hi-word ( wparam -- hi ) -16 shift lo-word ; inline
  11 : MAX_UNICODE_PATH 32768 ; inline
  12
  13 ! You must LocalFree the return value!
  14 FUNCTION: void* error_message ( DWORD id ) ;
  15
  16 : (win32-error-string) ( n -- string )
  17     error_message
  18     dup utf16n alien>string
  19     swap LocalFree drop ;
  20
  21 : win32-error-string ( -- str )
  22     GetLastError (win32-error-string) ;
  23
  24 : (win32-error) ( n -- )
  25     dup zero? [
  26         drop
  27     ] [
  28         win32-error-string throw
  29     ] if ;
  30
  31 : win32-error ( -- )
  32     GetLastError (win32-error) ;
  33
  34 : win32-error=0/f ( n -- ) { 0 f } member? [ win32-error ] when ;
  35 : win32-error>0 ( n -- ) 0 > [ win32-error ] when ;
  36 : win32-error<0 ( n -- ) 0 < [ win32-error ] when ;
  37 : win32-error<>0 ( n -- ) zero? [ win32-error ] unless ;
  38
  39 : invalid-handle? ( handle -- )
  40     INVALID_HANDLE_VALUE = [
  41         win32-error-string throw
  42     ] when ;
  43
  44 : expected-io-errors ( -- seq )
  45     ERROR_SUCCESS
  46     ERROR_IO_INCOMPLETE
  47     ERROR_IO_PENDING
  48     WAIT_TIMEOUT 4array ; foldable
  49
  50 : expected-io-error? ( error-code -- ? )
  51     expected-io-errors member? ;
  52
  53 : expected-io-error ( error-code -- )
  54     dup expected-io-error? [
  55         drop
  56     ] [
  57         (win32-error-string) throw
  58     ] if ;
  59
  60 : io-error ( return-value -- )
  61     { 0 f } member? [ GetLastError expected-io-error ] when ;