[Emacs-diffs] emacs/lisp ChangeLog international/mule-cmds.el

[Stefan Monnier]

CVSROOT:        /sources/emacs
Module name:    emacs
Changes by:     Stefan Monnier <monnier>        09/12/07 16:12:50

Modified files:
        lisp           : ChangeLog 
        lisp/international: mule-cmds.el 

Log message:
        (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.

CVSWeb URLs:
http://cvs.savannah.gnu.org/viewcvs/emacs/lisp/ChangeLog?cvsroot=emacs&r1=1.16856&r2=1.16857
http://cvs.savannah.gnu.org/viewcvs/emacs/lisp/international/mule-cmds.el?cvsroot=emacs&r1=1.383&r2=1.384

Patches:
Index: ChangeLog
===================================================================
RCS file: /sources/emacs/emacs/lisp/ChangeLog,v
retrieving revision 1.16856
retrieving revision 1.16857
diff -u -b -r1.16856 -r1.16857
--- ChangeLog   7 Dec 2009 16:09:05 -0000       1.16856
+++ ChangeLog   7 Dec 2009 16:12:47 -0000       1.16857
@@ -1,3 +1,9 @@
+2009-12-07  Stefan Monnier  <address@hidden>
+
+       * 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  <address@hidden>
 
        * simple.el (compose-mail): Check for incompatibilities and warn.

Index: international/mule-cmds.el
===================================================================
RCS file: /sources/emacs/emacs/lisp/international/mule-cmds.el,v
retrieving revision 1.383
retrieving revision 1.384
diff -u -b -r1.383 -r1.384
--- international/mule-cmds.el  11 Nov 2009 19:24:24 -0000      1.383
+++ international/mule-cmds.el  7 Dec 2009 16:12:50 -0000       1.384
@@ -2889,21 +2889,48 @@
 (defun ucs-names ()
   "Return alist of (CHAR-NAME . CHAR-CODE) pairs cached in `ucs-names'."
   (or ucs-names
-      (setq ucs-names
-           (let (name 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)
-                 "Loading Unicode character names..."
+                      "Finding Unicode characters with 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
-                        )
+                             ;; 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))
-                     (setq names (cons (cons name c) names)))
+                      (push (cons name c) names)
+                    (error "Wrong range"))
                  (if (setq name (get-char-code-property c 'old-name))
-                     (setq names (cons (cons name c) names)))))
-             names))))
+                      (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.")