Mercurial > hg > xemacs-beta
diff lisp/mule/mule-cmds.el @ 412:697ef44129c6 r21-2-14
Import from CVS: tag r21-2-14
| author | cvs |
|---|---|
| date | Mon, 13 Aug 2007 11:20:41 +0200 |
| parents | b8cc9ab3f761 |
| children | da8ed4261e83 |
line wrap: on
line diff
--- a/lisp/mule/mule-cmds.el Mon Aug 13 11:19:22 2007 +0200 +++ b/lisp/mule/mule-cmds.el Mon Aug 13 11:20:41 2007 +0200 @@ -1,6 +1,6 @@ ;;; mule-cmds.el --- Commands for multilingual environment -;; Copyright (C) 1995,1999 Electrotechnical Laboratory, JAPAN. +;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN. ;; Licensed to the Free Software Foundation. ;; Copyright (C) 1997 MORIOKA Tomohiko @@ -27,8 +27,8 @@ ;;; MULE related key bindings and menus. -(defvar mule-keymap (make-sparse-keymap "Mule") - "Keymap for Mule (Multilingual environment) specific commands.") +(defvar mule-keymap (make-sparse-keymap "MULE") + "Keymap for MULE (Multilingual environment) specific commands.") ;; Keep "C-x C-m ..." for mule specific commands. (define-key ctl-x-map "\C-m" mule-keymap) @@ -38,18 +38,18 @@ (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-\\" 'select-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 "C" 'list-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. @@ -63,80 +63,18 @@ ;; but it won't be used that frequently. (define-key global-map "\C-\\" 'toggle-input-method) -;;; This is no good because people often type Shift-SPC -;;; meaning to type SPC. -- rms. -;;; ;; Here's an alternative key binding for X users (Shift-SPACE). -;;; (define-key global-map [?\S- ] 'toggle-input-method) - -(defun coding-system-change-eol-conversion (coding-system eol-type) - "Return a coding system which differs from CODING-SYSTEM in eol conversion. -The returned coding system converts end-of-line by EOL-TYPE -but text as the same way as CODING-SYSTEM. -EOL-TYPE should be `lf', `crlf', `cr' or nil. -If EOL-TYPE is nil, the returned coding system detects -how end-of-line is formatted automatically while decoding. - -EOL-TYPE can be specified by an symbol `unix', `dos' or `mac'. -They means `lf', `crlf', and `cr' respectively." - (if (symbolp eol-type) - (setq eol-type (cond ((or (eq eol-type 'unix) - (eq eol-type 'lf)) - 'eol-lf) - ((or (eq eol-type 'dos) - (eq eol-type 'crlf)) - 'eol-crlf) - ((or (eq eol-type 'mac) - (eq eol-type 'cr)) - 'eol-cr) - (t eol-type)))) - (let ((orig-eol-type (coding-system-eol-type coding-system))) - (if (null orig-eol-type) - (if (not eol-type) - coding-system - (coding-system-property coding-system eol-type)) - (let ((base (coding-system-base coding-system))) - (if (not eol-type) - base - (if (= eol-type orig-eol-type) - coding-system - (setq orig-eol-type (coding-system-eol-type base)) - (if (null orig-eol-type) - (coding-system-property base eol-type)))))))) - -;; (defun coding-system-change-text-conversion (coding-system coding) -;; "Return a coding system which differs from CODING-SYSTEM in text conversion. -;; The returned coding system converts text by CODING -;; but end-of-line as the same way as CODING-SYSTEM. -;; If CODING is nil, the returned coding system detects -;; how text is formatted automatically while decoding." -;; (if (not coding) -;; (coding-system-base coding-system) -;; (let ((eol-type (coding-system-eol-type coding-system))) -;; (coding-system-change-eol-conversion -;; coding -;; (if (numberp eol-type) (aref [unix dos mac] eol-type)))))) - (defun view-hello-file () "Display the HELLO file which list up many languages and characters." (interactive) ;; We have to decode the file in any environment. - (let ((coding-system-for-read 'iso-2022-7bit)) + (let ((coding-system-for-read 'iso-2022-7)) (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)) + (let* ((coding-system + (read-coding-system "Coding system for following command: ")) (keyseq (read-key-sequence (format "Command to execute with %s:" coding-system))) (cmd (key-binding keyseq))) @@ -147,506 +85,183 @@ (defun set-default-coding-systems (coding-system) "Set default value of various coding systems to CODING-SYSTEM. -This sets the following coding systems: +The follwing coding systems are set: 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." + o default coding system for subprocess I/O" (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)) - (set-terminal-coding-system coding-system) + ;;(setq default-terminal-coding-system coding-system) + (setq terminal-coding-system coding-system) ;;(setq default-keyboard-coding-system coding-system) - (set-keyboard-coding-system coding-system) + (setq keyboard-coding-system coding-system) ;;(setq default-process-coding-system (cons coding-system coding-system)) - ;; Refer to coding-system-for-read and coding-system-for-write - ;; so that C-x RET c works. (add-hook 'comint-exec-hook `(lambda () (let ((proc (get-buffer-process (current-buffer)))) - (set-process-input-coding-system - proc (or coding-system-for-read ',coding-system)) - (set-process-output-coding-system - proc (or coding-system-for-write ',coding-system)))) + (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: +This also sets the following coding systems to CODING-SYSTEM: 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." + o default coding system for subprocess I/O" (interactive "zPrefer coding system: ") - (if (not (and coding-system (find-coding-system coding-system))) + (if (not (and coding-system (coding-system-p 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))) + (parent (coding-system-parent 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))) + (set coding-category (or parent coding-system)) + (if (not (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.") + (setq coding-category-list + (cons coding-category + (delq coding-category coding-category-list)))) + (if (and parent (interactive-p)) + (message "Highest priority is set to %s (parent of %s)" + parent coding-system)) + (set-default-coding-systems (or parent 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))) -;;; Language support stuff. +;;; Language support staffs. (defvar language-info-alist nil - "Alist of language environment definitions. + "Alist of language names vs the corresponding information of various kind. Each element looks like: (LANGUAGE-NAME . ((KEY . INFO) ...)) -where LANGUAGE-NAME is a string, the name of the language environment, -KEY is a symbol denoting the kind of information, and -INFO is the data associated with KEY. -Meaningful values for KEY include +where LANGUAGE-NAME is a string, +KEY is a symbol denoting the kind of information, +INFO is any Lisp object which contains the actual information related +to KEY.") - documentation value is documentation of what this language environment - is meant for, and how to use it. - charset value is a list of the character sets used by this - language environment. - sample-text value is one line of text, - written using those character sets, - appropriate for this language environment. - setup-function value is a function to call to switch to this - language environment. - exit-function value is a function to call to leave this - language environment. - coding-system value is a list of coding systems that are good - for saving text written in this language environment. - This list serves as suggestions to the user; - in effect, as a kind of documentation. - coding-priority value is a list of coding systems for this language - environment, in order of decreasing priority. - This is used to set up the coding system priority - list when you switch to this language environment. - input-method value is a default input method for this language - environment. - features value is a list of features requested in this - language environment. - tutorial value is a tutorial file name written in the language.") - -(defun get-language-info (lang-env key) - "Return information listed under KEY for language environment LANG-ENV. -KEY is a symbol denoting the kind of information. -For a list of useful values for KEY and their meanings, -see `language-info-alist'." - (if (symbolp lang-env) - (setq lang-env (symbol-name lang-env))) - (let ((lang-slot (assoc-ignore-case lang-env language-info-alist))) +(defun get-language-info (language-name key) + "Return the information for LANGUAGE-NAME of the kind KEY. +KEY is a symbol denoting the kind of required information." + (if (symbolp language-name) + (setq language-name (symbol-name language-name))) + (let ((lang-slot (assoc-ignore-case language-name language-info-alist))) (if lang-slot (cdr (assq key (cdr lang-slot)))))) -(defun set-language-info (lang-env key info) - "Modify part of the definition of language environment LANG-ENV. -Specifically, this stores the information INFO under KEY -in the definition of this language environment. +(defun set-language-info (language-name key info) + "Set for LANGUAGE-NAME the information INFO under KEY. KEY is a symbol denoting the kind of information. -INFO is the value for that information. +INFO is any Lisp object which contains the actual information. + +Currently, the following KEYs are used by Emacs: + +charset: list of symbols whose values are charsets specific to the language. + +coding-system: list of coding systems specific to the language. + +tutorial: a tutorial file name written in the language. + +sample-text: one line short text containing characters of the language. + +documentation: t or a string describing how Emacs supports the language. + If a string is specified, it is shown before any other information + of the language by the command `describe-language-environment'. -For a list of useful values for KEY and their meanings, -see `language-info-alist'." - (if (symbolp lang-env) - (setq lang-env (symbol-name lang-env))) +setup-function: a function to call for setting up environment + convenient for a user of the language. + +If KEY is documentation or setup-function, you can also specify +a cons cell as INFO, in which case, the car part should be +a normal value as INFO for KEY (as described above), +and the cdr part should be a symbol whose value is a menu keymap +in which an entry for the language is defined. But, only the car part +is actually set as the information. + +We will define more KEYs in the future. To avoid conflict, +if you want to use your own KEY values, make them start with `user-'." + (if (symbolp language-name) + (setq language-name (symbol-name language-name))) (let (lang-slot key-slot) - (setq lang-slot (assoc lang-env language-info-alist)) + (setq lang-slot (assoc language-name language-info-alist)) (if (null lang-slot) ; If no slot for the language, add it. - (setq lang-slot (list lang-env) + (setq lang-slot (list language-name) language-info-alist (cons lang-slot language-info-alist))) (setq key-slot (assq key lang-slot)) (if (null key-slot) ; If no slot for the key, add it. (progn (setq key-slot (list key)) (setcdr lang-slot (cons key-slot (cdr lang-slot))))) - (setcdr key-slot info))) + ;; Setup menu. + (cond ((eq key 'documentation) + ;; (define-key-after + ;; (if (consp info) + ;; (prog1 (symbol-value (cdr info)) + ;; (setq info (car info))) + ;; describe-language-environment-map) + ;; (vector (intern language-name)) + ;; (cons language-name 'describe-specified-language-support) + ;; t) + (if (consp info) + (setq info (car info))) + (when (featurep 'menubar) + (eval-after-load + "menubar-items.elc" + `(add-menu-button + '("Mule" "Describe Language Support") + (vector ,language-name + '(describe-language-environment ,language-name) + t)))) + ) + ((eq key 'setup-function) + ;; (define-key-after + ;; (if (consp info) + ;; (prog1 (symbol-value (cdr info)) + ;; (setq info (car info))) + ;; setup-language-environment-map) + ;; (vector (intern language-name)) + ;; (cons language-name 'setup-specified-language-environment) + ;; t) + (if (consp info) + (setq info (car info))) + (when (featurep 'menubar) + (eval-after-load + "menubar-items.elc" + `(add-menu-button + '("Mule" "Set Language Environment") + (vector ,language-name + '(set-language-environment ,language-name) + t)))) + )) -(defun set-language-info-alist (lang-env alist &optional parents) - "Store ALIST as the definition of language environment LANG-ENV. -ALIST is an alist of KEY and INFO values. See the documentation of + (setcdr key-slot info) + )) + +(defun set-language-info-alist (language-name alist) + "Set for LANGUAGE-NAME the information in ALIST. +ALIST is an alist of KEY and INFO. See the documentation of `set-language-info' for the meanings of KEY and INFO." - (if (symbolp lang-env) - (setq lang-env (symbol-name lang-env))) - (let (; (describe-map describe-language-environment-map) - ; (setup-map setup-language-environment-map) - ) - ;; (if parents - ;; (let ((l parents) - ;; map parent-symbol parent) - ;; (while l - ;; (if (symbolp (setq parent-symbol (car l))) - ;; (setq parent (symbol-name parent)) - ;; (setq parent parent-symbol parent-symbol (intern parent))) - ;; (setq map (lookup-key describe-map (vector parent-symbol))) - ;; (if (not map) - ;; (progn - ;; (setq map (intern (format "describe-%s-environment-map" - ;; (downcase parent)))) - ;; (define-prefix-command map) - ;; (define-key-after describe-map (vector parent-symbol) - ;; (cons parent map) t))) - ;; (setq describe-map (symbol-value map)) - ;; (setq map (lookup-key setup-map (vector parent-symbol))) - ;; (if (not map) - ;; (progn - ;; (setq map (intern (format "setup-%s-environment-map" - ;; (downcase parent)))) - ;; (define-prefix-command map) - ;; (define-key-after setup-map (vector parent-symbol) - ;; (cons parent map) t))) - ;; (setq setup-map (symbol-value map)) - ;; (setq l (cdr l))))) - - ;; Set up menu items for this language env. - (let ((doc (assq 'documentation alist))) - (when doc - ;; (define-key-after describe-map (vector (intern lang-env)) - ;; (cons lang-env 'describe-specified-language-support) t) - (when (featurep 'menubar) - (eval-after-load - "menubar-items.elc" - `(add-menu-button - '("%_Edit" "%_Multilingual (\"Mule\")" - "%_Describe Language Support") - (vector ,lang-env - '(describe-language-environment ,lang-env) - t)))) - )) - ;; (define-key-after setup-map (vector (intern lang-env)) - ;; (cons lang-env 'setup-specified-language-environment) t) - (when (featurep 'menubar) - (eval-after-load - "menubar-items.elc" - `(add-menu-button - '("%_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))))) + (if (symbolp language-name) + (setq language-name (symbol-name language-name))) + (while alist + (set-language-info language-name (car (car alist)) (cdr (car alist))) + (setq alist (cdr alist)))) (defun read-language-name (key prompt &optional default) - "Read a language environment name which has information for KEY. -If KEY is nil, read any language environment. -Prompt with PROMPT. DEFAULT is the default choice of language environment. -This returns a language environment name as a string." + "Read language name which has information for KEY, prompting with PROMPT. +DEFAULT is the default choice of language. +This returns a language name as a string." (let* ((completion-ignore-case t) (name (completing-read prompt language-info-alist - (and key - (function (lambda (elm) (assq key elm)))) - t nil nil default))) + (function (lambda (elm) (assq key elm))) + t nil default))) (if (and (> (length name) 0) - (or (not key) - (get-language-info name key))) + (get-language-info name key)) name))) ;;; Multilingual input methods. @@ -661,7 +276,7 @@ ";;; %s -- list of LEIM (Library of Emacs Input Method) ;; ;; This file contains a list of LEIM (Library of Emacs Input Method) -;; in the same directory as this file. Loading this file registers +;; in the same directory as this file. Loading this file registeres ;; the whole input methods in Emacs. ;; ;; Each entry has the form: @@ -706,13 +321,10 @@ (put 'current-input-method-title 'permanent-local t) (defcustom default-input-method nil - "*Default input method for multilingual text (a string). + "*Default input method for multilingual text. This is the input method activated automatically by the command `toggle-input-method' (\\[toggle-input-method])." - :group 'mule - :type '(choice (const nil) string)) - -(put 'input-method-function 'permanent-local t) + :group 'mule) (defvar input-method-history nil "History list for some commands that read input methods.") @@ -736,40 +348,26 @@ (put 'describe-current-input-method-function 'permanent-local t) (defvar input-method-alist nil - "Alist of input method names vs how to use them. + "Alist of input method names vs the corresponding information to use it. Each element has the form: - (INPUT-METHOD LANGUAGE-ENV ACTIVATE-FUNC TITLE DESCRIPTION ARGS...) -See the function `register-input-method' for the meanings of the elements.") + (INPUT-METHOD LANGUAGE-NAME ACTIVATE-FUNC TITLE DESCRIPTION ...) +See the function `register-input-method' for the meanings of each elements.") -(defun register-input-method (input-method lang-env &rest args) - "Register INPUT-METHOD as an input method for language environment ENV. -INPUT-METHOD and LANG-ENV are symbols or strings. - +(defun register-input-method (input-method language-name &rest args) + "Register INPUT-METHOD as an input method for LANGUAGE-NAME. +INPUT-METHOD and LANGUAGE-NAME are symbols or strings. The remaining arguments are: - ACTIVATE-FUNC, TITLE, DESCRIPTION, and ARGS... -ACTIVATE-FUNC is a function to call to activate this method. -TITLE is a string to show in the mode line when this method is active. -DESCRIPTION is a string describing this method and what it is good for. -The ARGS, if any, are passed as arguments to ACTIVATE-FUNC. -All told, the arguments to ACTIVATE-FUNC are INPUT-METHOD and the ARGS. - -This function is mainly used in the file \"leim-list.el\" which is -created at building time of emacs, registering all quail input methods -contained in the emacs distribution. - -In case you want to register a new quail input method by yourself, be -careful to use the same input method title as given in the third -parameter of `quail-define-package' (if the values are different, the -string specified in this function takes precedence). - -The commands `describe-input-method' and `list-input-methods' need -this duplicated values to show some information about input methods -without loading the affected quail packages." - (if (symbolp lang-env) - (setq lang-env (symbol-name lang-env))) + ACTIVATE-FUNC, TITLE, DESCRIPTION, and ARG ... + where, +ACTIVATE-FUNC is a function to call for activating this method. +TITLE is a string shown in mode-line while this method is active, +DESCRIPTION is a string describing about this method, +Arguments to ACTIVATE-FUNC are INPUT-METHOD and ARGs." + (if (symbolp language-name) + (setq language-name (symbol-name language-name))) (if (symbolp input-method) (setq input-method (symbol-name input-method))) - (let ((info (cons lang-env args)) + (let ((info (cons language-name args)) (slot (assoc input-method input-method-alist))) (if slot (setcdr slot info) @@ -789,41 +387,30 @@ ;; This binding is necessary because input-method-history is ;; buffer local. (input-method (completing-read prompt input-method-alist - nil t nil 'input-method-history - default))) - (if (and input-method (symbolp input-method)) - (setq input-method (symbol-name input-method))) + nil t nil 'input-method-history) + ;;default) + )) (if (> (length input-method) 0) input-method (if inhibit-null (error "No valid input method is specified"))))) (defun activate-input-method (input-method) - "Switch to input method INPUT-METHOD for the current buffer. -If some other input method is already active, turn it off first. -If INPUT-METHOD is nil, deactivate any current input method." - (if (and input-method (symbolp input-method)) + "Turn INPUT-METHOD on. +If some input method is already on, turn it off at first." + (if (symbolp input-method) (setq input-method (symbol-name input-method))) (if (and current-input-method (not (string= current-input-method input-method))) - (inactivate-input-method)) - (unless (or current-input-method (null input-method)) + (inactivate-input-method)) + (unless current-input-method (let ((slot (assoc input-method input-method-alist))) (if (null slot) (error "Can't activate input method `%s'" input-method)) - (let ((func (nth 2 slot))) - (if (functionp func) - (apply (nth 2 slot) input-method (nthcdr 5 slot)) - (if (and (consp func) (symbolp (car func)) (symbolp (cdr func))) - (progn - (require (cdr func)) - (apply (car func) input-method (nthcdr 5 slot))) - (error "Can't activate input method `%s'" input-method)))) + (apply (nth 2 slot) input-method (nthcdr 5 slot)) (setq current-input-method input-method) (setq current-input-method-title (nth 3 slot)) - (unwind-protect - (run-hooks 'input-method-activate-hook) - (force-mode-line-update))))) + (run-hooks 'input-method-activate-hook)))) (defun inactivate-input-method () "Turn off the current input method." @@ -839,12 +426,12 @@ (unwind-protect (run-hooks 'input-method-inactivate-hook) (setq current-input-method nil - current-input-method-title nil) - (force-mode-line-update))))) + current-input-method-title nil))))) -(defun set-input-method (input-method) - "Select and activate input method INPUT-METHOD for the current buffer. -This also sets the default input method to the one you specify." +(defun select-input-method (input-method) + "Select and turn on INPUT-METHOD. +This sets the default input method to what you specify, +and turn it on for the current buffer." (interactive (let* ((default (or (car input-method-history) default-input-method))) (list (read-input-method-name @@ -856,35 +443,28 @@ (defun toggle-input-method (&optional arg) "Turn on or off a multilingual text input method for the current buffer. -With no prefix argument, if an input method is currently activated, -turn it off. Otherwise, activate an input method -- the one most -recently used, or the one specified in `default-input-method', or -the one read from the minibuffer. +With arg, read an input method from minibuffer and turn it on. -With a prefix argument, read an input method from the minibuffer and -turn it on. +Without arg, if some input method is currently activated, turn it off, +else turn on an input method selected last time +or the default input method (see `default-input-method'). -The default is to use the most recent input method specified -\(not including the currently active input method, if any)." +When there's no input method to turn on, turn on what read from minibuffer." (interactive "P") - (if (and current-input-method (not arg)) - (inactivate-input-method) - (let ((default (or (car input-method-history) default-input-method))) - (if (and arg default (equal current-input-method default) - (> (length input-method-history) 1)) - (setq default (nth 1 input-method-history))) + (let* ((default (or (car input-method-history) default-input-method))) + (if (and current-input-method (not arg)) + (inactivate-input-method) (activate-input-method (if (or arg (not default)) - (progn - (read-input-method-name - (if default "Input method (default %s): " "Input method: " ) - default t)) + (read-input-method-name + (if default "Input method (default %s): " "Input method: " ) + default t) default)) (or default-input-method (setq default-input-method current-input-method))))) (defun describe-input-method (input-method) - "Describe input method INPUT-METHOD." + "Describe input method INPUT-METHOD." (interactive (list (read-input-method-name "Describe input method (default, current choice): "))) @@ -904,11 +484,12 @@ (fboundp describe-current-input-method-function)) (funcall describe-current-input-method-function) (message "No way to describe the current input method `%s'" - current-input-method) + (cdr current-input-method)) (ding)) (error "No input method is activated now"))) -(defun read-multilingual-string (prompt &optional initial-input input-method) +(defun read-multilingual-string (prompt &optional initial-input + input-method) "Read a multilingual string from minibuffer, prompting with string PROMPT. The input method selected last time is activated in minibuffer. If optional second arg INITIAL-INPUT is non-nil, insert it in the minibuffer @@ -918,51 +499,37 @@ or a string." (setq input-method (or input-method - current-input-method default-input-method (read-input-method-name "Input method: " nil t))) (if (and input-method (symbolp input-method)) (setq input-method (symbol-name input-method))) - (let ((prev-input-method current-input-method)) - (unwind-protect - (progn - (activate-input-method input-method) - ;; FSF Emacs - ;; (read-string prompt initial-input nil nil t) - (read-string prompt initial-input nil)) - (activate-input-method prev-input-method)))) + (let ((current-input-method input-method)) + ;; FSFmacs + ;; (read-string prompt initial-input nil nil t))) + (read-string prompt initial-input nil))) ;; Variables to control behavior of input methods. All input methods ;; should react to these variables. -(defcustom input-method-verbose-flag 'default - "*A flag to control extra guidance given by input methods. -The value should be nil, t, `complex-only', or `default'. +(defcustom input-method-verbose-flag t + "*If this flag is non-nil, input methods give extra guidance. The extra guidance is done by showing list of available keys in echo -area. When you use the input method in the minibuffer, the guidance -is shown at the bottom short window (split from the existing window). - -If the value is t, extra guidance is always given, if the value is -nil, extra guidance is always suppressed. +area. -If the value is `complex-only', only complex input methods such as -`chinese-py' and `japanese' give extra guidance. - -If the value is `default', complex input methods always give extra -guidance, but simple input methods give it only when you are not in -the minibuffer. - -See also the variable `input-method-highlight-flag'." - :type '(choice (const t) (const nil) (const complex-only) (const default)) +For complex input methods such as `chinese-py' and `japanese', +when you use the input method in the minibuffer, the guidance is +shown at the bottom short window (split from the existing window). +For simple input methods, guidance is not shown +when you are in the minibuffer." + :type 'boolean :group 'mule) (defcustom input-method-highlight-flag t "*If this flag is non-nil, input methods highlight partially-entered text. For instance, while you are in the middle of a Quail input method sequence, the text inserted so far is temporarily underlined. -The underlining goes away when you finish or abort the input method sequence. -See also the variable `input-method-verbose-flag'." +The underlining goes away when you finish or abort the input method sequence." :type 'boolean :group 'mule) @@ -976,53 +543,22 @@ "Normal hook run just after an input method is inactivated. The variable `current-input-method' still keeps the input method name -just inactivated.") +just inacitvated.") (defvar input-method-after-insert-chunk-hook nil "Normal hook run just after an input method insert some chunk of text.") -(defvar input-method-exit-on-first-char nil - "This flag controls a timing when an input method returns. -Usually, the input method does not return while there's a possibility -that it may find a different translation if a user types another key. -But, it this flag is non-nil, the input method returns as soon as -the current key sequence gets long enough to have some valid translation.") - -(defvar input-method-use-echo-area nil - "This flag controls how an input method shows an intermediate key sequence. -Usually, the input method inserts the intermediate key sequence, -or candidate translations corresponding to the sequence, -at point in the current buffer. -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. 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. +input method temporalily. After the key is handled, the input method is +back on. But, if this flag is non-nil, the input method is never back on.") -(defvar set-language-environment-hook nil - "Normal hook run after some language environment is set. - -When you set some hook function here, that effect usually should not -be inherited to another language environment. So, you had better set -another function in `exit-language-environment-hook' (which see) to -cancel the effect.") - -(defvar exit-language-environment-hook nil - "Normal hook run after exiting from some language environment. -When this hook is run, the variable `current-language-environment' -is still bound to the language environment being exited. - -This hook is mainly used for canceling the effect of -`set-language-environment-hook' (which-see).") - -(put 'setup-specified-language-environment 'apropos-inhibit t) - (defun setup-specified-language-environment () - "Switch to a specified language environment." + "Set up multi-lingual environment convenient for the specified language." (interactive) (let (language-name) (if (and (symbolp last-command-event) @@ -1032,246 +568,30 @@ (set-language-environment language-name) (error "Bogus calling sequence")))) -(defcustom current-language-environment "English" - "The last language environment specified with `set-language-environment'. -This variable should be set only with \\[customize], which is equivalent -to using the function `set-language-environment'." - :link '(custom-manual "(emacs)Language Environments") - :set (lambda (symbol value) (set-language-environment value)) - :get (lambda (x) - (or (car-safe (assoc-ignore-case - (if (symbolp current-language-environment) - (symbol-name current-language-environment) - current-language-environment) - language-info-alist)) - "English")) - :type (cons 'choice (mapcar (lambda (lang) - (list 'const (car lang))) - language-info-alist)) - :initialize 'custom-initialize-default - :group 'mule - :type 'string) - -(defun reset-language-environment () - "Reset multilingual environment of Emacs to the default status. - -The default status is as follows: - - 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. - - 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-8-1 'iso-8859-1) - (set-coding-category-system 'iso-8-2 'iso-8859-1) - (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 'no-conversion 'raw-text) - (set-coding-category-system 'shift-jis 'shift_jis) - (set-coding-category-system 'big5 'big5) - (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)) - ) - (t - (set-coding-priority-list - '(iso-8-1 - iso-8-2 - iso-7 - iso-lock-shift - iso-8-designate - no-conversion - shift-jis - big5)) - )) - - ;; (update-coding-systems-internal) - - (set-default-coding-systems nil) - ;; Don't alter the terminal and keyboard coding systems here. - ;; The terminal still supports the same coding system - ;; that it supported a minute ago. -;;; (set-terminal-coding-system-internal nil) -;;; (set-keyboard-coding-system-internal nil) - - ;; (setq nonascii-translation-table nil - ;; nonascii-insert-offset 0) - ) +(defvar current-language-environment "English" + "The last language environment specified with `set-language-environment'.") (defun set-language-environment (language-name) "Set up multi-lingual environment for using LANGUAGE-NAME. This sets the coding system priority and the default input method -and sometimes other things. LANGUAGE-NAME should be a string -which is the name of a language environment. For example, \"Latin-1\" -specifies the character set for the major languages of Western Europe." - (interactive (list (read-language-name - nil - "Set language environment (default, English): "))) +and sometimes other things." + (interactive (list (read-language-name 'setup-function + "Set language environment: "))) (if language-name (if (symbolp language-name) (setq language-name (symbol-name language-name))) (setq language-name "English")) - (or (assoc-ignore-case language-name language-info-alist) + (if (null (get-language-info language-name 'setup-function)) (error "Language environment not defined: %S" language-name)) - (if current-language-environment - (let ((func (get-language-info current-language-environment - 'exit-function))) - (run-hooks 'exit-language-environment-hook) - (if (fboundp func) (funcall func)))) - (let ((default-eol-type (coding-system-eol-type - default-buffer-file-coding-system))) - (reset-language-environment) - - (setq current-language-environment language-name) - (set-language-environment-coding-systems language-name default-eol-type)) - (let ((input-method (get-language-info language-name 'input-method))) - (when input-method - (setq default-input-method input-method) - (if input-method-history - (setq input-method-history - (cons input-method - (delete input-method input-method-history)))))) - ;; (let ((nonascii (get-language-info language-name 'nonascii-translation)) - ;; (dos-table - ;; (if (eq window-system 'pc) - ;; (intern - ;; (concat "cp" dos-codepage "-nonascii-translation-table"))))) - ;; (cond - ;; ((char-table-p nonascii) - ;; (setq nonascii-translation-table nonascii)) - ;; ((and (eq window-system 'pc) (boundp dos-table)) - ;; ;; DOS terminals' default is to use a special non-ASCII translation - ;; ;; table as appropriate for the installed codepage. - ;; (setq nonascii-translation-table (symbol-value dos-table))) - ;; ((charsetp nonascii) - ;; (setq nonascii-insert-offset (- (make-char nonascii) 128))))) - - ;; (setq charset-origin-alist - ;; (get-language-info language-name 'charset-origin-alist)) - - ;; Unibyte setups if necessary. - ;; (unless default-enable-multibyte-characters - ;; ;; Syntax and case table. - ;; (let ((syntax (get-language-info language-name 'unibyte-syntax))) - ;; (if syntax - ;; (let ((set-case-syntax-set-multibyte nil)) - ;; (load syntax nil t)) - ;; ;; No information for syntax and case. Reset to the defaults. - ;; (let ((syntax-table (standard-syntax-table)) - ;; (case-table (standard-case-table)) - ;; (ch (if (eq window-system 'pc) 128 160))) - ;; (while (< ch 256) - ;; (modify-syntax-entry ch " " syntax-table) - ;; (aset case-table ch ch) - ;; (setq ch (1+ ch))) - ;; (set-char-table-extra-slot case-table 0 nil) - ;; (set-char-table-extra-slot case-table 1 nil) - ;; (set-char-table-extra-slot case-table 2 nil)) - ;; (set-standard-case-table (standard-case-table)) - ;; (let ((list (buffer-list))) - ;; (while list - ;; (with-current-buffer (car list) - ;; (set-case-table (standard-case-table))) - ;; (setq list (cdr list)))))) - ;; ;; Display table and coding system for terminal. - ;; (let ((coding (get-language-info language-name 'unibyte-display))) - ;; (if coding - ;; (standard-display-european-internal) - ;; (standard-display-default (if (eq window-system 'pc) 128 160) 255) - ;; (aset standard-display-table 146 nil)) - ;; (or (eq window-system 'pc) - ;; (set-terminal-coding-system coding)))) - - (let ((required-features (get-language-info language-name 'features))) - (while required-features - (require (car required-features)) - (setq required-features (cdr required-features)))) - (let ((func (get-language-info language-name 'setup-function))) - (if (fboundp func) - (funcall func))) - (run-hooks 'set-language-environment-hook) + (funcall (get-language-info language-name 'setup-function)) + (setq current-language-environment language-name) (force-mode-line-update t)) -;; (defun standard-display-european-internal () -;; ;; Actually set up direct output of non-ASCII characters. -;; (standard-display-8bit (if (eq window-system 'pc) 128 160) 255) -;; ;; Unibyte Emacs on MS-DOS wants to display all 8-bit characters with -;; ;; the native font, and codes 160 and 146 stand for something very -;; ;; different there. -;; (or (and (eq window-system 'pc) (not default-enable-multibyte-characters)) -;; (progn -;; ;; Make non-line-break space display as a plain space. -;; ;; Most X fonts do the wrong thing for code 160. -;; (aset standard-display-table 160 [32]) -;; ;; Most Windows programs send out apostrophe's as \222. Most X fonts -;; ;; don't contain a character at that position. Map it to the ASCII -;; ;; apostrophe. -;; (aset standard-display-table 146 [39])))) - -(defun set-language-environment-coding-systems (language-name - &optional eol-type) - "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." - (let* ((priority (get-language-info language-name 'coding-priority)) - (default-coding (car priority))) - (if priority - (let ((categories (mapcar 'coding-system-category priority)) - category checked-categories) - (set-default-coding-systems - (if (memq eol-type '(lf crlf cr unix dos mac)) - (coding-system-change-eol-conversion default-coding eol-type) - default-coding)) - ;; (setq default-sendmail-coding-system default-coding) - (while priority - (unless (memq (setq category (car categories)) checked-categories) - (set-coding-category-system category (car priority)) - (setq checked-categories (cons category checked-categories))) - (setq priority (cdr priority) - categories (cdr categories))) - (set-coding-priority-list (nreverse checked-categories)) - ;; (update-coding-systems-internal) - )))) - ;; Print all arguments with `princ', then print "\n". (defsubst princ-list (&rest args) (while args (princ (car args)) (setq args (cdr args))) (princ "\n")) -(put 'describe-specified-language-support 'apropos-inhibit t) - ;; Print a language specific information such as input methods, ;; charsets, and coding systems. This function is intended to be ;; called from the menu: @@ -1291,7 +611,7 @@ (interactive (list (read-language-name 'documentation - "Describe language environment (default, current choice): "))) + "Describe language environment (default, current choise): "))) (if (null language-name) (setq language-name current-language-environment)) (if (or (null language-name) @@ -1301,9 +621,8 @@ (setq language-name (symbol-name language-name))) (let ((doc (get-language-info language-name 'documentation))) (with-output-to-temp-buffer "*Help*" - (princ-list language-name " language environment" "\n") (if (stringp doc) - (progn + (progn (princ-list doc) (terpri))) (let ((str (get-language-info language-name 'sample-text))) @@ -1312,15 +631,9 @@ (princ "Sample text:\n") (princ-list " " str) (terpri)))) - (let ((input-method (get-language-info language-name 'input-method)) - (l (copy-sequence input-method-alist))) - (princ "Input methods") - (when input-method - (princ (format " (default, %s)" input-method)) - (setq input-method (assoc input-method input-method-alist)) - (setq l (cons input-method (delete input-method l)))) - (princ ":\n") - (while l + (princ "Input methods:\n") + (let ((l input-method-alist)) + (while l (if (string= language-name (nth 1 (car l))) (princ-list " " (car (car l)) (format " (`%s' in mode line)" (nth 3 (car l))))) @@ -1343,14 +656,9 @@ (princ ; (format " %s (`%c' in mode line):\n\t%s\n" ;; In XEmacs, `coding-system-mnemonic' returns string. (format " %s (`%s' in mode line):\n\t%s\n" - (car l) - (coding-system-mnemonic (car l)) - (coding-system-doc-string (car l)))) - ;; (let ((aliases (coding-system-get (car l) 'alias-coding-systems))) - ;; (when aliases - ;; (princ "\t") - ;; (princ (cons 'alias: (cdr aliases))) - ;; (terpri))) + (car l) + (coding-system-mnemonic (car l)) + (coding-system-doc-string (car l)))) (setq l (cdr l)))))))) ;;; Charset property @@ -1370,7 +678,7 @@ (defvar char-code-property-table (make-char-table 'generic) "Char-table containing a property list of each character code. - +;; See also the documentation of `get-char-code-property' and `put-char-code-property'") ;; (let ((plist (aref char-code-property-table char))) @@ -1391,70 +699,8 @@ (nconc plist (list propname value)))) (put-char-table char (list propname value) char-code-property-table) ))) - - -;; Pretty description of encoded string - -;; Alist of ISO 2022 control code vs the corresponding mnemonic string. -;; (defvar iso-2022-control-alist -;; '((?\x1b . "ESC") -;; (?\x0e . "SO") -;; (?\x0f . "SI") -;; (?\x8e . "SS2") -;; (?\x8f . "SS3") -;; (?\x9b . "CSI"))) - -;; (defun encoded-string-description (str coding-system) -;; "Return a pretty description of STR that is encoded by CODING-SYSTEM." -;; (setq str (string-as-unibyte str)) -;; (let ((char (aref str 0)) -;; desc) -;; (when (< char 128) -;; (setq desc (or (cdr (assq char iso-2022-control-alist)) -;; (char-to-string char))) -;; (let ((i 1) -;; (len (length str))) -;; (while (< i len) -;; (setq char (aref str i)) -;; (if (>= char 128) -;; (setq desc nil i len) -;; (setq desc (concat desc " " -;; (or (cdr (assq char iso-2022-control-alist)) -;; (char-to-string char))) -;; i (1+ i)))))) -;; (or desc -;; (mapconcat (function (lambda (x) (format "0x%02x" x))) str " ")))) - -;; (defun encode-coding-char (char coding-system) -;; "Encode CHAR by CODING-SYSTEM and return the resulting string. -;; If CODING-SYSTEM can't safely encode CHAR, return nil." -;; (if (cmpcharp char) -;; (setq char (car (decompose-composite-char char 'list)))) -;; (let ((str1 (char-to-string char)) -;; (str2 (make-string 2 char)) -;; (safe-charsets (and coding-system -;; (coding-system-get coding-system 'safe-charsets))) -;; enc1 enc2 i1 i2) -;; (when (or (eq safe-charsets t) -;; (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 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. -;; -;; (setq enc1 (string-as-unibyte (encode-coding-string str1 coding-system)) -;; i1 (length enc1) -;; enc2 (string-as-unibyte (encode-coding-string str2 coding-system)) -;; i2 (length enc2)) -;; (while (and (> i1 0) (= (aref enc1 (1- i1)) (aref enc2 (1- i2)))) -;; (setq i1 (1- i1) i2 (1- i2))) -;; -;; ;; Now (substring enc1 i1) and (substring enc2 i2) are the same, -;; ;; and they are the extra control sequences at the tail to -;; ;; exclude. -;; (substring enc2 0 i2)))) - +;; (setcar (cdr slot) value) +;; (nconc plist (list propname value)))) +;; (aset char-code-property-table char (list propname value))))) ;;; mule-cmds.el ends here