unmaintained/io/os-winnt-shell.factor

   1 USING: alien calendar io io-internals kernel libs-io math
   2 namespaces prettyprint sequences windows-api ;
   3 IN: shell
   4
   5 TUPLE: winnt-shell ;
   6
   7 T{ winnt-shell } \ shell set-global
   8
   9 TUPLE: file name size mtime attributes ;
  10
  11 : ((directory*)) ( handle -- )
  12     "WIN32_FIND_DATA" <c-object> [ FindNextFile ] 2keep
  13     rot zero? [ 2drop ] [ , ((directory*)) ] if ;
  14
  15 : (directory*) ( path -- )
  16     "WIN32_FIND_DATA" <c-object> [
  17         FindFirstFile dup INVALID_HANDLE_VALUE = [
  18             win32-error
  19         ] when
  20     ] keep ,
  21     [ ((directory*)) ] keep FindClose win32-error=0/f ;
  22
  23 : append-star ( path -- path )
  24     dup peek CHAR: \\ = "*" "\\*" ? append ;
  25
  26 M: winnt-shell directory* ( path -- seq )
  27     normalize-pathname append-star [ (directory*) ] { } make ;
  28
  29 : WIN32_FIND_DATA>file-size ( WIN32_FILE_ATTRIBUTE_DATA -- n )
  30     [ WIN32_FIND_DATA-nFileSizeLow ] keep
  31     WIN32_FIND_DATA-nFileSizeHigh 32 shift + ;
  32
  33 M: winnt-shell make-file ( WIN32_FIND_DATA -- file )
  34     [ WIN32_FIND_DATA-cFileName alien>u16-string ] keep
  35     [ WIN32_FIND_DATA>file-size ] keep
  36     [
  37         WIN32_FIND_DATA-ftCreationTime
  38         FILETIME>timestamp >local-time
  39     ] keep
  40     WIN32_FIND_DATA-dwFileAttributes <file> ;
  41
  42 M: winnt-shell file. ( file -- )
  43     [ [ file-attributes >oct write ] keep ] with-cell
  44     [ bl ] with-cell
  45     [ [ file-size unparse write ] keep ] with-cell
  46     [ bl ] with-cell
  47     [ [ file-mtime file-time-string write ] keep ] with-cell
  48     [ bl ] with-cell
  49     [ file-name write ] with-cell ;
  50
  51 M: winnt-shell touch-file ( path -- )
  52     #! Set the file write time to 'now'
  53     normalize-pathname
  54     dup maybe-create-file [ drop ] [ now set-file-write-time ] if ;
  55