diff options
Diffstat (limited to 'third_party/lisp/alexandria/io.lisp')
| -rw-r--r-- | third_party/lisp/alexandria/io.lisp | 172 |
1 files changed, 0 insertions, 172 deletions
diff --git a/third_party/lisp/alexandria/io.lisp b/third_party/lisp/alexandria/io.lisp deleted file mode 100644 index 28bf5e6d82..0000000000 --- a/third_party/lisp/alexandria/io.lisp +++ /dev/null @@ -1,172 +0,0 @@ -;; Copyright (c) 2002-2006, Edward Marco Baringer -;; All rights reserved. - -(in-package :alexandria) - -(defmacro with-open-file* ((stream filespec &key direction element-type - if-exists if-does-not-exist external-format) - &body body) - "Just like WITH-OPEN-FILE, but NIL values in the keyword arguments mean to use -the default value specified for OPEN." - (once-only (direction element-type if-exists if-does-not-exist external-format) - `(with-open-stream - (,stream (apply #'open ,filespec - (append - (when ,direction - (list :direction ,direction)) - (when ,element-type - (list :element-type ,element-type)) - (when ,if-exists - (list :if-exists ,if-exists)) - (when ,if-does-not-exist - (list :if-does-not-exist ,if-does-not-exist)) - (when ,external-format - (list :external-format ,external-format))))) - ,@body))) - -(defmacro with-input-from-file ((stream-name file-name &rest args - &key (direction nil direction-p) - &allow-other-keys) - &body body) - "Evaluate BODY with STREAM-NAME to an input stream on the file -FILE-NAME. ARGS is sent as is to the call to OPEN except EXTERNAL-FORMAT, -which is only sent to WITH-OPEN-FILE when it's not NIL." - (declare (ignore direction)) - (when direction-p - (error "Can't specify :DIRECTION for WITH-INPUT-FROM-FILE.")) - `(with-open-file* (,stream-name ,file-name :direction :input ,@args) - ,@body)) - -(defmacro with-output-to-file ((stream-name file-name &rest args - &key (direction nil direction-p) - &allow-other-keys) - &body body) - "Evaluate BODY with STREAM-NAME to an output stream on the file -FILE-NAME. ARGS is sent as is to the call to OPEN except EXTERNAL-FORMAT, -which is only sent to WITH-OPEN-FILE when it's not NIL." - (declare (ignore direction)) - (when direction-p - (error "Can't specify :DIRECTION for WITH-OUTPUT-TO-FILE.")) - `(with-open-file* (,stream-name ,file-name :direction :output ,@args) - ,@body)) - -(defun read-stream-content-into-string (stream &key (buffer-size 4096)) - "Return the \"content\" of STREAM as a fresh string." - (check-type buffer-size positive-integer) - (let ((*print-pretty* nil)) - (with-output-to-string (datum) - (let ((buffer (make-array buffer-size :element-type 'character))) - (loop - :for bytes-read = (read-sequence buffer stream) - :do (write-sequence buffer datum :start 0 :end bytes-read) - :while (= bytes-read buffer-size)))))) - -(defun read-file-into-string (pathname &key (buffer-size 4096) external-format) - "Return the contents of the file denoted by PATHNAME as a fresh string. - -The EXTERNAL-FORMAT parameter will be passed directly to WITH-OPEN-FILE -unless it's NIL, which means the system default." - (with-input-from-file - (file-stream pathname :external-format external-format) - (read-stream-content-into-string file-stream :buffer-size buffer-size))) - -(defun write-string-into-file (string pathname &key (if-exists :error) - if-does-not-exist - external-format) - "Write STRING to PATHNAME. - -The EXTERNAL-FORMAT parameter will be passed directly to WITH-OPEN-FILE -unless it's NIL, which means the system default." - (with-output-to-file (file-stream pathname :if-exists if-exists - :if-does-not-exist if-does-not-exist - :external-format external-format) - (write-sequence string file-stream))) - -(defun read-stream-content-into-byte-vector (stream &key ((%length length)) - (initial-size 4096)) - "Return \"content\" of STREAM as freshly allocated (unsigned-byte 8) vector." - (check-type length (or null non-negative-integer)) - (check-type initial-size positive-integer) - (do ((buffer (make-array (or length initial-size) - :element-type '(unsigned-byte 8))) - (offset 0) - (offset-wanted 0)) - ((or (/= offset-wanted offset) - (and length (>= offset length))) - (if (= offset (length buffer)) - buffer - (subseq buffer 0 offset))) - (unless (zerop offset) - (let ((new-buffer (make-array (* 2 (length buffer)) - :element-type '(unsigned-byte 8)))) - (replace new-buffer buffer) - (setf buffer new-buffer))) - (setf offset-wanted (length buffer) - offset (read-sequence buffer stream :start offset)))) - -(defun read-file-into-byte-vector (pathname) - "Read PATHNAME into a freshly allocated (unsigned-byte 8) vector." - (with-input-from-file (stream pathname :element-type '(unsigned-byte 8)) - (read-stream-content-into-byte-vector stream '%length (file-length stream)))) - -(defun write-byte-vector-into-file (bytes pathname &key (if-exists :error) - if-does-not-exist) - "Write BYTES to PATHNAME." - (check-type bytes (vector (unsigned-byte 8))) - (with-output-to-file (stream pathname :if-exists if-exists - :if-does-not-exist if-does-not-exist - :element-type '(unsigned-byte 8)) - (write-sequence bytes stream))) - -(defun copy-file (from to &key (if-to-exists :supersede) - (element-type '(unsigned-byte 8)) finish-output) - (with-input-from-file (input from :element-type element-type) - (with-output-to-file (output to :element-type element-type - :if-exists if-to-exists) - (copy-stream input output - :element-type element-type - :finish-output finish-output)))) - -(defun copy-stream (input output &key (element-type (stream-element-type input)) - (buffer-size 4096) - (buffer (make-array buffer-size :element-type element-type)) - (start 0) end - finish-output) - "Reads data from INPUT and writes it to OUTPUT. Both INPUT and OUTPUT must -be streams, they will be passed to READ-SEQUENCE and WRITE-SEQUENCE and must have -compatible element-types." - (check-type start non-negative-integer) - (check-type end (or null non-negative-integer)) - (check-type buffer-size positive-integer) - (when (and end - (< end start)) - (error "END is smaller than START in ~S" 'copy-stream)) - (let ((output-position 0) - (input-position 0)) - (unless (zerop start) - ;; FIXME add platform specific optimization to skip seekable streams - (loop while (< input-position start) - do (let ((n (read-sequence buffer input - :end (min (length buffer) - (- start input-position))))) - (when (zerop n) - (error "~@<Could not read enough bytes from the input to fulfill ~ - the :START ~S requirement in ~S.~:@>" 'copy-stream start)) - (incf input-position n)))) - (assert (= input-position start)) - (loop while (or (null end) (< input-position end)) - do (let ((n (read-sequence buffer input - :end (when end - (min (length buffer) - (- end input-position)))))) - (when (zerop n) - (if end - (error "~@<Could not read enough bytes from the input to fulfill ~ - the :END ~S requirement in ~S.~:@>" 'copy-stream end) - (return))) - (incf input-position n) - (write-sequence buffer output :end n) - (incf output-position n))) - (when finish-output - (finish-output output)) - output-position)) |