1 |
;;; mule-cmds.el --- commands for mulitilingual environment |
;;; mule-cmds.el --- commands for mulitilingual environment -*-coding: iso-2022-7bit -*- |
2 |
;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN. |
;; Copyright (C) 1995, 2003 Electrotechnical Laboratory, JAPAN. |
3 |
;; Licensed to the Free Software Foundation. |
;; Licensed to the Free Software Foundation. |
4 |
;; Copyright (C) 2000, 2001, 2002, 2003 Free Software Foundation, Inc. |
;; Copyright (C) 2000, 2001, 2002, 2003 Free Software Foundation, Inc. |
5 |
|
|
64 |
(define-key-after mule-menu-keymap [set-language-environment] |
(define-key-after mule-menu-keymap [set-language-environment] |
65 |
(list 'menu-item "Set Language Environment" setup-language-environment-map |
(list 'menu-item "Set Language Environment" setup-language-environment-map |
66 |
:help "Multilingual environment suitable for a specific language")) |
:help "Multilingual environment suitable for a specific language")) |
|
(define-key-after mule-menu-keymap [mouse-set-font] |
|
|
'(menu-item "Set Font/Fontset" mouse-set-font |
|
|
:visible (fboundp 'generate-fontset-menu) |
|
|
:help "Select a font from list of known fonts/fontsets")) |
|
67 |
(define-key-after mule-menu-keymap [separator-mule] |
(define-key-after mule-menu-keymap [separator-mule] |
68 |
'("--") |
'("--") |
69 |
t) |
t) |
80 |
t) |
t) |
81 |
(define-key-after mule-menu-keymap [set-various-coding-system] |
(define-key-after mule-menu-keymap [set-various-coding-system] |
82 |
(list 'menu-item "Set Coding Systems" set-coding-system-map |
(list 'menu-item "Set Coding Systems" set-coding-system-map |
83 |
:enable 'enable-multibyte-characters)) |
:enable 'default-enable-multibyte-characters)) |
84 |
(define-key-after mule-menu-keymap [view-hello-file] |
(define-key-after mule-menu-keymap [view-hello-file] |
85 |
'(menu-item "Show Multi-lingual Text" view-hello-file |
'(menu-item "Show Multi-lingual Text" view-hello-file |
86 |
:enable (file-readable-p |
:enable (file-readable-p |
412 |
non-nil, it is used to sort CODINGS in the different way than above." |
non-nil, it is used to sort CODINGS in the different way than above." |
413 |
(if sort-coding-systems-predicate |
(if sort-coding-systems-predicate |
414 |
(sort codings sort-coding-systems-predicate) |
(sort codings sort-coding-systems-predicate) |
415 |
(let* ((most-preferred (symbol-value (car coding-category-list))) |
(let* ((from-categories (mapcar #'(lambda (x) (symbol-value x)) |
416 |
|
coding-category-list)) |
417 |
|
(most-preferred (car from-categories)) |
418 |
(lang-preferred (get-language-info current-language-environment |
(lang-preferred (get-language-info current-language-environment |
419 |
'coding-system)) |
'coding-system)) |
420 |
(func (function |
(func (function |
421 |
(lambda (x) |
(lambda (x) |
422 |
(let ((base (coding-system-base x))) |
(let ((base (coding-system-base x))) |
423 |
(+ (if (eq base most-preferred) 64 0) |
;; We calculate the priority number 0..255 by |
424 |
(let ((mime (coding-system-get base 'mime-charset))) |
;; using the 8 bits PMMLCEII as this: |
425 |
|
;; P: 1 iff most preferred. |
426 |
|
;; MM: greater than 0 iff mime-charset. |
427 |
|
;; L: 1 iff one of the current lang. env.'s codings. |
428 |
|
;; C: 1 iff one of codings listed in the category list. |
429 |
|
;; E: 1 iff not XXX-with-esc |
430 |
|
;; II: if iso-2022 based, 0..3, else 1. |
431 |
|
(logior |
432 |
|
(lsh (if (eq base most-preferred) 1 0) 7) |
433 |
|
(lsh |
434 |
|
(let ((mime (coding-system-get base 'mime-charset))) |
435 |
;; Prefer coding systems corresponding to a |
;; Prefer coding systems corresponding to a |
436 |
;; MIME charset. |
;; MIME charset. |
437 |
(if mime |
(if mime |
438 |
;; Lower utf-16 priority so that we |
;; Lower utf-16 priority so that we |
439 |
;; normally prefer utf-8 to it, and put |
;; normally prefer utf-8 to it, and put |
440 |
;; x-ctext below that. |
;; x-ctext below that. |
441 |
(cond ((or (eq base 'mule-utf-16-le) |
(cond ((string-match "utf-16" |
442 |
(eq base 'mule-utf-16-be)) |
(symbol-name mime)) |
443 |
16) |
2) |
444 |
((string-match "^x-" (symbol-name mime)) |
((string-match "^x-" (symbol-name mime)) |
445 |
8) |
1) |
446 |
(t 32)) |
(t 3)) |
447 |
0)) |
0)) |
448 |
(if (memq base lang-preferred) 8 0) |
5) |
449 |
(if (string-match "-with-esc\\'" (symbol-name base)) |
(lsh (if (memq base lang-preferred) 1 0) 4) |
450 |
0 4) |
(lsh (if (memq base from-categories) 1 0) 3) |
451 |
(if (eq (coding-system-type base) 2) |
(lsh (if (string-match "-with-esc\\'" |
452 |
;; For ISO based coding systems, prefer |
(symbol-name base)) |
453 |
;; one that doesn't use escape sequences. |
0 1) 2) |
454 |
(let ((flags (coding-system-flags base))) |
(if (eq (coding-system-type base) 2) |
455 |
(if (or (consp (aref flags 0)) |
;; For ISO based coding systems, prefer |
456 |
(consp (aref flags 1)) |
;; one that doesn't use escape sequences. |
457 |
(consp (aref flags 2)) |
(let ((flags (coding-system-flags base))) |
458 |
(consp (aref flags 3))) |
(if (or (consp (aref flags 0)) |
459 |
(if (or (aref flags 8) (aref flags 9)) |
(consp (aref flags 1)) |
460 |
0 |
(consp (aref flags 2)) |
461 |
1) |
(consp (aref flags 3))) |
462 |
2)) |
(if (or (aref flags 8) (aref flags 9)) |
463 |
1))))))) |
0 |
464 |
|
1) |
465 |
|
2)) |
466 |
|
1))))))) |
467 |
(sort codings (function (lambda (x y) |
(sort codings (function (lambda (x y) |
468 |
(> (funcall func x) (funcall func y)))))))) |
(> (funcall func x) (funcall func y)))))))) |
469 |
|
|
627 |
between FROM and TO are shown in a popup window. Among them, the most |
between FROM and TO are shown in a popup window. Among them, the most |
628 |
proper one is suggested as the default. |
proper one is suggested as the default. |
629 |
|
|
630 |
The list of `buffer-file-coding-system' of the current buffer and the |
The list of `buffer-file-coding-system' of the current buffer, |
631 |
|
the `default-buffer-file-coding-system', and the |
632 |
most preferred coding system (if it corresponds to a MIME charset) is |
most preferred coding system (if it corresponds to a MIME charset) is |
633 |
treated as the default coding system list. Among them, the first one |
treated as the default coding system list. Among them, the first one |
634 |
that safely encodes the text is normally selected silently and |
that safely encodes the text is normally selected silently and |
645 |
list of coding systems to be prepended to the default coding system |
list of coding systems to be prepended to the default coding system |
646 |
list. However, if DEFAULT-CODING-SYSTEM is a list and the first |
list. However, if DEFAULT-CODING-SYSTEM is a list and the first |
647 |
element is t, the cdr part is used as the defualt coding system list, |
element is t, the cdr part is used as the defualt coding system list, |
648 |
i.e. `buffer-file-coding-system' and the most prepended coding system |
i.e. `buffer-file-coding-system', `default-buffer-file-coding-system', |
649 |
is not used. |
and the most preferred coding system are not used. |
650 |
|
|
651 |
Optional 4th arg ACCEPT-DEFAULT-P, if non-nil, is a function to |
Optional 4th arg ACCEPT-DEFAULT-P, if non-nil, is a function to |
652 |
determine the acceptability of the silently selected coding system. |
determine the acceptability of the silently selected coding system. |
676 |
(mapcar (function (lambda (x) (cons x (coding-system-base x)))) |
(mapcar (function (lambda (x) (cons x (coding-system-base x)))) |
677 |
default-coding-system)) |
default-coding-system)) |
678 |
|
|
679 |
|
;; From now on, the list of defaults is reversed. |
680 |
|
(setq default-coding-system (nreverse default-coding-system)) |
681 |
|
|
682 |
(unless no-other-defaults |
(unless no-other-defaults |
683 |
;; If buffer-file-coding-system is not nil nor undecided, append it |
;; If buffer-file-coding-system is not nil nor undecided, append it |
684 |
;; to the defaults. |
;; to the defaults. |
686 |
(let ((base (coding-system-base buffer-file-coding-system))) |
(let ((base (coding-system-base buffer-file-coding-system))) |
687 |
(or (eq base 'undecided) |
(or (eq base 'undecided) |
688 |
(rassq base default-coding-system) |
(rassq base default-coding-system) |
689 |
(setq default-coding-system |
(push (cons buffer-file-coding-system base) |
690 |
(append default-coding-system |
default-coding-system)))) |
691 |
(list (cons buffer-file-coding-system base))))))) |
|
692 |
|
;; If default-buffer-file-coding-system is not nil nor undecided, |
693 |
|
;; append it to the defaults. |
694 |
|
(if default-buffer-file-coding-system |
695 |
|
(let ((base (coding-system-base default-buffer-file-coding-system))) |
696 |
|
(or (eq base 'undecided) |
697 |
|
(rassq base default-coding-system) |
698 |
|
(push (cons default-buffer-file-coding-system base) |
699 |
|
default-coding-system)))) |
700 |
|
|
701 |
;; If the most preferred coding system has the property mime-charset, |
;; If the most preferred coding system has the property mime-charset, |
702 |
;; append it to the defaults. |
;; append it to the defaults. |
703 |
(let ((tail coding-category-list) |
(let ((tail coding-category-list) |
704 |
preferred base) |
preferred base) |
705 |
(while (and tail |
(while (and tail (not (setq preferred (symbol-value (car tail))))) |
|
(not (setq preferred (symbol-value (car tail))))) |
|
706 |
(setq tail (cdr tail))) |
(setq tail (cdr tail))) |
707 |
(and (coding-system-p preferred) |
(and (coding-system-p preferred) |
708 |
(setq base (coding-system-base preferred)) |
(setq base (coding-system-base preferred)) |
709 |
(coding-system-get preferred 'mime-charset) |
(coding-system-get preferred 'mime-charset) |
710 |
(not (rassq base default-coding-system)) |
(not (rassq base default-coding-system)) |
711 |
(setq default-coding-system |
(push (cons preferred base) |
712 |
(append default-coding-system |
default-coding-system))))) |
|
(list (cons preferred base)))))))) |
|
713 |
|
|
714 |
(if select-safe-coding-system-accept-default-p |
(if select-safe-coding-system-accept-default-p |
715 |
(setq accept-default-p select-safe-coding-system-accept-default-p)) |
(setq accept-default-p select-safe-coding-system-accept-default-p)) |
730 |
(push (car elt) safe)) |
(push (car elt) safe)) |
731 |
(push (car elt) unsafe))) |
(push (car elt) unsafe))) |
732 |
(if safe |
(if safe |
733 |
(setq coding-system (car (last safe))))) |
(setq coding-system (car safe)))) |
734 |
|
|
735 |
;; If all the defaults failed, ask a user. |
;; If all the defaults failed, ask a user. |
736 |
(when (not coding-system) |
(when (not coding-system) |
887 |
(insert "\n") |
(insert "\n") |
888 |
(fill-region-as-paragraph pos (point))) |
(fill-region-as-paragraph pos (point))) |
889 |
(insert "Or specify any other coding system |
(insert "Or specify any other coding system |
890 |
on your risk of losing the problematic characters.\n"))) |
at the risk of losing the problematic characters.\n"))) |
891 |
|
|
892 |
;; Read a coding system. |
;; Read a coding system. |
893 |
(setq default-coding-system (or (car safe) (car codings))) |
(setq default-coding-system (or (car safe) (car codings))) |
1591 |
bound to each category are as follows |
bound to each category are as follows |
1592 |
coding category coding system |
coding category coding system |
1593 |
-------------------------------------------------- |
-------------------------------------------------- |
|
coding-category-iso-8-2 iso-latin-1 |
|
1594 |
coding-category-iso-8-1 iso-latin-1 |
coding-category-iso-8-1 iso-latin-1 |
1595 |
|
coding-category-iso-8-2 iso-latin-1 |
1596 |
|
coding-category-utf-8 mule-utf-8 |
1597 |
|
coding-category-utf-16-be mule-utf-16be-with-signature |
1598 |
|
coding-category-utf-16-le mule-utf-16le-with-signature |
1599 |
coding-category-iso-7-tight iso-2022-jp |
coding-category-iso-7-tight iso-2022-jp |
1600 |
coding-category-iso-7 iso-2022-7bit |
coding-category-iso-7 iso-2022-7bit |
1601 |
coding-category-iso-7-else iso-2022-7bit-lock |
coding-category-iso-7-else iso-2022-7bit-lock |
1605 |
coding-category-sjis japanese-shift-jis |
coding-category-sjis japanese-shift-jis |
1606 |
coding-category-big5 chinese-big5 |
coding-category-big5 chinese-big5 |
1607 |
coding-category-ccl nil |
coding-category-ccl nil |
1608 |
coding-category-binary no-conversion |
coding-category-binary no-conversion" |
|
coding-category-utf-16-be nil |
|
|
coding-category-utf-16-le nil |
|
|
coding-category-utf-8 mule-utf-8" |
|
1609 |
(interactive) |
(interactive) |
1610 |
;; This function formerly set default-enable-multibyte-characters to t, |
;; This function formerly set default-enable-multibyte-characters to t, |
1611 |
;; but that is incorrect. It should not alter the unibyte/multibyte choice. |
;; but that is incorrect. It should not alter the unibyte/multibyte choice. |
1620 |
coding-category-raw-text 'raw-text |
coding-category-raw-text 'raw-text |
1621 |
coding-category-sjis 'japanese-shift-jis |
coding-category-sjis 'japanese-shift-jis |
1622 |
coding-category-big5 'chinese-big5 |
coding-category-big5 'chinese-big5 |
1623 |
coding-category-utf-16-be nil |
coding-category-utf-16-be 'mule-utf-16be-with-signature |
1624 |
coding-category-utf-16-le nil |
coding-category-utf-16-le 'mule-utf-16le-with-signature |
1625 |
coding-category-utf-8 'mule-utf-8 |
coding-category-utf-8 'mule-utf-8 |
1626 |
coding-category-ccl nil |
coding-category-ccl nil |
1627 |
coding-category-binary 'no-conversion) |
coding-category-binary 'no-conversion) |
1629 |
(set-coding-priority |
(set-coding-priority |
1630 |
'(coding-category-iso-8-1 |
'(coding-category-iso-8-1 |
1631 |
coding-category-iso-8-2 |
coding-category-iso-8-2 |
1632 |
|
coding-category-utf-8 |
1633 |
|
coding-category-utf-16-be |
1634 |
|
coding-category-utf-16-le |
1635 |
coding-category-iso-7-tight |
coding-category-iso-7-tight |
1636 |
coding-category-iso-7 |
coding-category-iso-7 |
1637 |
coding-category-iso-7-else |
coding-category-iso-7-else |
1641 |
coding-category-sjis |
coding-category-sjis |
1642 |
coding-category-big5 |
coding-category-big5 |
1643 |
coding-category-ccl |
coding-category-ccl |
1644 |
coding-category-binary |
coding-category-binary)) |
|
coding-category-utf-16-be |
|
|
coding-category-utf-16-le |
|
|
coding-category-utf-8)) |
|
1645 |
|
|
1646 |
(update-coding-systems-internal) |
(update-coding-systems-internal) |
1647 |
|
|
1684 |
(let ((coding (get-language-info language-name 'unibyte-display))) |
(let ((coding (get-language-info language-name 'unibyte-display))) |
1685 |
(if coding |
(if coding |
1686 |
(standard-display-european-internal) |
(standard-display-european-internal) |
1687 |
(standard-display-default (if (eq window-system 'pc) 128 160) 255) |
;; The following 2 lines undo the 8-bit display that we set up |
1688 |
(aset standard-display-table 146 nil)) |
;; in standard-display-european-internal, which see. This is in |
1689 |
|
;; case the user has used standard-display-european earlier in |
1690 |
|
;; this session. (The MS-DOS port doesn't use that setup, so it |
1691 |
|
;; doesn't need to undo it.) |
1692 |
|
(when standard-display-table |
1693 |
|
(dotimes (i 128) |
1694 |
|
(aset standard-display-table (+ i 128) nil)))) |
1695 |
(or (eq window-system 'pc) |
(or (eq window-system 'pc) |
1696 |
(set-terminal-coding-system coding)))) |
(set-terminal-coding-system coding)))) |
1697 |
|
|
1698 |
(defun set-language-environment (language-name) |
(defun set-language-environment (language-name) |
1699 |
"Set up multi-lingual environment for using LANGUAGE-NAME. |
"Set up multi-lingual environment for using LANGUAGE-NAME. |
1708 |
(if (symbolp language-name) |
(if (symbolp language-name) |
1709 |
(setq language-name (symbol-name language-name))) |
(setq language-name (symbol-name language-name))) |
1710 |
(setq language-name "English")) |
(setq language-name "English")) |
1711 |
(or (assoc-ignore-case language-name language-info-alist) |
(let ((slot (assoc-ignore-case language-name language-info-alist))) |
1712 |
|
(unless slot |
1713 |
(error "Language environment not defined: %S" language-name)) |
(error "Language environment not defined: %S" language-name)) |
1714 |
|
(setq language-name (car slot))) |
1715 |
(if current-language-environment |
(if current-language-environment |
1716 |
(let ((func (get-language-info current-language-environment |
(let ((func (get-language-info current-language-environment |
1717 |
'exit-function))) |
'exit-function))) |
1800 |
(aset standard-display-table 160 [32]) |
(aset standard-display-table 160 [32]) |
1801 |
;; With luck, non-Latin-1 fonts are more recent and so don't |
;; With luck, non-Latin-1 fonts are more recent and so don't |
1802 |
;; have this bug. |
;; have this bug. |
1803 |
(aset standard-display-table 2208 [32]) ; Latin-1 NBSP |
(aset standard-display-table (make-char 'latin-iso8859-1 160) [32]) |
1804 |
;; Most Windows programs send out apostrophes as \222. Most X fonts |
;; Most Windows programs send out apostrophes as \222. Most X fonts |
1805 |
;; don't contain a character at that position. Map it to the ASCII |
;; don't contain a character at that position. Map it to the ASCII |
1806 |
;; apostrophe. [This is actually RIGHT SINGLE QUOTATION MARK, |
;; apostrophe. [This is actually RIGHT SINGLE QUOTATION MARK, |
1808 |
;; fonts probably have the appropriate glyph at this position, |
;; fonts probably have the appropriate glyph at this position, |
1809 |
;; so they could use standard-display-8bit. It's better to use a |
;; so they could use standard-display-8bit. It's better to use a |
1810 |
;; proper windows-1252 coding system. --fx] |
;; proper windows-1252 coding system. --fx] |
1811 |
(aset standard-display-table 146 [39])))) |
(aset standard-display-table 146 [39]) |
1812 |
|
;; XFree86 4 has changed most of the fonts from their designed |
1813 |
|
;; versions such that `' no longer appears as balanced quotes. |
1814 |
|
;; Assume it has iso10646 fonts installed, so we can display |
1815 |
|
;; balanced quotes. |
1816 |
|
(when (and (eq window-system 'x) |
1817 |
|
(string= "The XFree86 Project, Inc" (x-server-vendor)) |
1818 |
|
(> (aref (number-to-string (nth 2 (x-server-version))) 0) |
1819 |
|
?3)) |
1820 |
|
(aset standard-display-table ?' [?$,1ry(B]) |
1821 |
|
(aset standard-display-table ?` [?$,1rx(B]) |
1822 |
|
;; The fonts don't have the relevant bug. |
1823 |
|
(aset standard-display-table 160 nil) |
1824 |
|
(aset standard-display-table (make-char 'latin-iso8859-1 160) |
1825 |
|
nil))))) |
1826 |
|
|
1827 |
(defun set-language-environment-coding-systems (language-name |
(defun set-language-environment-coding-systems (language-name |
1828 |
&optional eol-type) |
&optional eol-type) |
1881 |
(error "No documentation for the specified language")) |
(error "No documentation for the specified language")) |
1882 |
(if (symbolp language-name) |
(if (symbolp language-name) |
1883 |
(setq language-name (symbol-name language-name))) |
(setq language-name (symbol-name language-name))) |
1884 |
|
(dolist (feature (get-language-info language-name 'features)) |
1885 |
|
(require feature)) |
1886 |
(let ((doc (get-language-info language-name 'documentation)) |
(let ((doc (get-language-info language-name 'documentation)) |
1887 |
pos) |
pos) |
1888 |
(help-setup-xref (list #'describe-language-environment language-name) |
(help-setup-xref (list #'describe-language-environment language-name) |
2169 |
(".*8859[-_]?9\\>" . "Latin-5") |
(".*8859[-_]?9\\>" . "Latin-5") |
2170 |
(".*8859[-_]?14\\>" . "Latin-8") |
(".*8859[-_]?14\\>" . "Latin-8") |
2171 |
(".*8859[-_]?15\\>" . "Latin-9") |
(".*8859[-_]?15\\>" . "Latin-9") |
2172 |
(".*utf\\(-?8\\)\\>" . "UTF-8") |
(".*utf-?8\\>" . "UTF-8") |
2173 |
;; utf-8@euro exists, so put this last. (@euro really specifies |
;; utf-8@euro exists, so put this last. (@euro really specifies |
2174 |
;; the currency, rather than the charset.) |
;; the currency, rather than the charset.) |
2175 |
(".*@euro\\>" . "Latin-9"))) |
(".*@euro\\>" . "Latin-9"))) |
2316 |
(setq locale-coding-system coding-system)))) |
(setq locale-coding-system coding-system)))) |
2317 |
|
|
2318 |
;; Default to A4 paper if we're not in a C, POSIX or US locale. |
;; Default to A4 paper if we're not in a C, POSIX or US locale. |
2319 |
;; (See comments in Flanginfo.) |
;; (See comments in Flocale_info.) |
2320 |
(let ((locale locale) |
(let ((locale locale) |
2321 |
(paper (langinfo 'paper))) |
(paper (locale-info 'paper))) |
2322 |
(if paper |
(if paper |
2323 |
;; This will always be null at the time of writing. |
;; This will always be null at the time of writing. |
2324 |
(cond |
(cond |
2403 |
(if (and coding-system (eq (coding-system-type coding-system) 2)) |
(if (and coding-system (eq (coding-system-type coding-system) 2)) |
2404 |
;; Try to get a pretty description for ISO 2022 escape sequences. |
;; Try to get a pretty description for ISO 2022 escape sequences. |
2405 |
(function (lambda (x) (or (cdr (assq x iso-2022-control-alist)) |
(function (lambda (x) (or (cdr (assq x iso-2022-control-alist)) |
2406 |
(format "%02X" x)))) |
(format "0x%02X" x)))) |
2407 |
(function (lambda (x) (format "0x%02X" x)))) |
(function (lambda (x) (format "0x%02X" x)))) |
2408 |
str " ")) |
str " ")) |
2409 |
|
|
2439 |
(substring enc2 0 i2)))) |
(substring enc2 0 i2)))) |
2440 |
|
|
2441 |
|
|
2442 |
|
;;; arch-tag: b382c432-4b36-460e-bf4c-05efd0bb18dc |
2443 |
;;; mule-cmds.el ends here |
;;; mule-cmds.el ends here |