Mercurial > emacs
changeset 17758:8c67c2e2cc29
(build-describe-language-support-function,
build-set-language-environment-function): The functions deleted.
(set-language-info): Doc-string modified. Chage handling of
special keys describe-function and setup-function.
(read-language-name): Return nil if a language specified does not
have KEY.
(current-input-method-title): Doc-string modified.
(select-input-method): Set current-input-method to nil even if
inactivation of the current input method failed.
(set-language-environment): Doc-string modified.
(describe-language-support): Doc-string modified. Calls an
appropriate function for each langauge.
(describe-language-support-internal): New function.
author | Kenichi Handa <handa@m17n.org> |
---|---|
date | Mon, 12 May 1997 06:56:23 +0000 |
parents | f008897b73f0 |
children | ef12c80a8a1e |
files | lisp/international/mule-cmds.el |
diffstat | 1 files changed, 81 insertions(+), 84 deletions(-) [+] |
line wrap: on
line diff
--- a/lisp/international/mule-cmds.el Mon May 12 06:56:21 1997 +0000 +++ b/lisp/international/mule-cmds.el Mon May 12 06:56:23 1997 +0000 @@ -50,7 +50,7 @@ (define-key mule-keymap "m" 'toggle-enable-multibyte-characters) (define-key mule-keymap "f" 'set-buffer-file-coding-system) (define-key mule-keymap "t" 'set-terminal-coding-system) -(define-key mule-keymap "k" 'set-keyboard-coding-system) +(define-key mule-keymap "k" 'encoded-kbd-set-coding-system) (define-key mule-keymap "p" 'set-current-process-coding-system) (define-key mule-keymap "i" 'select-input-method) (define-key mule-keymap "\C-\\" 'select-input-method) @@ -68,8 +68,8 @@ '("--")) (define-key mule-keymap [set-process-coding-system] '("Set coding system of process" . set-current-process-coding-system)) -(define-key mule-keymap [set-keyboard-coding-system] - '("Set coding system of keyboard" . set-keyboard-coding-system)) +(define-key mule-keymap [encoded-kbd-set-coding-system] + '("Set coding system for Encoded-kbd mode" . encoded-kbd-set-coding-system)) (define-key mule-keymap [set-terminal-coding-system] '("Set coding system of terminal" . set-terminal-coding-system)) (define-key mule-keymap [set-buffer-file-coding-system] @@ -94,12 +94,11 @@ '("Disable/enable multibyte character" . toggle-enable-multibyte-characters)) ;; These are meaningless when running under X. -(put 'set-keyboard-coding-system 'menu-enable +(put 'encoded-kbd-set-coding-system 'menu-enable '(null window-system)) (put 'set-terminal-coding-system 'menu-enable '(null window-system)) - ;; This should be a single character key binding because users use it ;; very frequently while editing multilingual text. Now we can use ;; only two such keys: "\C-\\" and "\C-^", but the latter is not @@ -145,24 +144,11 @@ "Return the information for LANGUAGE-NAME of the kind KEY. LANGUAGE-NAME is a string. KEY is a symbol denoting the kind of required information." - (let ((lang-slot (assoc language-name language-info-alist))) + (let ((lang-slot (assoc-ignore-case + (downcase language-name) language-info-alist))) (if lang-slot (cdr (assq key (cdr lang-slot)))))) -;; Return a lambda form which calls `describe-language-support' with -;; argument LANG. -(defun build-describe-language-support-function (lang) - `(lambda () - (interactive) - (describe-language-support ,lang))) - -;; Return a lambda form which calls `set-language-environment' with -;; argument LANG. -(defun build-set-language-environment-function (lang) - `(lambda () - (interactive) - (set-language-environment ,lang))) - (defun set-language-info (language-name key info) "Set for LANGUAGE-NAME the information INFO under KEY. LANGUAGE-NAME is a string @@ -172,18 +158,20 @@ 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 langauge. -setup-function: see the documentation of `set-language-environment'. tutorial: a tutorial file name written in the language. sample-text: one line short text containing characters of the language. -documentation: a docstring describing how the language is supported, - or a fuction to call to describe it, - or t which means call `describe-language-support' to describe it. input-method: alist of input method names for the language vs information for activating them. Use `register-input-method' (which see) to add a new input method to the alist. +documentation: a string describing how Emacs supports the langauge. +describe-function: a function to call for descriebing how Emacs supports + the language. The function uses information listed abobe. +setup-function: a function to call for setting up environment + convenient for the language. -Emacs will use more KEYs in the future. To avoid the conflition, users -should use prefix \"user-\" in the name of KEY." +Emacs will use more KEYs in the future. To avoid conflict, users +should use prefix \"user-\" in the name of KEY if he wants to set +different kind of information." (let (lang-slot key-slot) (setq lang-slot (assoc language-name language-info-alist)) (if (null lang-slot) ; If no slot for the language, add it. @@ -196,16 +184,16 @@ (setcdr lang-slot (cons key-slot (cdr lang-slot))))) (setcdr key-slot info) ;; Setup menu. - (cond ((eq key 'documentation) - (define-key mule-describe-language-support-map + (cond ((eq key 'describe-function) + (define-key-after mule-describe-language-support-map (vector (intern language-name)) - (cons language-name - (build-describe-language-support-function language-name)))) + (cons language-name info) + t)) ((eq key 'setup-function) - (define-key mule-set-language-environment-map + (define-key-after mule-set-language-environment-map (vector (intern language-name)) - (cons language-name - (build-set-language-environment-function language-name))))) + (cons language-name info) + t))) )) (defun set-language-info-alist (language-name alist) @@ -224,8 +212,9 @@ (function (lambda (elm) (assq key elm))) t initial-input))) - (and (> (length name) 0) - (car (assoc-ignore-case (downcase name) language-info-alist))))) + (if (and (> (length name) 0) + (get-language-info name key)) + name))) ;;; Multilingual input methods. @@ -238,7 +227,7 @@ (defvar current-input-method-title nil "Title string of the current input method shown in mode line. -Every input method should set this an appropriate value when activated.") +Every input method should set this to an appropriate value when activated.") (make-variable-buffer-local 'current-input-method-title) (put 'current-input-method-title 'permanent-local t) @@ -338,9 +327,10 @@ (error "No input method `%s' for %s" method-name language-name)) (if current-input-method (progn - (if (not (equal previous-input-method current-input-method)) - (setq previous-input-method current-input-method)) - (funcall inactivate-current-input-method-function))) + (setq previous-input-method current-input-method) + (unwind-protect + (funcall inactivate-current-input-method-function) + (setq current-input-method nil)))) (setq method-slot (cdr method-slot)) (apply (car method-slot) method-name (cdr method-slot)) (setq default-input-method @@ -411,9 +401,9 @@ ;;; Language specific setup functions. (defun set-language-environment (language-name) - "Setup a user's environment for LANGUAGE-NAME. + "Setup multilingual environment convenient for LANGUAGE-NAME. -To setup, a fucntion returned by: +For that, a fucntion returned by: (get-language-info LANGUAGE-NAME 'setup-function) is called." (interactive (list (read-language-name 'setup-function "Language: "))) @@ -430,52 +420,59 @@ (princ "\n")) (defun describe-language-support (language-name) - "Show documentation about how Emacs supports LANGUAGE-NAME." + "Describe how Emacs supports LANGUAGE-NAME. + +For that, a function returned by: + (get-language-info LANGUAGE-NAME 'describe-function) +is called." (interactive (list (read-language-name 'documentation "Language: "))) - (let (doc) + (let (func) (if (or (null language-name) - (null (setq doc - (get-language-info language-name 'documentation)))) + (null (setq func + (get-language-info language-name 'describe-function)))) (error "No documentation for the specified language")) - (with-output-to-temp-buffer "*Help*" - (if (not (eq doc t)) - (cond ((stringp doc) - (princ doc)) - ((and (symbolp doc) (fboundp doc)) - (funcall doc)) - (t - (error "Invalid documentation data for %s" language-name))) - (princ-list "List of items specific to " - language-name - " environment") - (princ "-----------------------------------------------------------\n") - (let ((str (get-language-info language-name 'sample-text))) - (if (stringp str) - (progn - (princ "<sample text>\n") - (princ-list " " str)))) - (princ "<input methods>\n") - (let ((l (get-language-info language-name 'input-method))) - (while l - (princ-list " " (car (car l))) - (setq l (cdr l)))) - (princ "<character sets>\n") - (let ((l (get-language-info language-name 'charset))) - (if (null l) - (princ-list " nothing specific to " language-name) - (while l - (princ-list " " (car l) - (format ":%3d:\n\t" (charset-id (car l))) - (charset-description (car l))) - (setq l (cdr l))))) - (princ "<coding systems>\n") - (let ((l (get-language-info language-name 'coding-system))) - (if (null l) - (princ-list " nothing specific to " language-name) - (while l - (princ-list " " (car l) ":\n\t" - (coding-system-docstring (car l))) - (setq l (cdr l))))))))) + (funcall func))) + +;; Print LANGUAGE-NAME specific information such as input methods, +;; charsets, and coding systems. This function is intended to be +;; called from various describe-LANGUAGE-support functions defined in +;; lisp/language/LANGUAGE.el. +(defun describe-language-support-internal (language-name) + (with-output-to-temp-buffer "*Help*" + (let ((doc (get-language-info language-name 'documentation))) + (if (stringp doc) + (princ-list doc))) + (princ "-----------------------------------------------------------\n") + (princ-list "List of items specific to " + language-name + " support") + (princ "-----------------------------------------------------------\n") + (let ((str (get-language-info language-name 'sample-text))) + (if (stringp str) + (progn + (princ "<sample text>\n") + (princ-list " " str)))) + (princ "<input methods>\n") + (let ((l (get-language-info language-name 'input-method))) + (while l + (princ-list " " (car (car l))) + (setq l (cdr l)))) + (princ "<character sets>\n") + (let ((l (get-language-info language-name 'charset))) + (if (null l) + (princ-list " nothing specific to " language-name) + (while l + (princ-list " " (car l) ": " + (charset-description (car l))) + (setq l (cdr l))))) + (princ "<coding systems>\n") + (let ((l (get-language-info language-name 'coding-system))) + (if (null l) + (princ-list " nothing specific to " language-name) + (while l + (princ-list " " (car l) ":\n\t" + (coding-system-docstring (car l))) + (setq l (cdr l))))))) ;;; Charset property