Commit ad6b1ff3 authored by rtoy's avatar rtoy
Browse files

code/extfmts.lisp: 

o Add +replacement-character-code+.

pcl/simple-streams/external-formats/utf-16-be.lisp:
pcl/simple-streams/external-formats/utf-16-le.lisp:
pcl/simple-streams/external-formats/utf-16.lisp:
pcl/simple-streams/external-formats/utf-32-be.lisp:
pcl/simple-streams/external-formats/utf-32-le.lisp:
pcl/simple-streams/external-formats/utf-8.lisp:
o Use +replacement-character-code+ instead of the literal.
parent 5b3bfd2c

code/extfmts.lisp

+4 −1
Original line number Diff line number Diff line
@@ -5,7 +5,7 @@ 
;;; domain.

;;; 

(ext:file-comment

 "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/extfmts.lisp,v 1.2.4.3.2.23 2009/05/28 16:06:39 rtoy Exp $")

 "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/extfmts.lisp,v 1.2.4.3.2.24 2009/06/10 16:38:50 rtoy Exp $")

;;;

;;; **********************************************************************

;;;
@@ -31,6 +31,9 @@ 
(defconstant +ef-de+ 9)

(defconstant +ef-max+ 10)



;; Unicode replacement character U+FFFD

(defconstant +replacement-character-code+ #xFFFD)



(define-condition external-format-not-implemented (error)

  ()

  (:report

pcl/simple-streams/external-formats/utf-16-be.lisp

+5 −5
Original line number Diff line number Diff line
@@ -4,7 +4,7 @@ 
;;; This code was written by Paul Foley and has been placed in the public

;;; domain.

;;;

(ext:file-comment "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/simple-streams/external-formats/utf-16-be.lisp,v 1.1.2.1.2.6 2009/05/20 21:47:37 rtoy Exp $")

(ext:file-comment "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/simple-streams/external-formats/utf-16-be.lisp,v 1.1.2.1.2.7 2009/06/10 16:38:50 rtoy Exp $")



(in-package "STREAM")
@@ -19,7 +19,7 @@ 
	    (,code (+ (* 256 ,c1) ,c2)))

       (declare (type (integer 0 #xffff) ,code))

       (cond ((lisp::surrogatep ,code :low)

	      (setf ,code #xFFFD))

	      (setf ,code +replacement-character-code+))

	     ((lisp::surrogatep ,code :high)

	      (let* ((,c1 ,input)

		     (,c2 ,input)
@@ -30,10 +30,10 @@ 
		;; next time around?

		(if (lisp::surrogatep ,next :low)

		    (setq ,code (+ (ash (- ,code #xD800) 10) ,next #x2400))

		    (setf ,code #xFFFD))))

		    (setf ,code +replacement-character-code+))))

	     ((= ,code #xFFFE)

	      ;; Replace with REPLACEMENT CHARACTER.  

	      (setf ,code #xFFFD)))

	      (setf ,code +replacement-character-code+)))

       (values ,code 2)))

  (code-to-octets (code state output c c1 c2)

    `(flet ((output (code)
@@ -48,4 +48,4 @@ 
		(output (logior ,c1 #xD800))

		(output (logior ,c2 #xDC00))))

	     (t

	      (output #xFFFD))))))
 
	      (output +replacement-character-code+))))))

pcl/simple-streams/external-formats/utf-16-le.lisp

+4 −4
Original line number Diff line number Diff line
@@ -4,7 +4,7 @@ 
;;; This code was written by Paul Foley and has been placed in the public

;;; domain.

;;;

(ext:file-comment "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/simple-streams/external-formats/utf-16-le.lisp,v 1.1.2.1.2.6 2009/05/20 21:47:37 rtoy Exp $")

(ext:file-comment "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/simple-streams/external-formats/utf-16-le.lisp,v 1.1.2.1.2.7 2009/06/10 16:38:50 rtoy Exp $")



(in-package "STREAM")
@@ -19,7 +19,7 @@ 
       (declare (type (integer 0 #xffff) ,code))

       (cond ((lisp::surrogatep ,code :low)

	      ;; Replace with REPLACEMENT CHARACTER.

	      (setf ,code #xFFFD))

	      (setf ,code +replacement-character-code+))

	     ((lisp::surrogatep ,code :high)

	      (let* ((,c1 ,input)

		     (,c2 ,input)
@@ -29,7 +29,7 @@ 
		;; next time around?

		(if (lisp::surrogatep ,next :low)

		    (setq ,code (+ (ash (- ,code #xD800) 10) ,next #x2400))

		    (setq ,code #xFFFD))))

		    (setq ,code +replacement-character-code+))))

	     ((= ,code #xFFFE)

	      ;; replace with REPLACEMENT CHARACTER ?

	      (error "Illegal character U+FFFE in UTF-16 sequence.")))
@@ -47,4 +47,4 @@ 
		(output (logior ,c1 #xD800))

		(output (logior ,c2 #xDC00))))

	     (t

	      (output #xFFFD))))))
 
	      (output +replacement-character-code+))))))

pcl/simple-streams/external-formats/utf-16.lisp

+5 −5
Original line number Diff line number Diff line 
;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Package: STREAM -*-

;;;

;;; **********************************************************************

(ext:file-comment "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/simple-streams/external-formats/utf-16.lisp,v 1.1.2.3 2009/05/20 21:47:37 rtoy Exp $")

(ext:file-comment "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/simple-streams/external-formats/utf-16.lisp,v 1.1.2.4 2009/06/10 16:38:50 rtoy Exp $")



(in-package "STREAM")
@@ -48,7 +48,7 @@ 
	    ;; the BOM being reread as a character

	    (cond ((lisp::surrogatep ,code :low)

		   ;; replace with REPLACEMENT CHARACTER ?

		   (setf ,code #xFFFD))

		   (setf ,code +replacement-character-code+))

		  ((lisp::surrogatep ,code :high)

		   (let* ((,c1 ,input)

			  (,c2 ,input)
@@ -62,14 +62,14 @@ 
		     (if (lisp::surrogatep ,next :low)

			 (setq ,code (+ (ash (- ,code #xD800) 10) ,next #x2400)

			       ,wd 4)

			 (setf ,code #xFFFD))))

			 (setf ,code +replacement-character-code+))))

		  ((and (= ,code #xFFFE) (zerop ,st))

		   (setf ,state 1) (go :again))

		  ((and (= ,code #xFEFF) (zerop ,st))

		   (setf ,state 2) (go :again))

		  ((= ,code #xFFFE)

		   ;; Replace with REPLACEMENT CHARACTER.  

		   (setf ,code #xFFFD)))

		   (setf ,code +replacement-character-code+)))

	    (return (values ,code ,wd))))))

  (code-to-octets (code state output c c1 c2)

    `(flet ((output (code)
@@ -88,4 +88,4 @@ 
		(output (logior ,c1 #xD800))

		(output (logior ,c2 #xDC00))))

	     (t

	      (output #xFFFD))))))
 
	      (output +replacement-character-code+))))))

pcl/simple-streams/external-formats/utf-32-be.lisp

+2 −2
Original line number Diff line number Diff line
@@ -4,7 +4,7 @@ 
;;; This code was written by Raymond Toy and has been placed in the public

;;; domain.

;;;

(ext:file-comment "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/simple-streams/external-formats/utf-32-be.lisp,v 1.1.2.3 2009/05/27 20:36:36 rtoy Exp $")

(ext:file-comment "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/simple-streams/external-formats/utf-32-be.lisp,v 1.1.2.4 2009/06/10 16:38:50 rtoy Exp $")



(in-package "STREAM")
@@ -25,7 +25,7 @@ 
       (cond ((or (> ,c #x10ffff)

		  (lisp::surrogatep ,c))

	      ;; Surrogates are illegal.  Use replacement character.

	      (values #xfffd 4))

	      (values +replacement-character-code+ 4))

	     (t

	      (values ,c 4)))))