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