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

pre-calculating accurate ranges.  Iterate with bigger
gc-cons-threshold.
This commit is contained in:
Kenichi Handa 2009-12-09 00:57:02 +00:00
parent e2f3c6923a
commit ae63e572b3
2 changed files with 38 additions and 41 deletions

View file

@ -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> 2009-12-08 Dan Nicolaescu <dann@ics.uci.edu>
Add support for stashing a snapshot of the current tree. Add support for stashing a snapshot of the current tree.

View file

@ -2889,47 +2889,38 @@ on encoding."
(defun ucs-names () (defun ucs-names ()
"Return alist of (CHAR-NAME . CHAR-CODE) pairs cached in `ucs-names'." "Return alist of (CHAR-NAME . CHAR-CODE) pairs cached in `ucs-names'."
(or ucs-names (or ucs-names
(let ((ranges (let ((bmp-ranges
(purecopy '((#x0000 . #x33FF)
;; We precompute at compile-time the ranges of chars ;; (#x3400 . #x4DBF) CJK Ideograph Extension A
;; that have names, so that at runtime, building the (#x4DC0 . #x4DFF)
;; table can be done faster, since most of the time is ;; (#x4E00 . #x9FFF) CJK Ideograph
;; spent looking for the chars that do have a name. (#xA000 . #x0D7FF)
(eval-when-compile ;; (#xD800 . #xFAFF) Surrogate/Private
(let ((ranges ()) (#xFB00 . #xFFFD)))
(first 0) (upper-ranges
(last 0)) '((#x10000 . #x134FF)
(dotimes-with-progress-reporter (c #xEFFFF) ;; (#x13500 . #x1CFFF) unsed
"Finding Unicode characters with names..." (#x1D000 . #x1FFFF)
(unless (or ;; (#x20000 . #xDFFFF) CJK Ideograph Extension A, B, etc, unsed
;; CJK Ideograph Extension Arch (#xE0000 . #xE01FF)))
(and (>= c #x3400 ) (<= c #x4dbf )) (gc-cons-threshold 10000000)
;; CJK Ideograph c end name names)
(and (>= c #x4e00 ) (<= c #x9fff )) (dolist (range bmp-ranges)
;; Private/Surrogate (setq c (car range)
(and (>= c #xd800 ) (<= c #xfaff )) end (cdr range))
;; CJK Ideograph Extensions B, C (while (<= c end)
(and (>= c #x20000) (<= c #x2ffff)) (if (setq name (get-char-code-property c 'name))
(null (get-char-code-property c 'name))) (push (cons name c) names))
;; This char has a name. (if (setq name (get-char-code-property c 'old-name))
(if (<= c (1+ last)) (push (cons name c) names))
;; Extend the current range. (setq c (1+ c))))
(setq last c) (dolist (range upper-ranges)
;; We have to split the range. (setq c (car range)
(push (cons first last) ranges) end (cdr range))
(setq first (setq last c))))) (while (<= c end)
(cons (cons first last) ranges))))) (if (setq name (get-char-code-property c 'name))
name names) (push (cons name c) names))
(dolist (range ranges) (setq c (1+ c))))
(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)))) (setq ucs-names names))))
(defvar ucs-completions (lazy-completion-table ucs-completions ucs-names) (defvar ucs-completions (lazy-completion-table ucs-completions ucs-names)