;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
;; 02111-1307, USA.
+;; Note: Some of the code here is now in code-cmds.el
+
;;; Code:
;;; MULE related key bindings and menus.
-(defvar mule-keymap (make-sparse-keymap "Mule")
- "Keymap for Mule (Multilingual environment) specific commands.")
+(require 'code-cmds)
-;; Keep "C-x C-m ..." for mule specific commands.
-(define-key ctl-x-map "\C-m" mule-keymap)
+;; Preserve the old name
+(defvaralias 'mule-keymap 'coding-keymap)
-(define-key mule-keymap "f" 'set-buffer-file-coding-system)
-(define-key mule-keymap "F" 'set-default-buffer-file-coding-system) ; XEmacs
-(define-key mule-keymap "t" 'set-terminal-coding-system)
-(define-key mule-keymap "k" 'set-keyboard-coding-system)
-(define-key mule-keymap "p" 'set-buffer-process-coding-system)
(define-key mule-keymap "x" 'set-selection-coding-system)
(define-key mule-keymap "X" 'set-next-selection-coding-system)
(define-key mule-keymap "\C-\\" 'set-input-method)
-(define-key mule-keymap "c" 'universal-coding-system-argument)
;;(define-key mule-keymap "c" 'list-coding-system-briefly) ; XEmacs
(define-key mule-keymap "C" 'describe-coding-system) ; XEmacs
(define-key mule-keymap "r" 'toggle-display-direction) ; XEmacs
(define-key mule-keymap "l" 'set-language-environment)
-(define-key help-map "\C-L" 'describe-language-support)
(define-key help-map "L" 'describe-language-environment)
(define-key help-map "\C-\\" 'describe-input-method)
(define-key help-map "I" 'describe-input-method)
-(define-key help-map "C" 'describe-coding-system)
(define-key help-map "h" 'view-hello-file)
;; Menu for XEmacs were moved to menubar-items.el.
(let ((base (coding-system-base coding-system)))
(if (not eol-type)
base
- (if (= eol-type orig-eol-type)
+ (if (eq eol-type orig-eol-type)
coding-system
(setq orig-eol-type (coding-system-eol-type base))
(if (null orig-eol-type)
(let ((coding-system-for-read 'iso-2022-7bit))
(find-file-read-only (expand-file-name "HELLO" data-directory))))
-(defun universal-coding-system-argument ()
- "Execute an I/O command using the specified coding system."
- (interactive)
- (let* ((default (and buffer-file-coding-system
- (not (eq (coding-system-type buffer-file-coding-system)
- t))
- (coding-system-name buffer-file-coding-system)))
- (coding-system
- (read-coding-system
- (if default
- (format "Coding system for following command (default, %s): "
- default)
- "Coding system for following command: ")
- default))
- (keyseq (read-key-sequence
- (format "Command to execute with %s:" coding-system)))
- (cmd (key-binding keyseq)))
- (let ((coding-system-for-read coding-system)
- (coding-system-for-write coding-system))
- (message "")
- (call-interactively cmd))))
-
-(defun set-default-coding-systems (coding-system)
- "Set default value of various coding systems to CODING-SYSTEM.
-This sets the following coding systems:
- o coding system of a newly created buffer
- o default coding system for terminal output
- o default coding system for keyboard input
- o default coding system for subprocess I/O
- o default coding system for converting file names."
- (check-coding-system coding-system)
- ;;(setq-default buffer-file-coding-system coding-system)
- (set-default-buffer-file-coding-system coding-system)
- ;; (if default-enable-multibyte-characters
- ;; (setq default-file-name-coding-system coding-system))
- ;; If coding-system is nil, honor that on MS-DOS as well, so
- ;; that they could reset the terminal coding system.
- ;; (unless (and (eq window-system 'pc) coding-system)
- ;; (setq default-terminal-coding-system coding-system))
- (setq terminal-coding-system coding-system)
- ;;(setq default-keyboard-coding-system coding-system)
- (setq keyboard-coding-system coding-system)
- ;;(setq default-process-coding-system (cons coding-system coding-system))
- (add-hook 'comint-exec-hook
- `(lambda ()
- (let ((proc (get-buffer-process (current-buffer))))
- (set-process-input-coding-system proc ',coding-system)
- (set-process-output-coding-system proc ',coding-system)))
- 'append)
- (setq file-name-coding-system coding-system))
-
-(defun prefer-coding-system (coding-system)
- "Add CODING-SYSTEM at the front of the priority list for automatic detection.
-This also sets the following coding systems:
- o coding system of a newly created buffer
- o default coding system for terminal output
- o default coding system for keyboard input
- o default coding system for converting file names.
-
-If CODING-SYSTEM specifies a certain type of EOL conversion, the coding
-systems set by this function will use that type of EOL conversion.
-
-This command does not change the default value of terminal coding system
-for MS-DOS terminal, because DOS terminals only support a single coding
-system, and Emacs automatically sets the default to that coding system at
-startup."
- (interactive "zPrefer coding system: ")
- (if (not (and coding-system (find-coding-system coding-system)))
- (error "Invalid coding system `%s'" coding-system))
- (let ((coding-category (coding-system-category coding-system))
- (base (coding-system-base coding-system))
- (eol-type (coding-system-eol-type coding-system)))
- (if (not coding-category)
- ;; CODING-SYSTEM is no-conversion or undecided.
- (error "Can't prefer the coding system `%s'" coding-system))
- (set-coding-category-system coding-category (or base coding-system))
- ;; (update-coding-systems-internal)
- (or (eq coding-category (car (coding-category-list)))
- ;; We must change the order.
- (set-coding-priority-list (list coding-category)))
- (if (and base (interactive-p))
- (message "Highest priority is set to %s (base of %s)"
- base coding-system))
- ;; If they asked for specific EOL conversion, honor that.
- (if (memq eol-type '(lf crlf mac))
- (setq coding-system
- (coding-system-change-eol-conversion base eol-type))
- (setq coding-system base))
- (set-default-coding-systems coding-system)))
-
-;; (defun find-coding-systems-region-subset-p (list1 list2)
-;; "Return non-nil if all elements in LIST1 are included in LIST2.
-;; Comparison done with EQ."
-;; (catch 'tag
-;; (while list1
-;; (or (memq (car list1) list2)
-;; (throw 'tag nil))
-;; (setq list1 (cdr list1)))
-;; t))
-
-;; (defun find-coding-systems-region (from to)
-;; "Return a list of proper coding systems to encode a text between FROM and TO.
-;; All coding systems in the list can safely encode any multibyte characters
-;; in the text.
-;;
-;; If the text contains no multibyte characters, return a list of a single
-;; element `undecided'."
-;; (find-coding-systems-for-charsets (find-charset-region from to)))
-
-;; (defun find-coding-systems-string (string)
-;; "Return a list of proper coding systems to encode STRING.
-;; All coding systems in the list can safely encode any multibyte characters
-;; in STRING.
-;;
-;; If STRING contains no multibyte characters, return a list of a single
-;; element `undecided'."
-;; (find-coding-systems-for-charsets (find-charset-string string)))
-
-;; (defun find-coding-systems-for-charsets (charsets)
-;; "Return a list of proper coding systems to encode characters of CHARSETS.
-;; CHARSETS is a list of character sets."
-;; (if (or (null charsets)
-;; (and (= (length charsets) 1)
-;; (eq 'ascii (car charsets))))
-;; '(undecided)
-;; (setq charsets (delq 'composition charsets))
-;; (let ((l (coding-system-list 'base-only))
-;; (charset-preferred-codings
-;; (mapcar (function
-;; (lambda (x)
-;; (if (eq x 'unknown)
-;; 'raw-text
-;; (get-charset-property x 'preferred-coding-system))))
-;; charsets))
-;; (priorities (mapcar (function (lambda (x) (symbol-value x)))
-;; coding-category-list))
-;; codings coding safe)
-;; (if (memq 'unknown charsets)
-;; ;; The region contains invalid multibyte characters.
-;; (setq l '(raw-text)))
-;; (while l
-;; (setq coding (car l) l (cdr l))
-;; (if (and (setq safe (coding-system-get coding 'safe-charsets))
-;; (or (eq safe t)
-;; (find-coding-systems-region-subset-p charsets safe)))
-;; ;; We put the higher priority to coding systems included
-;; ;; in CHARSET-PREFERRED-CODINGS, and within them, put the
-;; ;; higher priority to coding systems which support smaller
-;; ;; number of charsets.
-;; (let ((priority
-;; (+ (if (coding-system-get coding 'mime-charset) 4096 0)
-;; (lsh (length (memq coding priorities)) 7)
-;; (if (memq coding charset-preferred-codings) 64 0)
-;; (if (> (coding-system-type coding) 0) 32 0)
-;; (if (consp safe) (- 32 (length safe)) 0))))
-;; (setq codings (cons (cons priority coding) codings)))))
-;; (mapcar 'cdr
-;; (sort codings (function (lambda (x y) (> (car x) (car y))))))
-;; )))
-
-;; (defun find-multibyte-characters (from to &optional maxcount excludes)
-;; "Find multibyte characters in the region specified by FROM and TO.
-;; If FROM is a string, find multibyte characters in the string.
-;; The return value is an alist of the following format:
-;; ((CHARSET COUNT CHAR ...) ...)
-;; where
-;; CHARSET is a character set,
-;; COUNT is a number of characters,
-;; CHARs are found characters of the character set.
-;; Optional 3rd arg MAXCOUNT limits how many CHARs are put in the above list.
-;; Optional 4th arg EXCLUDE is a list of character sets to be ignored.
-;;
-;; For invalid characters, CHARs are actually strings."
-;; (let ((chars nil)
-;; charset char)
-;; (if (stringp from)
-;; (let ((idx 0))
-;; (while (setq idx (string-match "[^\000-\177]" from idx))
-;; (setq char (aref from idx)
-;; charset (char-charset char))
-;; (if (eq charset 'unknown)
-;; (setq char (match-string 0)))
-;; (if (or (eq charset 'unknown)
-;; (not (or (eq excludes t) (memq charset excludes))))
-;; (let ((slot (assq charset chars)))
-;; (if slot
-;; (if (not (memq char (nthcdr 2 slot)))
-;; (let ((count (nth 1 slot)))
-;; (setcar (cdr slot) (1+ count))
-;; (if (or (not maxcount) (< count maxcount))
-;; (nconc slot (list char)))))
-;; (setq chars (cons (list charset 1 char) chars)))))
-;; (setq idx (1+ idx))))
-;; (save-excursion
-;; (goto-char from)
-;; (while (re-search-forward "[^\000-\177]" to t)
-;; (setq char (preceding-char)
-;; charset (char-charset char))
-;; (if (eq charset 'unknown)
-;; (setq char (match-string 0)))
-;; (if (or (eq charset 'unknown)
-;; (not (or (eq excludes t) (memq charset excludes))))
-;; (let ((slot (assq charset chars)))
-;; (if slot
-;; (if (not (member char (nthcdr 2 slot)))
-;; (let ((count (nth 1 slot)))
-;; (setcar (cdr slot) (1+ count))
-;; (if (or (not maxcount) (< count maxcount))
-;; (nconc slot (list char)))))
-;; (setq chars (cons (list charset 1 char) chars))))))))
-;; (nreverse chars)))
-
-;; (defvar last-coding-system-specified nil
-;; "Most recent coding system explicitly specified by the user when asked.
-;; This variable is set whenever Emacs asks the user which coding system
-;; to use in order to write a file. If you set it to nil explicitly,
-;; then call `write-region', then afterward this variable will be non-nil
-;; only if the user was explicitly asked and specified a coding system.")
-
-;; (defun select-safe-coding-system (from to &optional default-coding-system)
-;; "Ask a user to select a safe coding system from candidates.
-;; The candidates of coding systems which can safely encode a text
-;; between FROM and TO are shown in a popup window.
-;;
-;; Optional arg DEFAULT-CODING-SYSTEM specifies a coding system to be
-;; checked at first. If omitted, buffer-file-coding-system of the
-;; current buffer is used.
-;;
-;; If the text can be encoded safely by DEFAULT-CODING-SYSTEM, it is
-;; returned without any user interaction.
-;;
-;; Kludgy feature: if FROM is a string, the string is the target text,
-;; and TO is ignored."
-;; (or default-coding-system
-;; (setq default-coding-system buffer-file-coding-system))
-;; (let* ((charsets (if (stringp from) (find-charset-string from)
-;; (find-charset-region from to)))
-;; (safe-coding-systems (find-coding-systems-for-charsets charsets)))
-;; (if (or (not enable-multibyte-characters)
-;; (eq (car safe-coding-systems) 'undecided)
-;; (eq default-coding-system 'no-conversion)
-;; (and default-coding-system
-;; (memq (coding-system-base default-coding-system)
-;; safe-coding-systems)))
-;; default-coding-system
-;;
-;; ;; At first, change each coding system to the corresponding
-;; ;; mime-charset name if it is also a coding system.
-;; (let ((l safe-coding-systems)
-;; mime-charset)
-;; (while l
-;; (setq mime-charset (coding-system-get (car l) 'mime-charset))
-;; (if (and mime-charset (coding-system-p mime-charset))
-;; (setcar l mime-charset))
-;; (setq l (cdr l))))
-;;
-;; (let ((non-safe-chars (find-multibyte-characters
-;; from to 3
-;; (and default-coding-system
-;; (coding-system-get default-coding-system
-;; 'safe-charsets))))
-;; show-position overlays)
-;; (save-excursion
-;; ;; Highlight characters that default-coding-system can't encode.
-;; (when (integerp from)
-;; (goto-char from)
-;; (let ((found nil))
-;; (while (and (not found)
-;; (re-search-forward "[^\000-\177]" to t))
-;; (setq found (assq (char-charset (preceding-char))
-;; non-safe-chars))))
-;; (forward-line -1)
-;; (setq show-position (point))
-;; (save-excursion
-;; (while (and (< (length overlays) 256)
-;; (re-search-forward "[^\000-\177]" to t))
-;; (let* ((char (preceding-char))
-;; (charset (char-charset char)))
-;; (when (assq charset non-safe-chars)
-;; (setq overlays (cons (make-overlay (1- (point)) (point))
-;; overlays))
-;; (overlay-put (car overlays) 'face 'highlight))))))
-;;
-;; ;; At last, ask a user to select a proper coding system.
-;; (unwind-protect
-;; (save-window-excursion
-;; (when show-position
-;; ;; At first, be sure to show the current buffer.
-;; (set-window-buffer (selected-window) (current-buffer))
-;; (set-window-start (selected-window) show-position))
-;; ;; Then, show a helpful message.
-;; (with-output-to-temp-buffer "*Warning*"
-;; (save-excursion
-;; (set-buffer standard-output)
-;; (insert "The target text contains the following non ASCII character(s):\n")
-;; (let ((len (length non-safe-chars))
-;; (shown 0))
-;; (while (and non-safe-chars (< shown 3))
-;; (when (> (length (car non-safe-chars)) 2)
-;; (setq shown (1+ shown))
-;; (insert (format "%25s: " (car (car non-safe-chars))))
-;; (let ((l (nthcdr 2 (car non-safe-chars))))
-;; (while l
-;; (if (or (stringp (car l)) (char-valid-p (car l)))
-;; (insert (car l)))
-;; (setq l (cdr l))))
-;; (if (> (nth 1 (car non-safe-chars)) 3)
-;; (insert "..."))
-;; (insert "\n"))
-;; (setq non-safe-chars (cdr non-safe-chars)))
-;; (if (< shown len)
-;; (insert (format "%27s\n" "..."))))
-;; (insert (format "\
-;; These can't be encoded safely by the coding system %s.
-;;
-;; Please select one from the following safe coding systems:\n"
-;; default-coding-system))
-;; (let ((pos (point))
-;; (fill-prefix " "))
-;; (mapcar (function (lambda (x) (princ " ") (princ x)))
-;; safe-coding-systems)
-;; (fill-region-as-paragraph pos (point)))))
-;;
-;; ;; Read a coding system.
-;; (let* ((safe-names (mapcar (lambda (x) (list (symbol-name x)))
-;; safe-coding-systems))
-;; (name (completing-read
-;; (format "Select coding system (default %s): "
-;; (car safe-coding-systems))
-;; safe-names nil t nil nil
-;; (car (car safe-names)))))
-;; (setq last-coding-system-specified (intern name))
-;; (if (integerp (coding-system-eol-type default-coding-system))
-;; (setq last-coding-system-specified
-;; (coding-system-change-eol-conversion
-;; last-coding-system-specified
-;; (coding-system-eol-type default-coding-system))))
-;; last-coding-system-specified))
-;; (kill-buffer "*Warning*")
-;; (while overlays
-;; (delete-overlay (car overlays))
-;; (setq overlays (cdr overlays)))))))))
-
-;; (setq select-safe-coding-system-function 'select-safe-coding-system)
-
-;; (defun select-message-coding-system ()
-;; "Return a coding system to encode the outgoing message of the current buffer.
-;; It at first tries the first coding system found in these variables
-;; in this order:
-;; (1) local value of `buffer-file-coding-system'
-;; (2) value of `sendmail-coding-system'
-;; (3) value of `default-buffer-file-coding-system'
-;; (4) value of `default-sendmail-coding-system'
-;; If the found coding system can't encode the current buffer,
-;; or none of them are bound to a coding system,
-;; it asks the user to select a proper coding system."
-;; (let ((coding (or (and (local-variable-p 'buffer-file-coding-system)
-;; buffer-file-coding-system)
-;; sendmail-coding-system
-;; default-buffer-file-coding-system
-;; default-sendmail-coding-system)))
-;; (if (eq coding 'no-conversion)
-;; ;; We should never use no-conversion for outgoing mails.
-;; (setq coding nil))
-;; (if (fboundp select-safe-coding-system-function)
-;; (funcall select-safe-coding-system-function
-;; (point-min) (point-max) coding)
-;; coding)))
\f
;;; Language support stuff.
(eval-after-load
"menubar-items.elc"
`(add-menu-button
- '("Mule" "Describe Language Support")
+ '("%_Edit" "%_Multilingual (\"Mule\")"
+ "%_Describe Language Support")
(vector ,lang-env
'(describe-language-environment ,lang-env)
t))))
(eval-after-load
"menubar-items.elc"
`(add-menu-button
- '("Mule" "Set Language Environment")
+ '("%_Edit" "%_Multilingual (\"Mule\")"
+ "%_Set Language Environment")
(vector ,lang-env
'(set-language-environment ,lang-env)
t))))
-
+
(while alist
(set-language-info lang-env (car (car alist)) (cdr (car alist)))
(setq alist (cdr alist)))))
But, if this flag is non-nil, it displays them in echo area instead.")
(defvar input-method-exit-on-invalid-key nil
- "This flag controls the behaviour of an input method on invalid key input.
+ "This flag controls the behavior of an input method on invalid key input.
Usually, when a user types a key which doesn't start any character
handled by the input method, the key is handled by turning off the
input method temporarily. After that key, the input method is re-enabled.
The default status is as follows:
- The default value of buffer-file-coding-system is nil.
+ The default value of `buffer-file-coding-system' is nil.
The default coding system for process I/O is nil.
The default value for the command `set-terminal-coding-system' is nil.
The default value for the command `set-keyboard-coding-system' is nil.
bound to each category are as follows
coding category coding system
--------------------------------------------------
- iso-8-2 iso-8859-1
- iso-8-1 iso-8859-1
iso-7 iso-2022-7bit
- iso-lock-shift iso-2022-lock
- iso-8-designate iso-2022-8bit-ss2
no-conversion raw-text
+ utf-8 utf-8
+ iso-8-1 iso-8859-1
+ iso-8-2 ctext (iso-8859-1 alias)
+ iso-8-designate ctext (iso-8859-1 alias)
+ iso-lock-shift iso-2022-lock
shift-jis shift_jis
big5 big5
- ucs-4 ----
- utf-8 ----
+ ucs-4 iso-10646-ucs-4
"
+;; The old table (from FSF synch?) was not what we use (cf mule-coding.el),
+;; and as documented iso-8-designate is inconsistent with iso-2022-8bit-ss2.
+;; The order of priorities of coding categories and the coding system
+;; bound to each category are as follows
+;; coding category coding system
+;; --------------------------------------------------
+;; iso-8-2 iso-8859-1
+;; iso-8-1 iso-8859-1
+;; iso-7 iso-2022-7bit
+;; iso-lock-shift iso-2022-lock
+;; iso-8-designate iso-2022-8bit-ss2
+;; no-conversion raw-text
+;; shift-jis shift_jis
+;; big5 big5
+;; ucs-4 ----
+;; utf-8 ----
(interactive)
- ;; This function formerly set default-enable-multibyte-characters to t,
- ;; but that is incorrect. It should not alter the unibyte/multibyte choice.
- (set-coding-category-system 'iso-7 'iso-2022-7bit)
+ (set-coding-category-system 'iso-7 'iso-2022-7)
(set-coding-category-system 'iso-8-1 'iso-8859-1)
- (set-coding-category-system 'iso-8-2 'iso-8859-1)
+ (set-coding-category-system 'iso-8-2 'ctext)
(set-coding-category-system 'iso-lock-shift 'iso-2022-lock)
- (set-coding-category-system 'iso-8-designate 'iso-2022-8bit-ss2)
+ (set-coding-category-system 'iso-8-designate 'ctext)
(set-coding-category-system 'no-conversion 'raw-text)
(set-coding-category-system 'shift-jis 'shift_jis)
(set-coding-category-system 'big5 'big5)
+ ;; #### Can we now assume the existence of the 10646 coding systems?
+ ;; #### These lists need to be synched with the ones in mule-coding.el.
(cond ((eq (coding-system-type (coding-category-system 'utf-8)) 'utf-8)
- (set-coding-category-system 'ucs-4 'iso-10646-ucs-4)
(set-coding-category-system 'utf-8 'utf-8)
- (set-coding-priority-list
- '(iso-8-1
- iso-8-2
- iso-7
- iso-lock-shift
- iso-8-designate
- utf-8
- ucs-4
- no-conversion
- shift-jis
- big5))
+ (cond ((eq (coding-system-type (coding-category-system 'ucs-4))
+ 'iso-10646-ucs-4)
+ (set-coding-category-system 'ucs-4 'iso-10646-ucs-4)
+ (set-coding-priority-list
+ '(iso-7
+ no-conversion
+ utf-8
+ iso-8-1
+ iso-8-2
+ iso-8-designate
+ iso-lock-shift
+ shift-jis
+ big5
+ ucs-4))
+ )
+ (t
+ (set-coding-priority-list
+ '(iso-7
+ no-conversion
+ utf-8
+ iso-8-1
+ iso-8-2
+ iso-8-designate
+ iso-lock-shift
+ shift-jis
+ big5))
+ ))
)
(t
(set-coding-priority-list
- '(iso-8-1
+ '(iso-7
+ no-conversion
+ iso-8-1
iso-8-2
- iso-7
- iso-lock-shift
iso-8-designate
- no-conversion
+ iso-lock-shift
shift-jis
big5))
))
"Do various coding system setups for language environment LANGUAGE-NAME.
The optional arg EOL-TYPE specifies the eol-type of the default value
-of buffer-file-coding-system set by this function."
+of buffer-file-coding-system set by this function.
+
+Note that `coding-priority-list' is not reset first; thus changing language
+environment allows recognition of coding systems from previously set language
+environments. (This will not work if the desired coding systems are from the
+same category. E.g., starting with a Hebrew language environment, ISO 8859-8
+will be recognized. If you shift to Russian, ISO 8859-8 will be shadowed by
+ISO 8859-5, and cannot be automatically recognized without resetting the
+language environment to Hebrew. However, if you shift from Japanese to
+Russian, ISO-2022-JP will continue to be automatically recognized, since
+ISO-8859-5 and ISO-2022-JP are different coding categories.)"
(let* ((priority (get-language-info language-name 'coding-priority))
(default-coding (car priority)))
(if priority
;; (memq (char-charset char) safe-charsets))
;; ;; We must find the encoded string of CHAR. But, just encoding
;; ;; CHAR will put extra control sequences (usually to designate
-;; ;; ASCII charaset) at the tail if type of CODING is ISO 2022.
+;; ;; ASCII charset) at the tail if type of CODING is ISO 2022.
;; ;; To exclude such tailing bytes, we at first encode one-char
;; ;; string and two-char string, then check how many bytes at the
;; ;; tail of both encoded strings are the same.