(ucs-names): Supply a sufficiently fine ranges instead of

pre-calculating accurate ranges.  Iterate with bigger
gc-cons-threshold.

1 files changed, 32 insertions, 41 deletions

diff --git a/lisp/international/mule-cmds.el b/lisp/international/mule-cmds.el
index c13d96ec7b5..a817769c11d 100644
--- a/lisp/international/mule-cmds.el
+++ b/lisp/international/mule-cmds.el
@@ -2889,47 +2889,38 @@ on encoding."
 (defun ucs-names ()
   "Return alist of (CHAR-NAME . CHAR-CODE) pairs cached in `ucs-names'."
   (or ucs-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)))))
+      (let ((bmp-ranges
+	     '((#x0000 . #x33FF)
+	       ;; (#x3400 . #x4DBF) CJK Ideograph Extension A
+	       (#x4DC0 . #x4DFF)
+	       ;; (#x4E00 . #x9FFF) CJK Ideograph
+	       (#xA000 . #x0D7FF)
+	       ;; (#xD800 . #xFAFF) Surrogate/Private
+	       (#xFB00 . #xFFFD)))
+	    (upper-ranges
+	     '((#x10000 . #x134FF)
+	       ;; (#x13500 . #x1CFFF) unsed
+	       (#x1D000 . #x1FFFF)
+	       ;; (#x20000 . #xDFFFF) CJK Ideograph Extension A, B, etc, unsed
+	       (#xE0000 . #xE01FF)))
+	    (gc-cons-threshold 10000000)
+	    c end name names)
+        (dolist (range bmp-ranges)
+          (setq c (car range)
+                end (cdr range))
+	  (while (<= c end)
+	    (if (setq name (get-char-code-property c 'name))
+		(push (cons name c) names))
+	    (if (setq name (get-char-code-property c 'old-name))
+		(push (cons name c) names))
+	    (setq c (1+ c))))
+        (dolist (range upper-ranges)
+          (setq c (car range)
+                end (cdr range))
+	  (while (<= c end)
+	    (if (setq name (get-char-code-property c 'name))
+		(push (cons name c) names))
+	    (setq c (1+ c))))
         (setq ucs-names names))))
 
 (defvar ucs-completions (lazy-completion-table ucs-completions ucs-names)