;;;; representations thereof
(defpackage :charcode
- (:use :cl #+sbcl :sb-gray #-sbcl :gray)
+ (:use :cl)
(:export "MAKE-ENCODER" "MAKE-DECODER" "ENCODE-STRING" "DECODE-STRING" "SYSTEM-CHARSET"
- "CODING-ERROR"
+ "NO-CODEC-ERROR" "CODING-ERROR"
"MAKE-CODEC-CHARACTER-STREAM"
"ASCII" "LATIN-1" "LATIN1" "UTF-8" "UTF8"))
(in-package :charcode)
;;; General stuff
+(define-condition no-codec-error (error)
+ ((codec-name :initarg :codec-name))
+ (:report (lambda (c s)
+ (with-slots (codec-name) c
+ (format s "Could find no codec named ~A." codec-name)))))
+
(define-condition coding-error (error)
((input :initarg :input)
(position :initarg :position)
synonyms)))
(defun make-encoder (name)
- (the encoder-fun (values (funcall (get name 'make-encoder)))))
+ (the encoder-fun (values (funcall (or (get name 'make-encoder)
+ (error 'no-codec-error :codec-name name))))))
(defun make-decoder (name)
- (the decoder-fun (values (funcall (get name 'make-decoder)))))
+ (the decoder-fun (values (funcall (or (get name 'make-decoder)
+ (error 'no-codec-error :codec-name name))))))
(defun system-charset ()
;; XXX: Replace me with something perhaps more sensible.
;;; Gray stream implementation
+;; Disabled for now. There doesn't seem to be any good way to get
+;; these working generally over various implementations.
+
+#+unused (
(defclass codec-character-stream (fundamental-character-input-stream fundamental-character-output-stream)
((decoder :initarg :decoder)
(encoder :initarg :encoder)
(let ((outbuf (make-array (list (- end start)) :element-type '(unsigned-byte 8) :adjustable t :fill-pointer 0)))
(funcall encoder seq outbuf)
(write-sequence outbuf back))))
+)
;;; Implementation-specific functions
-#+(or (and clisp unicode) sbcl)
+#+(or (and clisp unicode) sbcl abcl)
+(defun unicode->char (unicode)
+ (declare (type (unsigned-byte 24) unicode))
+ (code-char unicode))
+
+#+(or (and clisp unicode) sbcl abcl)
+(defun char->unicode (char)
+ (declare (type character char))
+ (char-code char))
+
+#+ecl
(defun unicode->char (unicode)
(declare (type (unsigned-byte 24) unicode))
+ (when (>= unicode 256)
+ (error "ECL does not handle Unicode characters outside Latin-1."))
(code-char unicode))
-#+(or (and clisp unicode) sbcl)
+#+ecl
(defun char->unicode (char)
(declare (type character char))
(char-code char))