io.lisp

   1 ;; Copyright (c) 2002-2006, Edward Marco Baringer
   2 ;; All rights reserved.
   3
   4 (in-package :alexandria)
   5
   6 (defmacro with-input-from-file ((stream-name file-name &rest args &key
   7                                              (direction nil direction-provided-p)
   8                                              &allow-other-keys)
   9                                 &body body)
  10   "Evaluate BODY with STREAM-NAME bound to an input-stream from file
  11 FILE-NAME. ARGS is passed directly to open."
  12   (declare (ignore direction))
  13   (when direction-provided-p
  14     (error "Can't specifiy :DIRECTION in WITH-INPUT-FROM-FILE."))
  15   `(with-open-file (,stream-name ,file-name :direction :input ,@args)
  16      ,@body))
  17
  18 (defmacro with-output-to-file ((stream-name file-name &rest args &key
  19                                              (direction nil direction-provided-p)
  20                                              &allow-other-keys)
  21                                &body body)
  22   "Evaluate BODY with STREAM-NAME to an output stream on the file
  23 FILE-NAME. ARGS is sent as is to the call te open."
  24   (declare (ignore direction))
  25   (when direction-provided-p
  26     (error "Can't specifiy :DIRECTION in WITH-OUTPUT-FILE."))
  27   `(with-open-file (,stream-name ,file-name :direction :output ,@args)
  28      ,@body))
  29
  30 (defun read-file-into-string (pathname &key (buffer-size 4096) (external-format :default))
  31   "Return the contents of PATHNAME as a fresh string.
  32
  33 The file specified by PATHNAME will be read one ELEMENT-TYPE
  34 element at a time, the EXTERNAL-FORMAT and ELEMENT-TYPEs must be
  35 compatible.
  36
  37 The EXTERNAL-FORMAT parameter will be passed to
  38 ENCODING-KEYWORD-TO-NATIVE, see ENCODING-KEYWORD-TO-NATIVE to
  39 possible values."
  40   (with-input-from-file
  41       (file-stream pathname :external-format external-format)
  42     (let ((*print-pretty* nil))
  43       (with-output-to-string (datum)
  44         (let ((buffer (make-array buffer-size :element-type 'character)))
  45           (loop
  46              :for bytes-read = (read-sequence buffer file-stream)
  47              :do (write-sequence buffer datum :start 0 :end bytes-read)
  48              :while (= bytes-read buffer-size)))))))
  49
  50 (defun write-string-into-file (string pathname &key (if-exists :error)
  51                                                     (if-does-not-exist :error)
  52                                                     (external-format :default))
  53   "Write STRING to PATHNAME.
  54
  55 The EXTERNAL-FORMAT parameter will be passed to
  56 ENCODING-KEYWORD-TO-NATIVE, see ENCODING-KEYWORD-TO-NATIVE to
  57 possible values."
  58   (with-output-to-file (file-stream pathname :if-exists if-exists
  59                                     :if-does-not-exist if-does-not-exist
  60                                     :external-format external-format)
  61     (write-sequence string file-stream)))
  62
  63 (defun copy-file (from to &key (if-to-exists :supersede)
  64                                (element-type '(unsigned-byte 8)) force-output)
  65   (with-input-from-file (input from :element-type element-type)
  66     (with-output-to-file (output to :element-type element-type
  67                                     :if-exists if-to-exists)
  68       (copy-stream input output
  69                    :element-type element-type
  70                    :force-output force-output))))
  71
  72 (defun copy-stream (input output &key (element-type (stream-element-type input))
  73                     (buffer-size 4096)
  74                     (buffer (make-array buffer-size :element-type element-type))
  75                     force-output)
  76   "Reads data from INPUT and writes it to OUTPUT. Both INPUT and OUTPUT must
  77 be streams, they will be passed to READ-SEQUENCE and WRITE-SEQUENCE and must have
  78 compatible element-types."
  79   (loop
  80      :for bytes-read = (read-sequence buffer input)
  81      :while (= bytes-read buffer-size)
  82      :do (write-sequence buffer output)
  83      :finally (progn
  84                 (write-sequence buffer output :end bytes-read)
  85                 (when force-output
  86                   (force-output output)))))