core/io/files/files.factor

   1 ! Copyright (C) 2004, 2009 Slava Pestov, Daniel Ehrenberg.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: alien.strings continuations init io io.backend
   4 io.encodings io.encodings.utf8 io.files.private io.pathnames
   5 kernel kernel.private namespaces sequences splitting system ;
   6 IN: io.files
   7
   8 SYMBOL: +retry+ ! just try the operation again without blocking
   9 SYMBOL: +input+
  10 SYMBOL: +output+
  11
  12 ! Returns an event to wait for which will ensure completion of
  13 ! this request
  14 GENERIC: drain ( port handle -- event/f )
  15 GENERIC: refill ( port handle -- event/f )
  16
  17 HOOK: wait-for-fd io-backend ( handle event -- )
  18
  19 MIXIN: file-reader
  20 MIXIN: file-writer
  21
  22 M: file-reader stream-element-type drop +byte+ ; inline
  23 M: file-writer stream-element-type drop +byte+ ; inline
  24
  25 HOOK: (file-reader) io-backend ( path -- stream )
  26
  27 HOOK: (file-writer) io-backend ( path -- stream )
  28
  29 HOOK: (file-appender) io-backend ( path -- stream )
  30
  31 : <file-reader> ( path encoding -- stream )
  32     [ normalize-path (file-reader) { file-reader } declare ] dip <decoder> ; inline
  33
  34 : <file-writer> ( path encoding -- stream )
  35     [ normalize-path (file-writer) { file-writer } declare ] dip <encoder> ; inline
  36
  37 : <file-appender> ( path encoding -- stream )
  38     [ normalize-path (file-appender) { file-writer } declare ] dip <encoder> ; inline
  39
  40 : file-lines ( path encoding -- seq )
  41     <file-reader> stream-lines ;
  42
  43 : with-file-reader ( path encoding quot -- )
  44     [ <file-reader> ] dip with-input-stream ; inline
  45
  46 : file-contents ( path encoding -- seq )
  47     <file-reader> stream-contents ;
  48
  49 : with-file-writer ( path encoding quot -- )
  50     [ <file-writer> ] dip with-output-stream ; inline
  51
  52 : set-file-lines ( seq path encoding -- )
  53     [ [ print ] each ] with-file-writer ;
  54
  55 : set-file-contents ( seq path encoding -- )
  56     [ write ] with-file-writer ;
  57
  58 : with-file-appender ( path encoding quot -- )
  59     [ <file-appender> ] dip with-output-stream ; inline
  60
  61 : exists? ( path -- ? )
  62     normalize-path native-string>alien (exists?) ;
  63
  64 ! Current directory
  65 <PRIVATE
  66
  67 HOOK: cd io-backend ( path -- )
  68
  69 HOOK: cwd io-backend ( -- path )
  70
  71 M: object cwd ( -- path ) "." ;
  72
  73 : with-cd ( path quot -- )
  74     [ [ absolute-path cd ] curry ] dip compose
  75     cwd [ cd ] curry
  76     [ ] cleanup ; inline
  77
  78 PRIVATE>
  79
  80 : init-resource-path ( -- )
  81     OBJ-ARGS special-object
  82     [ utf8 alien>string "-resource-path=" ?head [ drop f ] unless ] map-find drop
  83     [ image parent-directory ] unless* "resource-path" set-global ;
  84
  85 [
  86     cwd current-directory set-global
  87     OBJ-IMAGE special-object alien>native-string cwd prepend-path \ image set-global
  88     OBJ-EXECUTABLE special-object alien>native-string cwd prepend-path \ vm set-global
  89     init-resource-path
  90 ] "io.files" add-startup-hook