Newer
Older
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
;;;; ---------------------------------------------------------------------------
;;;; Utilities related to streams
(asdf/package:define-package :asdf/stream
(:recycle :asdf/stream)
(:use :cl :asdf/package :asdf/compatibility :asdf/utility)
(:export
#:*default-stream-element-type* #:*stderr*
#:finish-outputs #:format!
#:with-output #:with-input #:call-with-input-file
#:with-safe-io-syntax #:read-function
#:read-file-forms #:read-first-file-form
#:copy-stream-to-stream #:concatenate-files
#:copy-stream-to-stream-line-by-line
#:slurp-stream-string #:slurp-stream-lines
#:slurp-stream-forms #:slurp-file-string
#:slurp-file-lines #:slurp-file-forms))
(in-package :asdf/stream)
(defvar *default-stream-element-type* (or #+(or abcl cmu cormanlisp scl xcl) 'character :default)
"default element-type for open (depends on the current CL implementation)")
(defvar *stderr* #-clozure *error-output* #+clozure ccl::*stderr*
"the original error output stream at startup")
;;; Ensure output buffers are flushed
(defun finish-outputs ()
"Finish output on the main output streams.
Useful for portably flushing I/O before user input or program exit."
;; CCL notably buffers its stream output by default.
(dolist (s (list *stderr* *error-output* *standard-output* *trace-output*))
(ignore-errors (finish-output s)))
(values))
(defun format! (stream format &rest args)
"Just like format, but call finish-outputs before and after the output."
(finish-outputs)
(apply 'format stream format args)
(finish-output stream))
;;; Output to a stream or string, FORMAT-style
(defgeneric call-with-output (x thunk)
(:documentation
;; code from fare-utils base/streams where it's now named
;; call-with-output-stream to avoid the package clash in a lot of my code.
"Calls FUN with an actual stream argument, behaving like FORMAT with respect to stream'ing:
If OBJ is a stream, use it as the stream.
If OBJ is NIL, use a STRING-OUTPUT-STREAM as the stream, and return the resulting string.
If OBJ is T, use *STANDARD-OUTPUT* as the stream.
If OBJ is a string with a fill-pointer, use it as a string-output-stream.
Otherwise, signal an error.")
(:method ((x null) thunk)
(declare (ignorable x))
(with-output-to-string (s) (funcall thunk s)))
(:method ((x (eql t)) thunk)
(declare (ignorable x))
(funcall thunk *standard-output*) nil)
#-genera
(:method ((x stream) thunk)
(funcall thunk x) nil)
(:method ((x string) thunk)
(assert (fill-pointer x))
(with-output-to-string (s x) (funcall thunk s)))
(:method (x thunk)
(declare (ignorable thunk))
(cond
#+genera
((typep x 'stream) (funcall thunk x) nil)
(t (error "not a valid stream designator ~S" x)))))
(defmacro with-output ((x &optional (value x)) &body body)
"Bind X to an output stream, coercing VALUE (default: previous binding of X)
as per FORMAT, and evaluate BODY within the scope of this binding."
`(call-with-output ,value #'(lambda (,x) ,@body)))
;;; Input helpers
(defun call-with-input-file (pathname thunk
&key (element-type *default-stream-element-type*)
(external-format :default))
"Open FILE for input with given options, call THUNK with the resulting stream."
(with-open-file (s pathname :direction :input
:element-type element-type :external-format external-format
:if-does-not-exist :error)
(funcall thunk s)))
(defmacro with-input-file ((var pathname &rest keys &key element-type external-format) &body body)
(declare (ignore element-type external-format))
`(call-with-input-file ,pathname #'(lambda (,var) ,@body) ,@keys))
;;; Reading helpers
(defmacro with-safe-io-syntax ((&key (package :cl)) &body body)
"Establish safe CL reader options around the evaluation of BODY"
`(call-with-safe-io-syntax #'(lambda () (let ((*package* (find-package ,package))) ,@body))))
(defun call-with-safe-io-syntax (thunk &key (package :cl))
(with-standard-io-syntax ()
(let ((*package* (find-package package))
(*print-readably* nil)
(*read-eval* nil))
(funcall thunk))))
(defun read-function (string)
"Read a form from a string in function context, return a function"
(eval `(function ,(read-from-string string))))
(defun* read-file-forms (file)
(with-open-file (in file)
(loop :with eof = (list nil)
:for form = (read in nil eof)
:until (eq form eof)
:collect form)))
(defun read-first-file-form (pathname &key (package :cl) eof-error-p eof-value)
"Reads the first form from the top of a file using a safe standardized syntax"
(with-safe-io-syntax (:package package)
(with-input-file (in pathname)
(read in eof-error-p eof-value))))
;;; Simple Whole-Stream processing
(defun* copy-stream-to-stream (input output &key (element-type 'character) (buffer-size 8192))
"Copy the contents of the INPUT stream into the OUTPUT stream,
using WRITE-SEQUENCE and a sensibly sized buffer."
(with-open-stream (input input)
(loop
:for buffer = (make-array (list buffer-size) :element-type element-type)
:for end = (read-sequence buffer input)
:until (zerop end)
:do (write-sequence buffer output :end end)
(when (< end buffer-size) (return)))))
(defun* concatenate-files (inputs output)
(with-open-file (o output :element-type '(unsigned-byte 8)
:direction :output :if-exists :rename-and-delete)
(dolist (input inputs)
(with-open-file (i input :element-type '(unsigned-byte 8)
:direction :input :if-does-not-exist :error)
(copy-stream-to-stream i o :element-type '(unsigned-byte 8))))))
(defun copy-stream-to-stream-line-by-line (input output &key prefix)
"Copy the contents of the INPUT stream into the OUTPUT stream,
reading contents line by line."
(with-open-stream (input input)
(loop :for (line eof) = (multiple-value-list (read-line input nil nil))
:while line :do
(when prefix (princ prefix output))
(princ line output)
(unless eof (terpri output))
(finish-output output)
(when eof (return)))))
(defun slurp-stream-string (input &key (element-type 'character))
"Read the contents of the INPUT stream as a string"
(with-open-stream (input input)
(with-output-to-string (output)
(copy-stream-to-stream input output :element-type element-type))))
(defun slurp-stream-lines (input)
"Read the contents of the INPUT stream as a list of lines"
(with-open-stream (input input)
(loop :for l = (read-line input nil nil) :while l :collect l)))
(defun slurp-stream-forms (input)
"Read the contents of the INPUT stream as a list of forms"
(with-open-stream (input input)
(loop :with eof = '#:eof
:for form = (read input nil eof)
:until (eq form eof) :collect form)))
(defun slurp-file-string (file &rest keys)
"Open FILE with option KEYS, read its contents as a string"
(apply 'call-with-input-file file 'slurp-stream-string keys))
(defun slurp-file-lines (file &rest keys)
"Open FILE with option KEYS, read its contents as a list of lines"
(apply 'call-with-input-file file 'slurp-stream-lines keys))
(defun slurp-file-forms (file &rest keys)
"Open FILE with option KEYS, read its contents as a list of forms"
(apply 'call-with-input-file file 'slurp-stream-forms keys))