# HG changeset patch # User Kenichi Handa # Date 1014948438 0 # Node ID 5a79de055700c0f07c7ec1d2071e69e135d31486 # Parent 3c6459e2914f6282664493a45609064cceeec265 (cp-make-translation-table, cp-valid-codes, cp-fix-safe-chars): Deleted. Caller changed. (cp-make-coding-system): Call define-coding-system. diff -r 3c6459e2914f -r 5a79de055700 lisp/international/code-pages.el --- a/lisp/international/code-pages.el Fri Mar 01 02:06:19 2002 +0000 +++ b/lisp/international/code-pages.el Fri Mar 01 02:07:18 2002 +0000 @@ -55,57 +55,10 @@ ;;; Code: -(defun cp-make-translation-table (v) - "Return a translation table made from 128-long vector V. -V comprises characters encodable by mule-utf-8." - (let ((encoding-vector (make-vector 256 0))) - (dotimes (i 128) - (aset encoding-vector i i)) - (dotimes (i 128) - (aset encoding-vector (+ i 128) (aref v i))) - (make-translation-table-from-vector encoding-vector))) - -(defun cp-valid-codes (v) - "Derive a valid-codes list for translation vector V. -See `make-coding-system'." - (let (pairs - (i 128) ; index into v - (start 0) ; start of a valid range - (end 127)) ; end of a valid range - (while (< i 256) - (if (aref v (- i 128)) ; start or extend range - (progn - (setq end i) - (unless start (setq start i))) - (if start - (push (cons start end) pairs)) - (setq start nil)) - (setq i (1+ i))) - (if start (push (cons start end) pairs)) - (nreverse pairs))) - -(defun cp-fix-safe-chars (cs) - "Remove `char-coding-system-table' entries from previous definition of CS. -CS is a base coding system or alias." - (when (coding-system-p cs) - (let ((chars (coding-system-get cs 'safe-chars))) - (map-char-table - (lambda (k v) - (if (and v (not (eq v t))) - (aset char-coding-system-table - k - (remq cs (aref char-coding-system-table v))))) - chars)))) - ;; Fix things that have been, or might be done by codepage.el. (eval-after-load "codepage" '(progn - (dolist (cs '(cp857 cp861 cp1253 cp852 cp866 cp437 cp855 cp869 cp775 - cp862 cp864 cp1250 cp863 cp865 cp1251 cp737 cp1257 cp850 - cp860 cp851 720)) - (cp-fix-safe-chars cs)) - ;; Semi-dummy version for the stuff in codepage.el which we don't ;; define here. (Used by mule-diag.) (defun cp-supported-codepages () @@ -170,50 +123,30 @@ the charactert set. DOC-STRING and MNEMONIC are used as the corresponding args of `make-coding-system'. If MNEMONIC isn't given, ?* is used." - (let* ((encoder (intern (format "encode-%s" name))) - (decoder (intern (format "decode-%s" name))) - (ccl-decoder - (ccl-compile - `(4 - ((loop - (read r1) - (if (r1 < 128) ;; ASCII - (r0 = ,(charset-id 'ascii)) - (if (r1 < 160) - (r0 = ,(charset-id 'eight-bit-control)) - (r0 = ,(charset-id 'eight-bit-graphic)))) - (translate-character ,decoder r0 r1) - (write-multibyte-character r0 r1) - (repeat)))))) - (ccl-encoder - (ccl-compile - `(1 - ((loop - (read-multibyte-character r0 r1) - (translate-character ,encoder r0 r1) - (write-repeat r1))))))) - `(let ((translation-table (cp-make-translation-table ,v)) - (codes (cp-valid-codes ,v))) - (define-translation-table ',decoder translation-table) - (define-translation-table ',encoder - (char-table-extra-slot translation-table 0)) - (cp-fix-safe-chars ',name) - (make-coding-system - ',name 4 ,(or mnemonic ?*) - (or ,doc-string (format "%s encoding" ',name)) - (cons ,ccl-decoder ,ccl-encoder) - (list (cons 'safe-chars (get ',encoder 'translation-table)) - (cons 'valid-codes codes) - (cons 'mime-charset ',name))) - (push (list ',name - nil ; charset list - ',decoder - (let (l) ; code range - (dolist (elt (reverse codes)) - (push (cdr elt) l) - (push (car elt) l)) - (list l))) - non-iso-charset-alist)))) + `(progn + (define-charset ',name "" + :dimension 1 + :code-space [ 0 255 ] + :ascii-compatible-p t + :map ,(let ((len 0) + map) + (dotimes (i 128) + (if (aref v i) (setq len (1+ len)))) + (setq map (make-vector (* len 2) nil)) + (setq len 0) + (dotimes (i 128) + (when (aref v i) + (aset map len (+ 128 i)) + (aset map (1+ len) (aref v i)) + (setq len (+ len 2)))) + map)) + + (define-coding-system ',name + ,(or doc-string "") + :coding-type 'charset + :mnemonic ,(or mnemonic ?*) + :charset-list '(,name) + :plist '(mime-charset ,name)))) ;; These tables were mostly derived by running somthing like