diff options
author | Stefan Monnier <monnier@iro.umontreal.ca> | 2009-12-07 16:12:47 +0000 |
---|---|---|
committer | Stefan Monnier <monnier@iro.umontreal.ca> | 2009-12-07 16:12:47 +0000 |
commit | da10ce2bb0f64bbbd62f49756952f19a37453d65 (patch) | |
tree | e4abdbc5768919a1c6d17a759656c16182433b0b /lisp/international | |
parent | 3d68fa99af7a4b84b2fdc44b429b9cddcbaaf88c (diff) | |
download | emacs-da10ce2bb0f64bbbd62f49756952f19a37453d65.tar.gz |
(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.
Diffstat (limited to 'lisp/international')
-rw-r--r-- | lisp/international/mule-cmds.el | 57 |
1 files changed, 42 insertions, 15 deletions
diff --git a/lisp/international/mule-cmds.el b/lisp/international/mule-cmds.el index ad1e3b7f538..57060ff9442 100644 --- 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.") |