diff lisp/mule/mule-cmds.el @ 197:acd284d43ca1 r20-3b25

Import from CVS: tag r20-3b25
author cvs
date Mon, 13 Aug 2007 10:00:02 +0200
parents b405438285a2
children 850242ba4a81
line wrap: on
line diff
--- a/lisp/mule/mule-cmds.el	Mon Aug 13 09:59:07 2007 +0200
+++ b/lisp/mule/mule-cmds.el	Mon Aug 13 10:00:02 2007 +0200
@@ -1,7 +1,7 @@
 ;;; mule-cmds.el --- Commands for multilingual environment
 
-;; Copyright (C) 1995 Free Software Foundation, Inc.
 ;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN.
+;; Licensed to the Free Software Foundation.
 ;; Copyright (C) 1997 MORIOKA Tomohiko
 
 ;; Keywords: mule, multilingual
@@ -34,29 +34,22 @@
 ;; Keep "C-x C-m ..." for mule specific commands.
 (define-key ctl-x-map "\C-m" 'mule-prefix)
 
-;; (defvar mule-describe-language-support-map
-;;   (make-sparse-keymap "Describe Language Support"))
-;; (fset 'mule-describe-language-support-prefix
-;;       mule-describe-language-support-map)
-
-;; (defvar mule-set-language-environment-map
-;;   (make-sparse-keymap "Set Language Environment"))
-;; (fset 'mule-set-language-environment-prefix
-;;       mule-set-language-environment-map)
-
 (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-current-process-coding-system)
 (define-key mule-keymap "P" 'set-default-process-coding-system) ; XEmacs
-(define-key mule-keymap "i" 'select-input-method)
+(define-key mule-keymap "\C-\\" 'select-input-method)
 (define-key mule-keymap "c" 'list-coding-system-briefly) ; 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-current-coding-system)
 (define-key help-map "h" 'view-hello-file)
 
@@ -96,35 +89,46 @@
 
 (defun get-language-info (language-name key)
   "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)))
+  (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 (language-name key info)
   "Set for LANGUAGE-NAME the information INFO under KEY.
-LANGUAGE-NAME is a string
 KEY is a symbol denoting the kind of 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 langauge.
+
 tutorial: a tutorial file name written in the language.
+
 sample-text: one line short text containing characters of the language.
-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.
+
+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'.
+
 setup-function: a function to call for setting up environment
- convenient for the language.
+       convenient for a user of the language.
 
-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."
+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 language-name language-info-alist))
     (if (null lang-slot)		; If no slot for the language, add it.
@@ -135,9 +139,8 @@
 	(progn
 	  (setq key-slot (list key))
 	  (setcdr lang-slot (cons key-slot (cdr lang-slot)))))
-    (setcdr key-slot info)
     ;; Setup menu.
-    (cond ((eq key 'describe-function)
+    (cond ((eq key 'documentation)
            ;; (define-key-after mule-describe-language-support-map
            ;;   (vector (intern language-name))
            ;;   (cons language-name info)
@@ -161,54 +164,99 @@
   "Set for LANGUAGE-NAME the information in ALIST.
 ALIST is an alist of KEY and INFO.  See the documentation of
 `set-langauge-info' for the meanings of KEY and INFO."
+  (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 initial-input)
-  "Read language name which has information for KEY, prompting with PROMPT."
+(defun read-language-name (key prompt &optional default)
+  "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
 				(function (lambda (elm) (assq key elm)))
-				t
-				initial-input)))
-    (and (> (length name) 0)
-	 (car (assoc-ignore-case (downcase name) language-info-alist)))))
+				t nil nil default)))
+    (if (and (> (length name) 0)
+	     (get-language-info name key))
+	name)))
 
 ;;; Multilingual input methods.
 
+(defconst leim-list-file-name "leim-list.el"
+  "Name of LEIM list file.
+This file contains a list of libraries of Emacs input methods (LEIM)
+in the format of Lisp expression for registering each input method.
+Emacs loads this file at startup time.")
+
+(defvar leim-list-header (format "\
+;;; %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 registeres
+;; the whole input methods in Emacs.
+;;
+;; Each entry has the form:
+;;   (register-input-method
+;;    INPUT-METHOD LANGUAGE-NAME ACTIVATE-FUNC
+;;    TITLE DESCRIPTION
+;;    ARG ...)
+;; See the function `register-input-method' for the meanings of arguments.
+;;
+;; If this directory is included in load-path, Emacs automatically
+;; loads this file at startup time.
+
+"
+				 leim-list-file-name)
+  "Header to be inserted in LEIM list file.")
+
+(defvar leim-list-entry-regexp "^(register-input-method"
+  "Regexp matching head of each entry in LEIM list file.
+See also the variable `leim-list-header'")
+
+(defvar update-leim-list-functions
+  '(quail-update-leim-list-file)
+  "List of functions to call to update LEIM list file.
+Each function is called with one arg, LEIM directory name.")
+
+(defun update-leim-list-file (&rest dirs)
+  "Update LEIM list file in directories DIRS."
+  (let ((functions update-leim-list-functions))
+    (while functions
+      (apply (car functions) dirs)
+      (setq functions (cdr functions)))))
+
 (defvar current-input-method nil
   "The current input method for multilingual text.
-The value is a cons of language name and input method name.
-If nil, it means no input method is activated now.")
+If nil, that means no input method is activated now.")
 (make-variable-buffer-local 'current-input-method)
 (put 'current-input-method 'permanent-local t)
 
 (defvar current-input-method-title nil
-  "Title string of the current input method shown in mode line.
-Every input method should set this to an appropriate value when activated.")
+  "Title string of the current input method shown in mode line.")
 (make-variable-buffer-local 'current-input-method-title)
 (put 'current-input-method-title 'permanent-local t)
 
-(defvar default-input-method nil
-  "Default input method.
-The default input method is the one activated automatically by the command
-`toggle-input-method' (\\[toggle-input-method]).
-The value is a cons of language name and input method name.")
+(defcustom default-input-method nil
+  "*Default input method for multilingual text.
+This is the input method activated automatically by the command
+`toggle-input-method' (\\[toggle-input-method])."
+  :group 'mule)
 
-(defvar default-input-method-title nil
-  "Title string of the default input method.")
-
-(defvar previous-input-method nil
-  "Input method selected previously.
-This is the one selected before the current input method is selected.
-See also the documentation of `default-input-method'.")
+(defvar input-method-history nil
+  "History list for some commands that read input methods.")
+(make-variable-buffer-local 'input-method-history)
+(put 'input-method-history 'permanent-local t)
 
 (defvar inactivate-current-input-method-function nil
   "Function to call for inactivating the current input method.
 Every input method should set this to an appropriate value when activated.
-This function is called with no argument.")
+This function is called with no argument.
+
+This function should never change the value of `current-input-method'.
+It is set to nil by the function `inactivate-input-method'.")
 (make-variable-buffer-local 'inactivate-current-input-method-function)
 (put 'inactivate-current-input-method-function 'permanent-local t)
 
@@ -218,104 +266,140 @@
 (make-variable-buffer-local 'describe-current-input-method-function)
 (put 'describe-current-input-method-function 'permanent-local t)
 
-(defun register-input-method (language-name input-method)
-  "Register INPUT-METHOD as an input method of LANGUAGE-NAME.
-LANGUAGE-NAME is a string.
-INPUT-METHOD is a list of the form:
-	(METHOD-NAME ACTIVATE-FUNC ARG ...)
-where METHOD-NAME is the name of this method,
-ACTIVATE-FUNC is the function to call for activating this method.
-Arguments for the function are METHOD-NAME and ARGs."
-  (let ((slot (get-language-info language-name 'input-method))
-	method-slot)
-    (if (null slot)
-	(set-language-info language-name 'input-method (list input-method))
-      (setq method-slot (assoc (car input-method) slot))
-      (if method-slot
-	  (setcdr method-slot (cdr input-method))
-	(set-language-info language-name 'input-method
-			   (cons input-method slot))))))
+(defvar input-method-alist nil
+  "Alist of input method names vs the corresponding information to use it.
+Each element has the form:
+	(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 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 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 language-name args))
+	(slot (assoc input-method input-method-alist)))
+    (if slot
+	(setcdr slot info)
+      (setq slot (cons input-method info))
+      (setq input-method-alist (cons slot input-method-alist)))))
+
+(defun read-input-method-name (prompt &optional default inhibit-null)
+  "Read a name of input method from a minibuffer prompting with PROMPT.
+If DEFAULT is non-nil, use that as the default,
+  and substitute it into PROMPT at the first `%s'.
+If INHIBIT-NULL is non-nil, null input signals an error.
 
-(defun read-language-and-input-method-name ()
-  "Read a language names and the corresponding input method from a minibuffer.
-Return a cons of those names."
-  (let ((language-name (read-language-name
-			'input-method
-			"Language: "
-			(if previous-input-method
-			    (cons (car previous-input-method) 0)))))
-    (if (null language-name)
-	(error "No input method for the specified language"))
-    (let* ((completion-ignore-case t)
-	   (key-slot (cdr (assq 'input-method
-				(assoc language-name language-info-alist))))
-	   (method-name
-	    (completing-read "Input method: " key-slot nil t
-			     (if (and previous-input-method
-				      (string= language-name
-					       (car previous-input-method)))
-				 (cons (cdr previous-input-method) 0)))))
-      (if (= (length method-name) 0)
-	  (error "No input method specified"))
-      (list language-name
-	    (car (assoc-ignore-case (downcase method-name) key-slot))))))
+The return value is a string."
+  (if default
+      (setq prompt (format prompt default)))
+  (let* ((completion-ignore-case t)
+	 ;; 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 (> (length input-method) 0)
+	input-method
+      (if inhibit-null
+	  (error "No valid input method is specified")))))
 
-(defun set-default-input-method (language-name method-name)
-  "Set the default input method to METHOD-NAME for inputting LANGUAGE-NAME.
-The default input method is the one activated automatically by the command
-`toggle-input-method' (\\[toggle-input-method]).
-This doesn't affect the currently activated input method."
-  (interactive (read-language-and-input-method-name))
-  (let* ((key-slot (get-language-info language-name 'input-method))
-	 (method-slot (assoc method-name key-slot)))
-    (if (null method-slot)
-	(error "No input method `%s' for %s" method-name language-name))
-    (setq default-input-method (cons language-name method-name))))
+(defun activate-input-method (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 current-input-method
+    (let ((slot (assoc input-method input-method-alist)))
+      (if (null 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))
+      (run-hooks 'input-method-activate-hook))))
 
-(defun select-input-method (language-name method-name)
-  "Select and activate input method METHOD-NAME for inputting LANGUAGE-NAME.
-The information for activating METHOD-NAME is stored
-in `language-info-alist' under the key 'input-method.
-The format of the information has the form:
-	((METHOD-NAME ACTIVATE-FUNC ARG ...) ...)
-where ACTIVATE-FUNC is a function to call for activating this method.
-Arguments for the function are METHOD-NAME and ARGs."
-  (interactive (read-language-and-input-method-name))
-  (let* ((key-slot (get-language-info language-name 'input-method))
-	 (method-slot (assoc method-name key-slot)))
-    (if (null method-slot)
-	(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 method-slot (cdr method-slot))
-    (apply (car method-slot) method-name (cdr method-slot))
-    (setq default-input-method
-	  (setq current-input-method (cons language-name method-name)))
-    (setq default-input-method-title current-input-method-title)
-    (setq current-input-method default-input-method)))
+(defun inactivate-input-method ()
+  "Turn off the current input method."
+  (when current-input-method
+    (if input-method-history
+	(unless (string= current-input-method (car input-method-history))
+	  (setq input-method-history
+		(cons current-input-method
+		      (delete current-input-method input-method-history))))
+      (setq input-method-history (list current-input-method)))
+    (unwind-protect
+	(funcall inactivate-current-input-method-function)
+      (unwind-protect
+	  (run-hooks 'input-method-inactivate-hook)
+	(setq current-input-method nil
+	      current-input-method-title nil)))))
+
+(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
+	    (if default "Select input method (default %s): " "Select input method: ")
+	    default t))))
+  (activate-input-method input-method)
+  (setq default-input-method input-method))
 
 (defun toggle-input-method (&optional arg)
-  "Toggle whether a multilingual input method is activated in this buffer.
-With arg, activate an input method specified interactively.
-Without arg, the method being activated is the one selected most recently,
- but if no input method has ever been selected, select one interactively."
+  "Turn on or off a multilingual text input method for the current buffer.
+
+With arg, read an input method from 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').
+
+When there's no input method to turn on, turn on what read from minibuffer."
   (interactive "P")
-  (if arg
-      (call-interactively 'select-input-method)
-    (if (null current-input-method)
-	(if default-input-method
-	    (select-input-method (car default-input-method)
-				 (cdr default-input-method))
-	  (call-interactively 'select-input-method))
-      (funcall inactivate-current-input-method-function)
-      (setq current-input-method nil))))
+  (if (eq arg 1)
+      (setq arg nil))
+  (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))
+	   (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 ()
-  "Describe the current input method."
-  (interactive)
+(defun describe-input-method (input-method)
+  "Describe  input method INPUT-METHOD."
+  (interactive
+   (list (read-input-method-name
+	  "Describe input method (default, current choice): ")))
+  (if (and input-method (symbolp input-method))
+      (setq input-method (symbol-name input-method)))
+  (if (null input-method)
+      (describe-current-input-method)
+    (with-output-to-temp-buffer "*Help*"
+      (let ((elt (assoc input-method input-method-alist)))
+	(princ (format "Input method: %s (`%s' in mode line) for %s\n  %s\n"
+		       input-method (nth 3 elt) (nth 1 elt) (nth 4 elt)))))))
+
+(defun describe-current-input-method ()
+  "Describe the input method currently in use."
   (if current-input-method
       (if (and (symbolp describe-current-input-method-function)
 	       (fboundp describe-current-input-method-function))
@@ -323,40 +407,74 @@
 	(message "No way to describe the current input method `%s'"
 		 (cdr current-input-method))
 	(ding))
-    (message "No input method is activated now")
-    (ding)))
+    (error "No input method is activated now")))
 
 (defun read-multilingual-string (prompt &optional initial-input
-					language-name method-name)
+					input-method)
   "Read a multilingual string from minibuffer, prompting with string PROMPT.
 The input method selected last time is activated in minibuffer.
-If non-nil, second arg INITIAL-INPUT is a string to insert before reading.
-Optional 3rd and 4th arguments LANGUAGE-NAME and METHOD-NAME specify
- the input method to be activated instead of the one selected last time."
-  (let ((minibuffer-setup-hook '(toggle-input-method))
-	(default-input-method default-input-method))
-    (if (and language-name method-name)
-	(set-default-input-method language-name method-name))
-    (read-string prompt initial-input)))
+If optional second arg INITIAL-INPUT is non-nil, insert it in the minibuffer
+initially.
+Optional 3rd argument INPUT-METHOD specifies the input method
+to be activated instead of the one selected last time.  It is a symbol
+or a string."
+  (setq input-method
+	(or 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 ((current-input-method input-method))
+    (read-string prompt initial-input nil nil t)))
 
 ;; Variables to control behavior of input methods.  All input methods
 ;; should react to these variables.
 
-(defvar input-method-tersely-flag nil
-  "*If this flag is non-nil, input method works rather tersely.
+(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.
 
-For instance, Quail input method does not show guidance buffer while
-inputting at minibuffer if this flag is t.")
+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."
+  :type 'boolean
+  :group 'mule)
 
 (defvar input-method-activate-hook nil
-  "Normal hook run just after an input method is activated.")
+  "Normal hook run just after an input method is activated.
+
+The variable `current-input-method' keeps the input method name
+just activated.")
 
 (defvar input-method-inactivate-hook nil
-  "Normal hook run just after an input method is inactivated.")
+  "Normal hook run just after an input method is inactivated.
+
+The variable `current-input-method' still keeps the input method name
+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-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 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.")
+
 
 ;;; Language specific setup functions.
 ;; (defun set-language-environment (language-name)