;;; 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.
+;; Copyright (C) 1997-2011 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, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
;; Registration Number H14PRO021
;; Copyright (C) 2003
(define-key-after map [describe-language-environment]
`(menu-item ,(purecopy "Describe Language Environment")
- describe-language-environment-map
+ ,describe-language-environment-map
:help ,(purecopy "Show multilingual settings for a specific language")))
(define-key-after map [describe-input-method]
`(menu-item ,(purecopy "Describe Input Method...") describe-input-method
;; 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)."
"Display the HELLO file, which lists many languages and characters."
(interactive)
;; We have to decode the file in any environment.
- (letf (((default-value 'enable-multibyte-characters) t)
- (coding-system-for-read 'iso-2022-7bit))
- (view-file (expand-file-name "HELLO" data-directory))))
+ (letf ((coding-system-for-read 'iso-2022-7bit))
+ (view-file (expand-file-name "HELLO" data-directory))))
(defun universal-coding-system-argument (coding-system)
"Execute an I/O command using the specified coding system."
(> (aref (number-to-string (nth 2 (x-server-version))) 0)
?3))
;; Make non-line-break space display as a plain space.
- (aset standard-display-table 160 [32]))
+ (aset standard-display-table (unibyte-char-to-multibyte 160) [32]))
;; Most Windows programs send out apostrophes as \222. Most X fonts
;; don't contain a character at that position. Map it to the ASCII
;; apostrophe. [This is actually RIGHT SINGLE QUOTATION MARK,
;; fonts probably have the appropriate glyph at this position,
;; so they could use standard-display-8bit. It's better to use a
;; proper windows-1252 coding system. --fx]
- (aset standard-display-table 146 [39]))))
+ (aset standard-display-table (unibyte-char-to-multibyte 146) [39]))))
(defun set-language-environment-coding-systems (language-name)
"Do various coding system setups for language environment LANGUAGE-NAME."
"Do various unibyte-mode setups for language environment LANGUAGE-NAME."
(set-display-table-and-terminal-coding-system language-name))
-(defsubst princ-list (&rest args)
+(defun princ-list (&rest args)
"Print all arguments with `princ', then print \"\\n\"."
- (while args (princ (car args)) (setq args (cdr args)))
+ (mapc #'princ args)
(princ "\n"))
+(make-obsolete 'princ-list "use mapc and princ instead" "23.3")
(put 'describe-specified-language-support 'apropos-inhibit t)
("af" . "Latin-1") ; Afrikaans
("am" "Ethiopic" utf-8) ; Amharic
("an" . "Latin-9") ; Aragonese
- ; ar Arabic glibc uses 8859-6
+ ("ar" . "Arabic")
; as Assamese
; ay Aymara
("az" . "UTF-8") ; Azerbaijani
:group 'mule
:global t)
-(defvar nonascii-insert-offset 0 "This variable is obsolete.")
-(defvar nonascii-translation-table nil "This variable is obsolete.")
+(defvar nonascii-insert-offset 0)
+(make-obsolete-variable 'nonascii-insert-offset "do not use it." "23.1")
+(defvar nonascii-translation-table nil)
+(make-obsolete-variable 'nonascii-translation-table "do not use it." "23.1")
(defvar ucs-names nil
"Alist of cached (CHAR-NAME . CHAR-CODE) pairs.")
(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 Ideographs Extension A
+ (#x4DC0 . #x4DFF)
+ ;; (#x4E00 . #x9FFF) CJK Unified Ideographs
+ (#xA000 . #xD7FF)
+ ;; (#xD800 . #xFAFF) Surrogate/Private
+ (#xFB00 . #xFFFD)))
+ (upper-ranges
+ '((#x10000 . #x134FF)
+ ;; (#x13500 . #x167FF) unused
+ (#x16800 . #x16A3F)
+ ;; (#x16A40 . #x1AFFF) unused
+ (#x1B000 . #x1B0FF)
+ ;; (#x1B100 . #x1CFFF) unused
+ (#x1D000 . #x1FFFF)
+ ;; (#x20000 . #xDFFFF) CJK Ideograph Extension A, B, etc, unused
+ (#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)
(define-key ctl-x-map "8\r" 'ucs-insert)
-;; arch-tag: b382c432-4b36-460e-bf4c-05efd0bb18dc
;;; mule-cmds.el ends here
HCoop / bpt / emacs.git / blobdiff