# HG changeset patch # User Kenichi Handa # Date 964678094 0 # Node ID 7b4fadfac0c8592bb594a4755f257e32d7e9e65a # Parent 6c62244b12b8a0fae8b73bb4b6da09c9173addca (register-char-codings): New function. (make-coding-system): Handle `safe-chars' specification in the arg PROPERTY. diff -r 6c62244b12b8 -r 7b4fadfac0c8 lisp/international/mule.el --- a/lisp/international/mule.el Thu Jul 27 06:07:14 2000 +0000 +++ b/lisp/international/mule.el Thu Jul 27 06:08:14 2000 +0000 @@ -351,6 +351,12 @@ ;; ;; The value is a translation table to be applied on encoding. ;; +;; o safe-chars +;; +;; The value is a char table. If a character has non-nil value in it, +;; the character is safely supported by the coding system. This +;; overrides the specification of safe-charsets. + ;; o safe-charsets ;; ;; The value is a list of charsets safely supported by the coding @@ -492,8 +498,11 @@ (setcdr tem (cons coding-system (cdr tem)))))) (defun coding-system-list (&optional base-only) - "Return a list of all existing coding systems. -If optional arg BASE-ONLY is non-nil, only base coding systems are listed." + "Return a list of all existing non-subsidiary coding systems. +If optional arg BASE-ONLY is non-nil, only base coding systems are listed. +The value doesn't include subsidiary coding systems which are what +made from bases and aliases automatically for various end-of-line +formats (e.g. iso-latin-1-unix, koi8-r-dos)." (let* ((codings (copy-sequence coding-system-list)) (tail (cons nil codings))) ;; Remove subsidiary coding systems (eol variants) and alias @@ -510,6 +519,23 @@ (setq tail (cdr tail))))) codings)) +(defun register-char-codings (coding-system safe-chars) + (let ((general (char-table-extra-slot char-coding-system-table 0))) + (if (eq safe-chars t) + (or (memq coding-system general) + (set-char-table-extra-slot char-coding-system-table 0 + (cons coding-system general))) + (map-char-table + (function + (lambda (key val) + (if (and (>= key 128) val) + (let ((codings (aref char-coding-system-table key))) + (or (memq coding-system codings) + (aset char-coding-system-table key + (cons coding-system codings))))))) + safe-chars)))) + + ;; Make subsidiary coding systems (eol-type variants) of CODING-SYSTEM. (defun make-subsidiary-coding-system (coding-system) (let ((coding-spec (coding-system-spec coding-system)) @@ -579,7 +605,8 @@ DESIGNATION-BOL non-nil means designation sequences should be placed at beginning of line on output. SAFE non-nil means convert unsafe characters to `?' on output. - Unsafe characters are what not specified in SAFE-CHARSET. + Characters not specified in the property `safe-charsets' nor + `safe-chars' are unsafe. ACCEPT-LATIN-EXTRA-CODE non-nil means code-detection routine accepts a code specified in `latin-extra-code-table' (which see) as a valid code of the coding system. @@ -718,13 +745,45 @@ (not (consp (car properties))))) ;; In the old version, the arg PROPERTIES is a list to be ;; set in PLIST as a value of property `safe-charsets'. - (plist-put plist 'safe-charsets properties) - ;; In the current version PROPERTIES is a property list. - ;; Reflect it into PLIST one by one. - (let ((l properties)) - (while l - (plist-put plist (car (car l)) (cdr (car l))) - (setq l (cdr l))))) + (setq properties (list (cons 'safe-charsets properties)))) + ;; In the current version PROPERTIES is a property list. + ;; Reflect it into PLIST one by one while handling safe-chars + ;; specially. + (let ((safe-charsets (cdr (assq 'safe-charsets properties))) + (safe-chars (cdr (assq 'safe-chars properties))) + (l properties) + prop val) + ;; If only safe-charsets is specified, make a char-table from + ;; it, and store that char-table as the value of `safe-chars'. + (if (and (not safe-chars) safe-charsets) + (let (charset) + (if (eq safe-charsets t) + (setq safe-chars t) + (setq safe-chars (make-char-table 'safe-chars)) + (while safe-charsets + (setq charset (car safe-charsets) + safe-charsets (cdr safe-charsets)) + (cond ((eq charset 'ascii)) ; just ignore + ((eq charset 'eight-bit-control) + (let ((i 128)) + (while (< i 160) + (aset safe-chars i t) + (setq i (1+ i))))) + ((eq charset 'eight-bit-graphic) + (let ((i 160)) + (while (< i 256) + (aset safe-chars i t) + (setq i (1+ i))))) + (t + (aset safe-chars (make-char charset) t))))) + (setq l (cons (cons 'safe-chars safe-chars) l)))) + (while l + (setq prop (car (car l)) val (cdr (car l)) l (cdr l)) + (if (eq prop 'safe-chars) + (progn + (setq val safe-chars) + (register-char-codings coding-system safe-chars))) + (plist-put plist prop val))) ;; The property `coding-category' may have been set differently ;; through PROPERTIES. (setq coding-category (plist-get plist 'coding-category)) @@ -768,14 +827,19 @@ (if (or (eq coding-category 'coding-category-iso-8-1) (eq coding-category 'coding-category-iso-8-2)) (let ((esc (intern (concat (symbol-name coding-system) "-with-esc"))) - (doc (format "Same as %s but can handle any charsets by ISO's escape sequences." coding-system))) + (doc (format "Same as %s but can handle any charsets by ISO's escape sequences." coding-system)) + (safe-charsets (assq 'safe-charsets properties)) + (mime-charset (assq 'mime-charset properties))) + (if safe-charsets + (setcdr safe-charsets t) + (setq properties (cons (cons 'safe-charsets t) properties))) + (if mime-charset + (setcdr mime-charset nil)) (make-coding-system esc type mnemonic doc (if (listp (car flags)) (cons (append (car flags) '(t)) (cdr flags)) (cons (list (car flags) t) (cdr flags))) - properties) - (coding-system-put esc 'mime-charset nil) - (coding-system-put esc 'safe-charsets t)))) + properties)))) coding-system)