(ucs-names): Weed out at compile-time the chars that don't have names, so

the table can be built much faster at run-time.

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 72be092c851a1ac87c929d134379c032253fa7aa..f633d7a12757a19022a5bd4ab2db01c1287a9833 100644 (file)
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,9 @@
+2009-12-07  Stefan Monnier  <monnier@iro.umontreal.ca>
+
+       * international/mule-cmds.el (ucs-names): Weed out at compile-time the
+       chars that don't have names, so the table can be built much faster at
+       run-time.
+
 2009-12-07  Chong Yidong  <cyd@stupidchicken.com>
 
        * simple.el (compose-mail): Check for incompatibilities and warn.

diff --git a/lisp/international/mule-cmds.el b/lisp/international/mule-cmds.el
index ad1e3b7f538132da7b51d7b3708bfb49d0ea68fd..57060ff9442642063c29274e1a79c9eed8a90666 100644 (file)
--- a/lisp/international/mule-cmds.el
+++ b/lisp/international/mule-cmds.el
@@ -2889,21 +2889,48 @@ on encoding."
 (defun ucs-names ()
   "Return alist of (CHAR-NAME . CHAR-CODE) pairs cached in `ucs-names'."
   (or ucs-names
-      (setq ucs-names
-           (let (name names)
-             (dotimes-with-progress-reporter (c #xEFFFF)
-                 "Loading Unicode character names..."
-               (unless (or
-                        (and (>= c #x3400 ) (<= c #x4dbf )) ; CJK Ideograph Extension A
-                        (and (>= c #x4e00 ) (<= c #x9fff )) ; CJK Ideograph
-                        (and (>= c #xd800 ) (<= c #xfaff )) ; Private/Surrogate
-                        (and (>= c #x20000) (<= c #x2ffff)) ; CJK Ideograph Extensions B, C
-                        )
-                 (if (setq name (get-char-code-property c 'name))
-                     (setq names (cons (cons name c) names)))
-                 (if (setq name (get-char-code-property c 'old-name))
-                     (setq names (cons (cons name c) names)))))
-             names))))
+      (let ((ranges
+             (purecopy
+              ;; We precompute at compile-time the ranges of chars
+              ;; that have names, so that at runtime, building the
+              ;; table can be done faster, since most of the time is
+              ;; spent looking for the chars that do have a name.
+              (eval-when-compile
+                (let ((ranges ())
+                      (first 0)
+                      (last 0))
+                  (dotimes-with-progress-reporter (c #xEFFFF)
+                      "Finding Unicode characters with names..."
+                    (unless (or
+                             ;; CJK Ideograph Extension Arch
+                             (and (>= c #x3400 ) (<= c #x4dbf ))
+                             ;; CJK Ideograph
+                             (and (>= c #x4e00 ) (<= c #x9fff ))
+                             ;; Private/Surrogate
+                             (and (>= c #xd800 ) (<= c #xfaff ))
+                             ;; CJK Ideograph Extensions B, C
+                             (and (>= c #x20000) (<= c #x2ffff))
+                             (null (get-char-code-property c 'name)))
+                      ;; This char has a name.
+                      (if (<= c (1+ last))
+                          ;; Extend the current range.
+                          (setq last c)
+                        ;; We have to split the range.
+                        (push (cons first last) ranges)
+                        (setq first (setq last c)))))
+                  (cons (cons first last) ranges))))
+             name names)
+            (dolist (range ranges)
+              (let ((c (car range))
+                    (end (cdr range)))
+                (while (<= c end)
+                  (if (setq name (get-char-code-property c 'name))
+                      (push (cons name c) names)
+                    (error "Wrong range"))
+                  (if (setq name (get-char-code-property c 'old-name))
+                      (push (cons name c) names))
+                  (setq c (1+ c)))))
+            (setq ucs-names names)))))
 
 (defvar ucs-completions (lazy-completion-table ucs-completions ucs-names)
   "Lazy completion table for completing on Unicode character names.")