io.lisp - clic - Clic is an command line interactive client for gopher written … | |
git clone git://bitreich.org/clic/ git://enlrupgkhuxnvlhsf6lc3fziv5h2hhfrinws65… | |
Log | |
Files | |
Refs | |
Tags | |
README | |
LICENSE | |
--- | |
io.lisp (8280B) | |
--- | |
1 ;; Copyright (c) 2002-2006, Edward Marco Baringer | |
2 ;; All rights reserved. | |
3 | |
4 (in-package :alexandria) | |
5 | |
6 (defmacro with-open-file* ((stream filespec &key direction element-type | |
7 if-exists if-does-not-exist external-… | |
8 &body body) | |
9 "Just like WITH-OPEN-FILE, but NIL values in the keyword arguments mea… | |
10 the default value specified for OPEN." | |
11 (once-only (direction element-type if-exists if-does-not-exist externa… | |
12 `(with-open-stream | |
13 (,stream (apply #'open ,filespec | |
14 (append | |
15 (when ,direction | |
16 (list :direction ,direction)) | |
17 (when ,element-type | |
18 (list :element-type ,element-type)) | |
19 (when ,if-exists | |
20 (list :if-exists ,if-exists)) | |
21 (when ,if-does-not-exist | |
22 (list :if-does-not-exist ,if-does-not-exist)) | |
23 (when ,external-format | |
24 (list :external-format ,external-format))))) | |
25 ,@body))) | |
26 | |
27 (defmacro with-input-from-file ((stream-name file-name &rest args | |
28 &key (direction nil directi… | |
29 &allow-other-keys) | |
30 &body body) | |
31 "Evaluate BODY with STREAM-NAME to an input stream on the file | |
32 FILE-NAME. ARGS is sent as is to the call to OPEN except EXTERNAL-FORMAT, | |
33 which is only sent to WITH-OPEN-FILE when it's not NIL." | |
34 (declare (ignore direction)) | |
35 (when direction-p | |
36 (error "Can't specify :DIRECTION for WITH-INPUT-FROM-FILE.")) | |
37 `(with-open-file* (,stream-name ,file-name :direction :input ,@args) | |
38 ,@body)) | |
39 | |
40 (defmacro with-output-to-file ((stream-name file-name &rest args | |
41 &key (direction nil directio… | |
42 &allow-other-keys) | |
43 &body body) | |
44 "Evaluate BODY with STREAM-NAME to an output stream on the file | |
45 FILE-NAME. ARGS is sent as is to the call to OPEN except EXTERNAL-FORMAT, | |
46 which is only sent to WITH-OPEN-FILE when it's not NIL." | |
47 (declare (ignore direction)) | |
48 (when direction-p | |
49 (error "Can't specify :DIRECTION for WITH-OUTPUT-TO-FILE.")) | |
50 `(with-open-file* (,stream-name ,file-name :direction :output ,@args) | |
51 ,@body)) | |
52 | |
53 (defun read-stream-content-into-string (stream &key (buffer-size 4096)) | |
54 "Return the \"content\" of STREAM as a fresh string." | |
55 (check-type buffer-size positive-integer) | |
56 (let ((*print-pretty* nil)) | |
57 (with-output-to-string (datum) | |
58 (let ((buffer (make-array buffer-size :element-type 'character))) | |
59 (loop | |
60 :for bytes-read = (read-sequence buffer stream) | |
61 :do (write-sequence buffer datum :start 0 :end bytes-read) | |
62 :while (= bytes-read buffer-size)))))) | |
63 | |
64 (defun read-file-into-string (pathname &key (buffer-size 4096) external-… | |
65 "Return the contents of the file denoted by PATHNAME as a fresh string. | |
66 | |
67 The EXTERNAL-FORMAT parameter will be passed directly to WITH-OPEN-FILE | |
68 unless it's NIL, which means the system default." | |
69 (with-input-from-file | |
70 (file-stream pathname :external-format external-format) | |
71 (read-stream-content-into-string file-stream :buffer-size buffer-siz… | |
72 | |
73 (defun write-string-into-file (string pathname &key (if-exists :error) | |
74 if-does-not-exist | |
75 external-format) | |
76 "Write STRING to PATHNAME. | |
77 | |
78 The EXTERNAL-FORMAT parameter will be passed directly to WITH-OPEN-FILE | |
79 unless it's NIL, which means the system default." | |
80 (with-output-to-file (file-stream pathname :if-exists if-exists | |
81 :if-does-not-exist if-does-not-exist | |
82 :external-format external-format) | |
83 (write-sequence string file-stream))) | |
84 | |
85 (defun read-stream-content-into-byte-vector (stream &key ((%length lengt… | |
86 (initial-size 4… | |
87 "Return \"content\" of STREAM as freshly allocated (unsigned-byte 8) v… | |
88 (check-type length (or null non-negative-integer)) | |
89 (check-type initial-size positive-integer) | |
90 (do ((buffer (make-array (or length initial-size) | |
91 :element-type '(unsigned-byte 8))) | |
92 (offset 0) | |
93 (offset-wanted 0)) | |
94 ((or (/= offset-wanted offset) | |
95 (and length (>= offset length))) | |
96 (if (= offset (length buffer)) | |
97 buffer | |
98 (subseq buffer 0 offset))) | |
99 (unless (zerop offset) | |
100 (let ((new-buffer (make-array (* 2 (length buffer)) | |
101 :element-type '(unsigned-byte 8)))) | |
102 (replace new-buffer buffer) | |
103 (setf buffer new-buffer))) | |
104 (setf offset-wanted (length buffer) | |
105 offset (read-sequence buffer stream :start offset)))) | |
106 | |
107 (defun read-file-into-byte-vector (pathname) | |
108 "Read PATHNAME into a freshly allocated (unsigned-byte 8) vector." | |
109 (with-input-from-file (stream pathname :element-type '(unsigned-byte 8… | |
110 (read-stream-content-into-byte-vector stream '%length (file-length s… | |
111 | |
112 (defun write-byte-vector-into-file (bytes pathname &key (if-exists :erro… | |
113 if-does-not-exist) | |
114 "Write BYTES to PATHNAME." | |
115 (check-type bytes (vector (unsigned-byte 8))) | |
116 (with-output-to-file (stream pathname :if-exists if-exists | |
117 :if-does-not-exist if-does-not-exist | |
118 :element-type '(unsigned-byte 8)) | |
119 (write-sequence bytes stream))) | |
120 | |
121 (defun copy-file (from to &key (if-to-exists :supersede) | |
122 (element-type '(unsigned-byte 8)) finish-… | |
123 (with-input-from-file (input from :element-type element-type) | |
124 (with-output-to-file (output to :element-type element-type | |
125 :if-exists if-to-exists) | |
126 (copy-stream input output | |
127 :element-type element-type | |
128 :finish-output finish-output)))) | |
129 | |
130 (defun copy-stream (input output &key (element-type (stream-element-type… | |
131 (buffer-size 4096) | |
132 (buffer (make-array buffer-size :element-type elemen… | |
133 (start 0) end | |
134 finish-output) | |
135 "Reads data from INPUT and writes it to OUTPUT. Both INPUT and OUTPUT … | |
136 be streams, they will be passed to READ-SEQUENCE and WRITE-SEQUENCE and … | |
137 compatible element-types." | |
138 (check-type start non-negative-integer) | |
139 (check-type end (or null non-negative-integer)) | |
140 (check-type buffer-size positive-integer) | |
141 (when (and end | |
142 (< end start)) | |
143 (error "END is smaller than START in ~S" 'copy-stream)) | |
144 (let ((output-position 0) | |
145 (input-position 0)) | |
146 (unless (zerop start) | |
147 ;; FIXME add platform specific optimization to skip seekable strea… | |
148 (loop while (< input-position start) | |
149 do (let ((n (read-sequence buffer input | |
150 :end (min (length buffer) | |
151 (- start input-position… | |
152 (when (zerop n) | |
153 (error "~@<Could not read enough bytes from the input… | |
154 the :START ~S requirement in ~S.~:@>" 'copy-s… | |
155 (incf input-position n)))) | |
156 (assert (= input-position start)) | |
157 (loop while (or (null end) (< input-position end)) | |
158 do (let ((n (read-sequence buffer input | |
159 :end (when end | |
160 (min (length buffer) | |
161 (- end input-position))… | |
162 (when (zerop n) | |
163 (if end | |
164 (error "~@<Could not read enough bytes from the inp… | |
165 the :END ~S requirement in ~S.~:@>" 'copy-stre… | |
166 (return))) | |
167 (incf input-position n) | |
168 (write-sequence buffer output :end n) | |
169 (incf output-position n))) | |
170 (when finish-output | |
171 (finish-output output)) | |
172 output-position)) |