;;; mule-cmds.el --- commands for multilingual environment -*-coding: iso-2022-7bit -*-
;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006,
-;; 2007, 2008, 2009 Free Software Foundation, Inc.
+;; 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007, 2008, 2009
+;; 2005, 2006, 2007, 2008, 2009, 2010
;; National Institute of Advanced Industrial Science and Technology (AIST)
;; Registration Number H14PRO021
;; Copyright (C) 2003
;; and delimiter characters. Support function of
;; coding-system-from-name.
(defun canonicalize-coding-system-name (name)
- (if (string-match "^iso[-_ ]?[0-9]" name)
- ;; "iso-8859-1" -> "8859-1", "iso-2022-jp" ->"2022-jp"
- (setq name (substring name (1- (match-end 0)))))
- (let ((idx (string-match "[-_ /]" name)))
- ;; Delete "-", "_", " ", "/" but do distinguish "16-be" and "16be".
- (while idx
- (if (and (>= idx 2)
- (eq (string-match "16-[lb]e$" name (- idx 2))
- (- idx 2)))
- (setq idx (string-match "[-_ /]" name (match-end 0)))
- (setq name (concat (substring name 0 idx) (substring name (1+ idx)))
- idx (string-match "[-_ /]" name idx))))
- name))
+ (if (string-match "^\\(ms\\|ibm\\|windows-\\)\\([0-9]+\\)$" name)
+ ;; "ms950", "ibm950", "windows-950" -> "cp950"
+ (concat "cp" (match-string 2 name))
+ (if (string-match "^iso[-_ ]?[0-9]" name)
+ ;; "iso-8859-1" -> "8859-1", "iso-2022-jp" ->"2022-jp"
+ (setq name (substring name (1- (match-end 0)))))
+ (let ((idx (string-match "[-_ /]" name)))
+ ;; Delete "-", "_", " ", "/" but do distinguish "16-be" and "16be".
+ (while idx
+ (if (and (>= idx 2)
+ (eq (string-match "16-[lb]e$" name (- idx 2))
+ (- idx 2)))
+ (setq idx (string-match "[-_ /]" name (match-end 0)))
+ (setq name (concat (substring name 0 idx) (substring name (1+ idx)))
+ idx (string-match "[-_ /]" name idx))))
+ name)))
(defun coding-system-from-name (name)
"Return a coding system whose name matches with NAME (string or symbol)."
(force-mode-line-update t))
(define-widget 'charset 'symbol
- (purecopy "An Emacs charset.")
+ "An Emacs charset."
:tag "Charset"
:complete-function (lambda ()
(interactive)
(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 ((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)
"Lazy completion table for completing on Unicode character names.")