Removed generic address resolution until a sane scheme can be found.
[lisp-utils.git] / charcode.lisp
index 6c08f42..486e679 100644 (file)
@@ -2,15 +2,21 @@
 ;;;; representations thereof
 
 (defpackage :charcode
 ;;;; representations thereof
 
 (defpackage :charcode
-  (:use :cl #+sbcl :sb-gray #-sbcl :gray)
+  (:use :cl)
   (:export "MAKE-ENCODER" "MAKE-DECODER" "ENCODE-STRING" "DECODE-STRING" "SYSTEM-CHARSET"
   (: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
 
           "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)
 (define-condition coding-error (error)
   ((input :initarg :input)
    (position :initarg :position)
               synonyms)))
 
 (defun make-encoder (name)
               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)
 
 (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.
 
 (defun system-charset ()
   ;; XXX: Replace me with something perhaps more sensible.
 
 ;;; Gray stream implementation
 
 
 ;;; 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)
 (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))))
     (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
 
 
 ;;; Implementation-specific functions
 
   (declare (type character char))
   (char-code 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))
+
+#+ecl
+(defun char->unicode (char)
+  (declare (type character char))
+  (char-code char))
+
 ;;; ASCII
 
 (defun decode-ascii (byteseq charseq &key (start 0) (end (length byteseq)))
 ;;; ASCII
 
 (defun decode-ascii (byteseq charseq &key (start 0) (end (length byteseq)))
 (define-encoder (ascii)
   #'encode-ascii)
 
 (define-encoder (ascii)
   #'encode-ascii)
 
+(define-codec-synonyms ascii :ascii)
+
 ;;; Latin-1
 
 (defun decode-latin-1 (byteseq charseq &key (start 0) (end (length byteseq)))
 ;;; Latin-1
 
 (defun decode-latin-1 (byteseq charseq &key (start 0) (end (length byteseq)))
 (define-encoder (latin-1)
   #'encode-latin-1)
 
 (define-encoder (latin-1)
   #'encode-latin-1)
 
-(define-codec-synonyms latin-1 latin1 iso-8859-1)
+(define-codec-synonyms latin-1 latin1 iso-8859-1 :latin-1 :latin1 :iso-8859-1)
 
 ;;; UTF-8
 
 
 ;;; UTF-8
 
                        (setf mlen 0))))))))
       #'decode)))
 
                        (setf mlen 0))))))))
       #'decode)))
 
-(define-codec-synonyms utf-8 utf8)
+(define-codec-synonyms utf-8 utf8 :utf-8 :utf8)