Skip to content
Snippets Groups Projects
Commit 72882fc7 authored by Philipp Marek's avatar Philipp Marek
Browse files

Merge branch 'origin/master'

parents ac984ab8 2c1968d9
No related branches found
No related tags found
No related merge requests found
...@@ -6,16 +6,16 @@ ...@@ -6,16 +6,16 @@
(defmacro with-open-file* ((stream filespec &key direction element-type (defmacro with-open-file* ((stream filespec &key direction element-type
if-exists if-does-not-exist external-format) if-exists if-does-not-exist external-format)
&body body) &body body)
"Just like WITH-OPEN-FILE, but NIL values in the keyword arguments mean to use "Just like WITH-OPEN-FILE, but NIL values in the keyword arguments
the default value specified for OPEN." mean to use the default value specified for OPEN."
(once-only (direction element-type if-exists if-does-not-exist external-format) (once-only (direction element-type if-exists if-does-not-exist external-format)
`(with-open-stream `(with-open-stream
(,stream (apply #'open ,filespec (,stream (apply #'open ,filespec
(append (append
(when ,direction (when ,direction
(list :direction ,direction)) (list :direction ,direction))
(when ,element-type (list :element-type (or ,element-type
(list :element-type ,element-type)) (default-element-type)))
(when ,if-exists (when ,if-exists
(list :if-exists ,if-exists)) (list :if-exists ,if-exists))
(when ,if-does-not-exist (when ,if-does-not-exist
...@@ -24,6 +24,16 @@ the default value specified for OPEN." ...@@ -24,6 +24,16 @@ the default value specified for OPEN."
(list :external-format ,external-format))))) (list :external-format ,external-format)))))
,@body))) ,@body)))
(defun default-element-type ()
;; On Lispworks, ELEMENT-TYPE :DEFAULT selects the appropriate
;; subtype of CHARACTER for the given external format which can
;; represent all possible characters.
#+lispworks :default
;; The spec says that OPEN's default ELEMENT-TYPE (when it is not
;; specified) is CHARACTER, but on AllegroCL it's (UNSIGNED-BYTE 8).
;; No harm done by specifying it on other implementations.
#-lispworks 'character)
(defmacro with-input-from-file ((stream-name file-name &rest args (defmacro with-input-from-file ((stream-name file-name &rest args
&key (direction nil direction-p) &key (direction nil direction-p)
&allow-other-keys) &allow-other-keys)
...@@ -67,10 +77,7 @@ which is only sent to WITH-OPEN-FILE when it's not NIL." ...@@ -67,10 +77,7 @@ which is only sent to WITH-OPEN-FILE when it's not NIL."
The EXTERNAL-FORMAT parameter will be passed directly to WITH-OPEN-FILE The EXTERNAL-FORMAT parameter will be passed directly to WITH-OPEN-FILE
unless it's NIL, which means the system default." unless it's NIL, which means the system default."
(with-input-from-file (with-input-from-file (file-stream pathname :external-format external-format)
(file-stream pathname
:external-format external-format
:element-type ':default)
(read-stream-content-into-string file-stream :buffer-size buffer-size))) (read-stream-content-into-string file-stream :buffer-size buffer-size)))
(defun write-string-into-file (string pathname &key (if-exists :error) (defun write-string-into-file (string pathname &key (if-exists :error)
...@@ -82,8 +89,7 @@ The EXTERNAL-FORMAT parameter will be passed directly to WITH-OPEN-FILE ...@@ -82,8 +89,7 @@ The EXTERNAL-FORMAT parameter will be passed directly to WITH-OPEN-FILE
unless it's NIL, which means the system default." unless it's NIL, which means the system default."
(with-output-to-file (file-stream pathname :if-exists if-exists (with-output-to-file (file-stream pathname :if-exists if-exists
:if-does-not-exist if-does-not-exist :if-does-not-exist if-does-not-exist
:external-format external-format :external-format external-format)
:element-type ':default)
(write-sequence string file-stream))) (write-sequence string file-stream)))
(defun read-stream-content-into-byte-vector (stream &key ((%length length)) (defun read-stream-content-into-byte-vector (stream &key ((%length length))
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment