diff options
| author | Kenichi Handa | 2003-03-18 04:11:32 +0000 |
|---|---|---|
| committer | Kenichi Handa | 2003-03-18 04:11:32 +0000 |
| commit | 620956ca4e7fd448c65a7e7827f08ac7454bf460 (patch) | |
| tree | b3e0a6f14c7278139ce8cf0522999caf52662f8b | |
| parent | 0eea77c3e733163f230fbc0e15b94069b03d9704 (diff) | |
| download | emacs-620956ca4e7fd448c65a7e7827f08ac7454bf460.tar.gz emacs-620956ca4e7fd448c65a7e7827f08ac7454bf460.zip | |
* 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.
| -rw-r--r-- | lisp/international/mule.el | 88 |
1 files changed, 11 insertions, 77 deletions
diff --git a/lisp/international/mule.el b/lisp/international/mule.el index 9ba35cd32b9..d5e516ee059 100644 --- a/lisp/international/mule.el +++ b/lisp/international/mule.el | |||
| @@ -592,83 +592,16 @@ character code range. Thus FUNC should iterate over [START, END]." | |||
| 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." |
| @@ -1088,7 +1021,6 @@ a value of `safe-charsets' in PLIST." | |||
| 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 |
| @@ -1122,6 +1054,8 @@ a value of `safe-charsets' in PLIST." | |||
| 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) |
| 1124 | 1056 | ||
| 1057 | (define-coding-system-internal coding-system) | ||
| 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) |