bug#28302: 26.0.50; [PATCH] Make ucs-names a hash table

[Mark Oteiza <mvoteiza@udel.edu>]

Eli Zaretskii <eliz@gnu.org> writes:

>> From: Mark Oteiza <mvoteiza@udel.edu>
>> Date: Thu, 31 Aug 2017 01:04:15 -0400
>> 
>> I seem to remember there having been complaints about ucs-names preview
>> being slow.  I was curious about how much of that time was spent
>> assoc'ing every element of a roughly n = 42k element long alist, and so
>> tried making it a hash table instead.  The result is a drastic speedup
>> of C-x 8 RET TAB, presumably this makes the operation O(n) vs O(n^2).
>
> Thanks, this is a very good change.  Please make sure (if you haven't
> already) that it survives bootstrap.
>
> Also, there are other places which assume that ucs-names is an alist,
> so I guess this is not the full final patch?

Yes, since posting I found the other two places where ucs-names is used
and have made changes there.

> And this should be mentioned in NEWS under incompatible Lisp changes,
> as ucs-names debuted in Emacs 23.1, and there could be some uses of it
> outside Emacs proper.

Thanks, patch with additional changes attached.  I don't really like
repeating the string in descr-text.el, but BEL is the only outlier and I
think it would be overkill to write a rassoc analog.

diff --git a/etc/NEWS b/etc/NEWS
index e8d6ea9c6d..e8f6aec9ef 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -1153,6 +1153,9 @@ table implementation. This uses a new bytecode op 'switch', which isn't
 compatible with previous Emacs versions. This functionality can be disabled
 by setting 'byte-compile-cond-use-jump-table' to nil.
 
+---
+** The variable 'ucs-names' is now a hash table.
+
 ** 'C-up', 'C-down', 'C-left' and 'C-right' are now defined in term
 mode to send the same escape sequences that xterm does.  This makes
 things like forward-word in readline work.
diff --git a/lisp/descr-text.el b/lisp/descr-text.el
index 6f36bbed68..b3c96988dd 100644
--- a/lisp/descr-text.el
+++ b/lisp/descr-text.el
@@ -617,16 +617,16 @@ describe-char
 			 (list
                           (let* ((names (ucs-names))
                                  (name
-                                  (or (when (= char 7)
+                                  (or (when (= char ?\a)
 				       ;; Special case for "BELL" which is
 				       ;; apparently the only char which
 				       ;; doesn't have a new name and whose
 				       ;; old-name is shadowed by a newer char
 				       ;; with that name (bug#25641).
-				       (car (rassoc char names)))
+				       "BELL (BEL)")
                                       (get-char-code-property char 'name)
                                       (get-char-code-property char 'old-name))))
-                            (if (and name (assoc-string name names))
+                            (if (and name (gethash name names))
                                 (format
                                  "type \"C-x 8 RET %x\" or \"C-x 8 RET %s\""
                                  char name)
diff --git a/lisp/leim/quail/latin-ltx.el b/lisp/leim/quail/latin-ltx.el
index 6c5afcd4f9..778706a451 100644
--- a/lisp/leim/quail/latin-ltx.el
+++ b/lisp/leim/quail/latin-ltx.el
@@ -75,20 +75,20 @@
           (`(,seq ,re)
            (let ((count 0)
                  (re (eval re t)))
-             (dolist (pair (ucs-names))
-               (let ((name (car pair))
-                     (char (cdr pair)))
-                 (when (and (characterp char) ;; Ignore char-ranges.
-                            (string-match re name))
-                   (let ((keys (if (stringp seq)
-                                   (replace-match seq nil nil name)
-                                 (funcall seq name char))))
-                     (if (listp keys)
-                         (dolist (x keys)
-                           (setq count (1+ count))
-                           (push (list x char) newrules))
-                       (setq count (1+ count))
-                       (push (list keys char) newrules))))))
+             (maphash
+              (lambda (name char) 
+                (when (and (characterp char) ;; Ignore char-ranges.
+                           (string-match re name))
+                  (let ((keys (if (stringp seq)
+                                  (replace-match seq nil nil name)
+                                (funcall seq name char))))
+                    (if (listp keys)
+                        (dolist (x keys)
+                          (setq count (1+ count))
+                          (push (list x char) newrules))
+                      (setq count (1+ count))
+                      (push (list keys char) newrules)))))
+               (ucs-names))
              ;; (message "latin-ltx: %d mappings for %S" count re)
 	     ))))
       (setq newrules (delete-dups newrules))
@@ -206,7 +206,7 @@
 
  ((lambda (name char)
     (let* ((base (concat (match-string 1 name) (match-string 3 name)))
-           (basechar (cdr (assoc base (ucs-names)))))
+           (basechar (gethash base (ucs-names))))
       (when (latin-ltx--ascii-p basechar)
         (string (if (match-end 2) ?^ ?_) basechar))))
   "\\(.*\\)SU\\(?:B\\|\\(PER\\)\\)SCRIPT \\(.*\\)")