comparison lisp/international/mule.el @ 68331:a7c2303e1399

(make-subsidiary-coding-system): Reset `coding-system-define-form' property of subsidiaries to nil. Avoid duplicated entry in coding-system-alist. (make-coding-system): Avoid duplicated entry in coding-system-alist. (define-coding-system-alias): Likewise.
author Kenichi Handa <handa@m17n.org>
date Sun, 22 Jan 2006 12:24:02 +0000
parents ac1d7b21ddfc
children 2ed18bf835e1
comparison
equal deleted inserted replaced
68330:837772085003 68331:a7c2303e1399
618 "Make subsidiary coding systems (eol-type variants) of CODING-SYSTEM." 618 "Make subsidiary coding systems (eol-type variants) of CODING-SYSTEM."
619 (let ((coding-spec (coding-system-spec coding-system)) 619 (let ((coding-spec (coding-system-spec coding-system))
620 (subsidiaries (vector (intern (format "%s-unix" coding-system)) 620 (subsidiaries (vector (intern (format "%s-unix" coding-system))
621 (intern (format "%s-dos" coding-system)) 621 (intern (format "%s-dos" coding-system))
622 (intern (format "%s-mac" coding-system)))) 622 (intern (format "%s-mac" coding-system))))
623 (i 0) 623 elt)
624 temp) 624 (dotimes (i 3)
625 (while (< i 3) 625 (setq elt (aref subsidiaries i))
626 (put (aref subsidiaries i) 'coding-system coding-spec) 626 (put elt 'coding-system coding-spec)
627 (put (aref subsidiaries i) 'eol-type i) 627 (put elt 'eol-type i)
628 (add-to-coding-system-list (aref subsidiaries i)) 628 (put elt 'coding-system-define-form nil)
629 (setq coding-system-alist 629 (add-to-coding-system-list elt)
630 (cons (list (symbol-name (aref subsidiaries i))) 630 (or (assoc (symbol-name elt) coding-system-alist)
631 coding-system-alist)) 631 (setq coding-system-alist
632 (setq i (1+ i))) 632 (cons (list (symbol-name elt)) coding-system-alist))))
633 subsidiaries)) 633 subsidiaries))
634 634
635 (defun transform-make-coding-system-args (name type &optional doc-string props) 635 (defun transform-make-coding-system-args (name type &optional doc-string props)
636 "For internal use only. 636 "For internal use only.
637 Transform XEmacs style args for `make-coding-system' to Emacs style. 637 Transform XEmacs style args for `make-coding-system' to Emacs style.
1080 (define-coding-system-internal coding-system) 1080 (define-coding-system-internal coding-system)
1081 1081
1082 ;; At last, register CODING-SYSTEM in `coding-system-list' and 1082 ;; At last, register CODING-SYSTEM in `coding-system-list' and
1083 ;; `coding-system-alist'. 1083 ;; `coding-system-alist'.
1084 (add-to-coding-system-list coding-system) 1084 (add-to-coding-system-list coding-system)
1085 (setq coding-system-alist (cons (list (symbol-name coding-system)) 1085 (or (assoc (symbol-name coding-system) coding-system-alist)
1086 coding-system-alist)) 1086 (setq coding-system-alist (cons (list (symbol-name coding-system))
1087 coding-system-alist)))
1087 1088
1088 ;; For a coding system of cateogory iso-8-1 and iso-8-2, create 1089 ;; For a coding system of cateogory iso-8-1 and iso-8-2, create
1089 ;; XXX-with-esc variants. 1090 ;; XXX-with-esc variants.
1090 (let ((coding-category (coding-system-category coding-system))) 1091 (let ((coding-category (coding-system-category coding-system)))
1091 (if (or (eq coding-category 'coding-category-iso-8-1) 1092 (if (or (eq coding-category 'coding-category-iso-8-1)
1112 (defun define-coding-system-alias (alias coding-system) 1113 (defun define-coding-system-alias (alias coding-system)
1113 "Define ALIAS as an alias for coding system CODING-SYSTEM." 1114 "Define ALIAS as an alias for coding system CODING-SYSTEM."
1114 (put alias 'coding-system (coding-system-spec coding-system)) 1115 (put alias 'coding-system (coding-system-spec coding-system))
1115 (put alias 'coding-system-define-form nil) 1116 (put alias 'coding-system-define-form nil)
1116 (add-to-coding-system-list alias) 1117 (add-to-coding-system-list alias)
1117 (setq coding-system-alist (cons (list (symbol-name alias)) 1118 (or (assoc (symbol-name alias) coding-system-alist)
1118 coding-system-alist)) 1119 (setq coding-system-alist (cons (list (symbol-name alias))
1120 coding-system-alist)))
1119 (let ((eol-type (coding-system-eol-type coding-system))) 1121 (let ((eol-type (coding-system-eol-type coding-system)))
1120 (if (vectorp eol-type) 1122 (if (vectorp eol-type)
1121 (progn 1123 (progn
1122 (nconc (coding-system-get alias 'alias-coding-systems) (list alias)) 1124 (nconc (coding-system-get alias 'alias-coding-systems) (list alias))
1123 (put alias 'eol-type (make-subsidiary-coding-system alias))) 1125 (put alias 'eol-type (make-subsidiary-coding-system alias)))