(make-translation-table): Set second extra

slot of the char table to 1.
(make-translation-table-from-vector): Likewise.
(make-translation-table-from-alist): Fix handling of multiple
entries.

1 files changed, 33 insertions, 26 deletions

diff --git a/lisp/international/mule.el b/lisp/international/mule.el
index 1b193bc5fb9..d2cc9c0f195 100644
--- a/lisp/international/mule.el
+++ b/lisp/international/mule.el
@@ -1839,6 +1839,7 @@ character, say TO-ALT, FROM is also translated to TO-ALT."
           (if rev-from
               (setcdr rev-to (append rev-from (cdr rev-to)))))))
     ;; Return TABLE just created.
+    (set-char-table-extra-slot table 1 1)
     table))
 
 (defun make-translation-table-from-vector (vec)
@@ -1856,6 +1857,8 @@ See also the variable `nonascii-translation-table'."
         (if (>= ch 256)
             (aset rev-table ch i))))
     (set-char-table-extra-slot table 0 rev-table)
+    (set-char-table-extra-slot table 1 1)
+    (set-char-table-extra-slot rev-table 1 1)
     table))
 
 (defun make-translation-table-from-alist (alist)
@@ -1864,32 +1867,36 @@ ALIST is an alist, each element has the form (FROM . TO).
 FROM and TO are a character or a vector of characters.
 If FROM is a character, that character is translated to TO.
 If FROM is a vector of characters, that sequence is translated to TO.
-The second extra-slot of the value is a translation table for reverse mapping."
-  (let ((table (make-char-table 'translation-table))
-        (rev-table (make-char-table 'translation-table))
-        max-lookup from to)
-    (setq max-lookup 1)
-    (dolist (elt alist)
-      (setq from (car elt) to (cdr elt))
-      (if (characterp from)
-          (aset table from to)
-        (let* ((ch (aref from 0))
-               (val (aref table ch)))
-          (aset table ch (cons (cons from to) val)))
-        (setq max-lookup (max max-lookup (length from)))))
-    (set-char-table-extra-slot table 1 max-lookup)
-    (setq max-lookup 1)
-    (dolist (elt alist)
-      (setq from (cdr elt) to (car elt))
-      (if (characterp from)
-          (aset rev-table from to)
-        (let* ((ch (aref from 0))
-               (val (aref rev-table ch)))
-          (aset rev-table ch (cons (cons from to) val)))
-        (setq max-lookup (max max-lookup (length from)))))
-    (set-char-table-extra-slot rev-table 1 max-lookup)
-    (set-char-table-extra-slot table 0 rev-table)
-    table))
+The first extra-slot of the value is a translation table for reverse mapping."
+  (let ((tables (vector (make-char-table 'translation-table)
+                        (make-char-table 'translation-table)))
+        table max-lookup from to idx val)
+    (dotimes (i 2)
+      (setq table (aref tables i))
+      (setq max-lookup 1)
+      (dolist (elt alist)
+        (if (= i 0)
+            (setq from (car elt) to (cdr elt))
+          (setq from (cdr elt) to (car elt)))
+        (if (characterp from)
+            (setq idx from)
+          (setq idx (aref from 0)
+                max-lookup (max max-lookup (length from))))
+        (setq val (aref table idx))
+        (if val
+            (progn
+              (or (consp val)
+                  (setq val (list (cons (vector idx) val))))
+              (if (characterp from)
+                  (setq from (vector from)))
+              (setq val (nconc val (list (cons from to)))))
+          (if (characterp from)
+              (setq val to)
+            (setq val (list (cons from to)))))
+        (aset table idx val))
+      (set-char-table-extra-slot table 1 max-lookup))
+    (set-char-table-extra-slot (aref tables 0) 0 (aref tables 1))
+    (aref tables 0)))
 
 (defun define-translation-table (symbol &rest args)
   "Define SYMBOL as the name of translation table made by ARGS.