1 ;;; -*- Mode: Lisp; Syntax: Common-Lisp; readtable: runes; Encoding: utf-8; -*-
2 ;;; ---------------------------------------------------------------------------
3 ;;; Title: Fast streams
4 ;;; Created: 1999-07-17
5 ;;; Author: Douglas Crosher
6 ;;; License: Lisp-LGPL (See file COPYING for details).
7 ;;; ---------------------------------------------------------------------------
8 ;;; (c) copyright 2007 by Douglas Crosher
10 ;;; This library is free software; you can redistribute it and/or
11 ;;; modify it under the terms of the GNU Library General Public
12 ;;; License as published by the Free Software Foundation; either
13 ;;; version 2 of the License, or (at your option) any later version.
15 ;;; This library is distributed in the hope that it will be useful,
16 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
18 ;;; Library General Public License for more details.
20 ;;; You should have received a copy of the GNU Library General Public
21 ;;; License along with this library; if not, write to the
22 ;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
23 ;;; Boston, MA 02111-1307 USA.
27 (eval-when (:compile-toplevel
:load-toplevel
:execute
)
28 (defparameter *fast
* '(optimize (speed 3) (safety 3))))
30 (deftype runes-encoding
:encoding-error
()
31 'ext
:character-conversion-error
)
36 (eval-when (:compile-toplevel
:load-toplevel
:execute
)
38 (defclass xstream
(ext:character-stream
)
39 ((name :initarg
:name
:initform nil
40 :accessor xstream-name
)
41 (column :initarg
:column
:initform
0)
42 (line :initarg
:line
:initform
1)
43 (unread-column :initarg
:unread-column
:initform
0)))
45 (defclass eol-conversion-xstream
(lisp::eol-conversion-input-stream xstream
)
50 (defun make-eol-conversion-xstream (source-stream)
51 "Returns a character stream that conversion CR-LF pairs and lone CR
52 characters into single linefeed character."
53 (declare (type stream source-stream
))
54 (let ((stream (ext:make-eol-conversion-stream source-stream
57 (change-class stream
'eol-conversion-xstream
)))
59 (definline xstream-p
(stream)
60 (typep stream
'xstream
))
62 (defun close-xstream (input)
65 (definline read-rune
(input)
66 (declare (type stream input
)
69 (let ((char (read-char input nil
:eof
)))
70 (cond ((member char
'(#\UFFFE
#\UFFFF
))
71 ;; These characters are illegal within XML documents.
72 (simple-error 'ext
:character-conversion-error
73 "~@<Illegal XML document character: ~S~:@>" char
))
74 ((eql char
#\linefeed
)
75 (setf (slot-value input
'unread-column
) (slot-value input
'column
))
76 (setf (slot-value input
'column
) 0)
77 (incf (the kernel
:index
(slot-value input
'line
))))
79 (incf (the kernel
:index
(slot-value input
'column
)))))
82 (definline peek-rune
(input)
83 (declare (type stream input
)
86 (peek-char nil input nil
:eof
))
88 (definline consume-rune
(input)
89 (declare (type stream input
)
95 (definline unread-rune
(rune input
)
96 (declare (type stream input
)
99 (unread-char rune input
)
100 (cond ((eql rune
#\linefeed
)
101 (setf (slot-value input
'column
) (slot-value input
'unread-column
))
102 (setf (slot-value input
'unread-column
) 0)
103 (decf (the kernel
:index
(slot-value input
'line
))))
105 (decf (the kernel
:index
(slot-value input
'column
)))))
108 (defun fread-rune (input)
111 (defun fpeek-rune (input)
114 (defun xstream-position (input)
115 (file-position input
))
117 (defun runes-encoding:find-encoding
(encoding)
120 (defun make-xstream (os-stream &key name
123 (initial-encoding :guess
))
124 (declare (ignore speed
))
125 (assert (eql initial-speed
1))
126 (assert (eq initial-encoding
:guess
))
127 (let* ((stream (ext:make-xml-character-conversion-stream os-stream
130 (xstream (make-eol-conversion-xstream stream
)))
131 (setf (xstream-name xstream
) name
)
135 (defclass xstream-string-input-stream
(lisp::string-input-stream xstream
)
138 (defun make-rod-xstream (string &key name
)
139 (declare (type string string
))
140 (let ((stream (make-string-input-stream string
)))
141 (change-class stream
'xstream-string-input-stream
:name name
)))
143 ;;; already at 'full speed' so just return the buffer size.
144 (defun set-to-full-speed (stream)
145 (length (ext:stream-in-buffer stream
)))
147 (defun xstream-speed (stream)
148 (length (ext:stream-in-buffer stream
)))
150 (defun xstream-line-number (stream)
151 (slot-value stream
'line
))
153 (defun xstream-column-number (stream)
154 (slot-value stream
'column
))
156 (defun xstream-encoding (stream)
157 (stream-external-format stream
))
159 ;;; the encoding will have already been detected, but it is checked against the
160 ;;; declared encoding here.
161 (defun (setf xstream-encoding
) (declared-encoding stream
)
162 (let* ((initial-encoding (xstream-encoding stream
))
164 (cond ((and (eq initial-encoding
:utf-16le
)
165 (member declared-encoding
'(:utf-16
:utf16
:utf-16le
:utf16le
)
166 :test
'string-equal
))
168 ((and (eq initial-encoding
:utf-16be
)
169 (member declared-encoding
'(:utf-16
:utf16
:utf-16be
:utf16be
)
170 :test
'string-equal
))
172 ((and (eq initial-encoding
:ucs-4be
)
173 (member declared-encoding
'(:ucs-4
:ucs4
:ucs-4be
:ucs4be
)
174 :test
'string-equal
))
176 ((and (eq initial-encoding
:ucs-4le
)
177 (member declared-encoding
'(:ucs-4
:ucs4
:ucs-4le
:ucs4le
)
178 :test
'string-equal
))
181 declared-encoding
))))
182 (unless (string-equal initial-encoding canonical-encoding
)
183 (warn "Unable to change xstream encoding from ~S to ~S (~S)~%"
184 initial-encoding declared-encoding canonical-encoding
))
188 ;;; ystream - a run output stream.
190 (deftype ystream
() 'stream
)
192 (defun ystream-column (stream)
193 (ext:line-column stream
))
195 (definline write-rune
(rune stream
)
196 (declare (inline write-char
))
197 (write-char rune stream
))
199 (defun write-rod (rod stream
)
200 (declare (type rod rod
)
201 (type stream stream
))
202 (write-string rod stream
))
204 (defun make-rod-ystream ()
205 (make-string-output-stream))
207 (defun close-ystream (stream)
209 (ext:string-output-stream
210 (get-output-stream-string stream
))
211 (ext:character-conversion-output-stream
212 (let ((target (slot-value stream
'stream
)))
214 (if (typep target
'ext
:byte-output-stream
)
215 (ext:get-output-stream-bytes target
)
218 ;;;; CHARACTER-STREAM-YSTREAM
220 (defun make-character-stream-ystream (target-stream)
224 ;;;; OCTET-VECTOR-YSTREAM
226 (defun make-octet-vector-ystream ()
227 (let ((target (ext:make-byte-output-stream
)))
228 (ext:make-character-conversion-stream target
:output t
229 :external-format
:utf-8
232 ;;;; OCTET-STREAM-YSTREAM
234 (defun make-octet-stream-ystream (os-stream)
235 (ext:make-character-conversion-stream os-stream
:output t
236 :external-format
:utf-8
240 ;;;; helper functions
242 (defun rod-to-utf8-string (rod)
243 (ext:make-string-from-bytes
(ext:make-bytes-from-string rod
:utf8
)
246 (defun utf8-string-to-rod (str)
247 (let ((bytes (map '(vector (unsigned-byte 8)) #'char-code str
)))
248 (ext:make-string-from-bytes bytes
:utf-8
)))
250 (defun make-octet-input-stream (octets)
251 (ext:make-byte-input-stream octets
))