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

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

2 files changed, 38 insertions, 41 deletions

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 269e28a63e9..7813b0ce2eb 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,9 @@
+2009-12-09  Kenichi Handa  <handa@m17n.org>
+
+        * international/mule-cmds.el (ucs-names): Supply a sufficiently
+        fine ranges instead of pre-calculating accurate ranges.  Iterate
+        with bigger gc-cons-threshold.
+
 2009-12-08  Dan Nicolaescu  <dann@ics.uci.edu>
 
         Add support for stashing a snapshot of the current tree.
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)