]> code.delx.au - gnu-emacs/blobdiff - lisp/international/ucs-tables.el
(quail-start-translation): Fix prompt
[gnu-emacs] / lisp / international / ucs-tables.el
index 01ec4ec087337b7e88b453c46067c2ad73905449..5574cf3d954e6dd18225793e82c863344a656d78 100644 (file)
@@ -1097,7 +1097,7 @@ Translates from the iso8859 charsets and `mule-unicode-0100-24ff'.")
   ;; table `utf-translation-table-for-decode' does nothing.
 
   ;; Convert the lists to the basic char tables.
-  (dolist (n (list 15 14 9 8 7 5 4 3 2 1))
+  (dolist (n (list 15 14 9 8 7 5 4 3 2 1))
     (let ((alist (symbol-value (intern (format "ucs-8859-%d-alist" n)))))
       (dolist (pair alist)
        (let ((mule (car pair))
@@ -1111,6 +1111,7 @@ Translates from the iso8859 charsets and `mule-unicode-0100-24ff'.")
 
   ;; Derive tables that can be used as per-coding-system
   ;; `translation-table-for-encode's.
+  ;; N.B., there's no 8859-6 coding system.
   (dolist (n (list 15 14 9 8 7 5 4 3 2 1))
     (let* ((alist (symbol-value (intern (format "ucs-8859-%d-alist" n))))
           (encode-translator (set (intern (format "ucs-8859-%d-encode-table"
@@ -1179,13 +1180,14 @@ everything on input operations."
 
   (when for-encode
     ;; Make mule-utf-* encode all characters in ucs-mule-to-mule-unicode.
-    (let ((coding-list '(mule-utf-8 mule-utf-16-be mule-utf-16-le)))
+    (let ((coding-list '(mule-utf-8 mule-utf-16be mule-utf-16le
+                                   mule-utf-16be-with-signature
+                                   mule-utf-16le-with-signature)))
       (define-translation-table 'utf-translation-table-for-encode
        ucs-mule-to-mule-unicode)
       (dolist (coding coding-list)
        (set-char-table-parent (coding-system-get coding 'safe-chars)
-                              ucs-mule-to-mule-unicode)
-       (register-char-codings coding ucs-mule-to-mule-unicode)))
+                              ucs-mule-to-mule-unicode)))
 
     ;; Adjust the 8859 coding systems to fragment the unified characters
     ;; on encoding.
@@ -1199,8 +1201,6 @@ everything on input operations."
        ;; used after they've been registered, but we might as well
        ;; record them.  Setting the parent here is a convenience.
        (set-char-table-parent safe table)
-       ;; Update the table of what encodes to what.
-       (register-char-codings coding-system table)
        (coding-system-put coding-system 'translation-table-for-encode table)))
     (add-hook 'minibuffer-setup-hook 'ucs-minibuffer-setup)))
 
@@ -1221,62 +1221,40 @@ unification on input operations."
     ;; ucs-mule-to-mule-unicode except what was originally supported
     ;; and what is translated by utf-translation-table-for-decode when
     ;; `utf-fragment-on-decoding' is non-nil.
-    (let ((coding-list '(mule-utf-8 mule-utf-16-be mule-utf-16-le))
+    (let ((coding-list '(mule-utf-8 mule-utf-16be mule-utf-16le
+                                   mule-utf-16be-with-signature
+                                   mule-utf-16le-with-signature))
          (safe (coding-system-get 'mule-utf-8 'safe-chars)))
       (dolist (coding coding-list)
        (set-char-table-parent (coding-system-get coding 'safe-chars) nil))
-      ;; Here we assume that all mule-utf-* have the same character
-      ;; repertory, thus we can use SAFE for all of them.
-      (map-char-table
-       (lambda (key val)
-        (if (and (>= key 128) val
-                 (not (aref safe key)))
-            (aset char-coding-system-table key
-                  (remq 'mule-utf-8
-                        (remq 'mule-utf-16-le
-                              (remq 'mule-utf-16-be
-                                    (aref char-coding-system-table key)))))))
-       ucs-mule-to-mule-unicode)
-    
       (if (not utf-fragment-on-decoding)
          (define-translation-table 'utf-translation-table-for-encode)
        (define-translation-table 'utf-translation-table-for-encode
-         utf-defragmentation-table)
-       (dolist (coding coding-list)
-         (register-char-codings coding utf-defragmentation-table))))
+         utf-defragmentation-table)))
 
-    ;; For each charset, remove the entries in
-    ;; `char-coding-system-table' added to its safe-chars table (as
-    ;; its parent).
+    ;; For each charset, remove the parent of `safe-chars' property of
+    ;; the corresponding coding system.
     (dolist (n '(1 2 3 4 5 7 8 9 14 15))
       (let* ((coding-system
              (coding-system-base (intern (format "iso-8859-%d" n))))
-            (table (symbol-value
-                    (intern (format "ucs-8859-%d-encode-table" n))))
             (safe (coding-system-get coding-system 'safe-chars)))
-       (when (char-table-parent safe)
-         (map-char-table
-          (lambda (key val)
-            (if (and (>= key 128) val)
-                (let ((codings (aref char-coding-system-table key)))
-                  (aset char-coding-system-table key
-                        (remq coding-system codings)))))
-          (char-table-parent safe))
-         (set-char-table-parent safe nil))
+       (if (char-table-parent safe)
+           (set-char-table-parent safe nil))
        (coding-system-put coding-system 'translation-table-for-encode nil)))
-    (optimize-char-coding-system-table)
     (remove-hook 'minibuffer-setup-hook 'ucs-minibuffer-setup)))
 
 (defun ucs-insert (arg)
   "Insert the Emacs character representation of the given Unicode.
 Interactively, prompts for a hex string giving the code."
   (interactive "sUnicode (hex): ")
-  (let ((c (decode-char 'ucs (if (integerp arg)
-                                arg
-                              (string-to-number arg 16)))))
+  (or (integerp arg)
+      (setq arg (string-to-number arg 16)))
+  (let ((c (decode-char 'ucs arg)))
     (if c
        (insert c)
-      (error "Character can't be decoded to UCS"))))
+      (if (or (< arg 0) (> arg #x10FFFF))
+         (error "Not a Unicode character code: 0x%X" arg)
+       (error "Character U+%04X is not yet supported" arg)))))
 
 ;;; Dealing with non-8859 character sets.
 
@@ -2408,7 +2386,7 @@ Interactively, prompts for a hex string giving the code."
         (?\e(1y\e(B . ?\e$,1Dy\e(B)
         (?\e(1|\e(B . ?\e$,1D|\e(B)
         (?\e(1}\e(B . ?\e$,1D}\e(B)))
-       
+
       (other
        '(
         ;; latin-jisx0201 is mostly decoded to ascii, with these
@@ -2531,6 +2509,8 @@ BUFFER defaults to the current buffer."
                     (coding-system-base default-buffer-file-coding-system))))
       (when cs
        (setq table (coding-system-get cs 'translation-table-for-encode))
+       (if (and table (symbolp table))
+           (setq table (get table 'translation-table)))
        (unless (char-table-p table)
          (setq table (coding-system-get cs 'translation-table-for-input)))
        (when (char-table-p table)
@@ -2555,4 +2535,5 @@ Intended to be added to `minibuffer-setup-hook'."
 
 (provide 'ucs-tables)
 
+;;; arch-tag: b497e22b-7fe1-486a-9352-e2d7f7d76a76
 ;;; ucs-tables.el ends here