Mercurial > emacs
comparison lisp/international/mule.el @ 50181:b88623fccdf1
* international/mule.el (optimize-char-coding-system-table):
Remove this function.
(register-char-codings): Make it obsolete.
(char-coding-system-table): Defconst it here.
(make-coding-system): Don't call register-char-codings, call
define-coding-system-internal.
author | Kenichi Handa <handa@m17n.org> |
---|---|
date | Tue, 18 Mar 2003 04:11:32 +0000 |
parents | 56e32316c94b |
children | 15141bb6dc1f |
comparison
equal
deleted
inserted
replaced
50180:46738c95f450 | 50181:b88623fccdf1 |
---|---|
590 (dotimes (i chars) | 590 (dotimes (i chars) |
591 (funcall func | 591 (funcall func |
592 (make-char charset (+ i start) start) | 592 (make-char charset (+ i start) start) |
593 (make-char charset (+ i start) (+ start chars -1))))))) | 593 (make-char charset (+ i start) (+ start chars -1))))))) |
594 | 594 |
595 (defun optimize-char-coding-system-table () | |
596 "Optimize `char-coding-system-table'. | |
597 Elements which compare `equal' are modified to share the same list." | |
598 (let (cache) | |
599 (map-char-table | |
600 (lambda (k v) | |
601 ;; This doesn't worry about elements which are permutations of | |
602 ;; each other. As it is, with utf-translate-cjk on and | |
603 ;; code-pages loaded, the table has ~50k elements, which are | |
604 ;; reduced to ~1k. (`optimize-char-table' might win if | |
605 ;; permutations were eliminated, but that's probably a small | |
606 ;; effect and not easy to test.) | |
607 (if v | |
608 (let ((existing (car (member v cache)))) | |
609 (if existing | |
610 (aset char-coding-system-table k existing) | |
611 (push v cache))))) | |
612 char-coding-system-table)) | |
613 (optimize-char-table char-coding-system-table)) | |
614 | |
615 (defun register-char-codings (coding-system safe-chars) | 595 (defun register-char-codings (coding-system safe-chars) |
616 "Add entries for CODING-SYSTEM to `char-coding-system-table'. | 596 "This is an obsolete function. |
617 If SAFE-CHARS is a char-table, its non-nil entries specify characters | 597 It exists just for backward compatibility, and it does nothing.") |
618 which CODING-SYSTEM encodes safely. If SAFE-CHARS is t, register | 598 (make-obsolete 'register-char-codings |
619 CODING-SYSTEM as a general one which can encode all characters." | 599 "Unnecessary function. Calling it has no effect." |
620 (let ((general (char-table-extra-slot char-coding-system-table 0)) | 600 "21.3") |
621 ;; Charsets which have some members in the table, but not all | 601 |
622 ;; of them (i.e. not just a generic character): | 602 (defconst char-coding-system-table nil |
623 (partials (char-table-extra-slot char-coding-system-table 1))) | 603 "This is an obsolete variable. |
624 (if (eq safe-chars t) | 604 It exists just for backward compatibility, and the value is always nil.") |
625 (or (memq coding-system general) | |
626 (set-char-table-extra-slot char-coding-system-table 0 | |
627 (cons coding-system general))) | |
628 (map-char-table | |
629 (lambda (key val) | |
630 (if (and (>= key 128) val) | |
631 (let ((codings (aref char-coding-system-table key)) | |
632 (charset (char-charset key))) | |
633 (unless (memq coding-system codings) | |
634 (if (and (generic-char-p key) | |
635 (memq charset partials)) | |
636 ;; The generic char would clobber individual | |
637 ;; entries already in the table. First save the | |
638 ;; separate existing entries for all chars of the | |
639 ;; charset (with the generic entry added, if | |
640 ;; necessary). | |
641 (let (entry existing) | |
642 (map-charset-chars | |
643 (lambda (start end) | |
644 (while (<= start end) | |
645 (setq entry (aref char-coding-system-table start)) | |
646 (when entry | |
647 (push (cons | |
648 start | |
649 (if (memq coding-system entry) | |
650 entry | |
651 (cons coding-system entry))) | |
652 existing)) | |
653 (setq start (1+ start)))) | |
654 charset) | |
655 ;; Update the generic entry. | |
656 (aset char-coding-system-table key | |
657 (cons coding-system codings)) | |
658 ;; Override with the saved entries. | |
659 (dolist (elt existing) | |
660 (aset char-coding-system-table (car elt) (cdr elt)))) | |
661 (aset char-coding-system-table key | |
662 (cons coding-system codings)) | |
663 (unless (or (memq charset partials) | |
664 (generic-char-p key)) | |
665 (push charset partials))))))) | |
666 safe-chars) | |
667 ;; This is probably too expensive (e.g. multiple calls in | |
668 ;; ucs-tables), and only really relevant in certain cases, so do | |
669 ;; it explicitly where appropriate. | |
670 ;; (optimize-char-coding-system-table) | |
671 (set-char-table-extra-slot char-coding-system-table 1 partials)))) | |
672 | 605 |
673 (defun make-subsidiary-coding-system (coding-system) | 606 (defun make-subsidiary-coding-system (coding-system) |
674 "Make subsidiary coding systems (eol-type variants) of CODING-SYSTEM." | 607 "Make subsidiary coding systems (eol-type variants) of CODING-SYSTEM." |
675 (let ((coding-spec (coding-system-spec coding-system)) | 608 (let ((coding-spec (coding-system-spec coding-system)) |
676 (subsidiaries (vector (intern (format "%s-unix" coding-system)) | 609 (subsidiaries (vector (intern (format "%s-unix" coding-system)) |
1086 (if (eq prop 'safe-chars) | 1019 (if (eq prop 'safe-chars) |
1087 (progn | 1020 (progn |
1088 (if (and (symbolp val) | 1021 (if (and (symbolp val) |
1089 (get val 'translation-table)) | 1022 (get val 'translation-table)) |
1090 (setq safe-chars (get val 'translation-table))) | 1023 (setq safe-chars (get val 'translation-table))) |
1091 (register-char-codings coding-system safe-chars) | |
1092 (setq val safe-chars))) | 1024 (setq val safe-chars))) |
1093 (plist-put plist prop val))) | 1025 (plist-put plist prop val))) |
1094 ;; The property `coding-category' may have been set differently | 1026 ;; The property `coding-category' may have been set differently |
1095 ;; through PROPERTIES. | 1027 ;; through PROPERTIES. |
1096 (setq coding-category (plist-get plist 'coding-category)) | 1028 (setq coding-category (plist-get plist 'coding-category)) |
1119 (<= eol-type 2)))) | 1051 (<= eol-type 2)))) |
1120 eol-type) | 1052 eol-type) |
1121 (t | 1053 (t |
1122 (error "Invalid EOL-TYPE spec:%S" eol-type)))) | 1054 (error "Invalid EOL-TYPE spec:%S" eol-type)))) |
1123 (put coding-system 'eol-type eol-type) | 1055 (put coding-system 'eol-type eol-type) |
1056 | |
1057 (define-coding-system-internal coding-system) | |
1124 | 1058 |
1125 ;; At last, register CODING-SYSTEM in `coding-system-list' and | 1059 ;; At last, register CODING-SYSTEM in `coding-system-list' and |
1126 ;; `coding-system-alist'. | 1060 ;; `coding-system-alist'. |
1127 (add-to-coding-system-list coding-system) | 1061 (add-to-coding-system-list coding-system) |
1128 (setq coding-system-alist (cons (list (symbol-name coding-system)) | 1062 (setq coding-system-alist (cons (list (symbol-name coding-system)) |