diff lisp/mule/mule-cmds.el @ 165:5a88923fcbfe r20-3b9

Import from CVS: tag r20-3b9
author cvs
date Mon, 13 Aug 2007 09:44:42 +0200
parents 43dd3413c7c7
children b405438285a2
line wrap: on
line diff
--- a/lisp/mule/mule-cmds.el	Mon Aug 13 09:43:39 2007 +0200
+++ b/lisp/mule/mule-cmds.el	Mon Aug 13 09:44:42 2007 +0200
@@ -31,18 +31,18 @@
   "Keymap for MULE (Multilingual environment) specific commands.")
 (fset 'mule-prefix mule-keymap)
 
-;; Keep "C-x C-k ..." for mule specific commands.
-(define-key ctl-x-map "\C-k" 'mule-prefix)
+;; 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-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)
+;; (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
@@ -74,7 +74,9 @@
 (defun view-hello-file ()
   "Display the HELLO file which list up many languages and characters."
   (interactive)
-  (find-file-read-only (expand-file-name "HELLO" data-directory)))
+  ;; We have to decode the file in any environment.
+  (let ((coding-system-for-read 'iso-2022-7))
+    (find-file-read-only (expand-file-name "HELLO" data-directory))))
 
 
 ;;; Language support staffs.
@@ -86,7 +88,7 @@
 (defvar language-info-alist nil
   "Alist of language names vs the corresponding information of various kind.
 Each element looks like:
-        (LANGUAGE-NAME . ((KEY . INFO) ...))
+	(LANGUAGE-NAME . ((KEY . INFO) ...))
 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
@@ -98,21 +100,7 @@
 KEY is a symbol denoting the kind of required information."
   (let ((lang-slot (assoc 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)))
+	(cdr (assq key (cdr lang-slot))))))
 
 (defun set-language-info (language-name key info)
   "Set for LANGUAGE-NAME the information INFO under KEY.
@@ -123,40 +111,50 @@
 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.
-        (setq lang-slot (list language-name)
-              language-info-alist (cons lang-slot language-info-alist)))
+    (if (null lang-slot)		; If no slot for the language, add it.
+	(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)))))
+    (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 mule-describe-language-support-map
-             (vector (intern language-name))
-             (cons language-name
-                   (build-describe-language-support-function language-name))))
-          ((eq key 'setup-function)
-           (define-key mule-set-language-environment-map
-             (vector (intern language-name))
-             (cons language-name
-                   (build-set-language-environment-function language-name)))))
+    (cond ((eq key 'describe-function)
+           ;; (define-key-after mule-describe-language-support-map
+           ;;   (vector (intern language-name))
+           ;;   (cons language-name info)
+           ;;   t)
+	   (eval-after-load "x-menubar"
+	     `(add-menu-button '("Mule" "Describe Language Support")
+			       (vector ,language-name ',info t)))
+	   )
+	  ((eq key 'setup-function)
+	   ;; (define-key-after mule-set-language-environment-map
+           ;;   (vector (intern language-name))
+           ;;   (cons language-name info)
+           ;;   t)
+	   (eval-after-load "x-menubar"
+	     `(add-menu-button '("Mule" "Set Language Environment")
+			       (vector ,language-name ',info t)))
+           ))
     ))
 
 (defun set-language-info-alist (language-name alist)
@@ -170,13 +168,13 @@
 (defun read-language-name (key prompt &optional initial-input)
   "Read language name which has information for KEY, prompting with PROMPT."
   (let* ((completion-ignore-case t)
-         (name (completing-read prompt
-                                language-info-alist
-                                (function (lambda (elm) (assq key elm)))
-                                t
-                                initial-input)))
+	 (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)))))
+	 (car (assoc-ignore-case (downcase name) language-info-alist)))))
 
 ;;; Multilingual input methods.
 
@@ -189,7 +187,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)
 
@@ -224,7 +222,7 @@
   "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 ...)
+	(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."
@@ -242,25 +240,25 @@
   "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)))))
+			'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"))
+	(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)))))
+	   (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"))
+	  (error "No input method specified"))
       (list language-name
-            (car (assoc-ignore-case (downcase method-name) key-slot))))))
+	    (car (assoc-ignore-case (downcase method-name) key-slot))))))
 
 (defun set-default-input-method (language-name method-name)
   "Set the default input method to METHOD-NAME for inputting LANGUAGE-NAME.
@@ -279,23 +277,23 @@
 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 ...) ...)
+	((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)))
+	 (method-slot (assoc method-name key-slot)))
     (if (null method-slot)
-        (error "No input method `%s' for %s" method-name language-name))
+	(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)))
+	(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 current-input-method (cons language-name method-name)))
     (setq default-input-method-title current-input-method-title)
     (setq current-input-method default-input-method)))
 
@@ -320,7 +318,7 @@
   (interactive)
   (if current-input-method
       (if (and (symbolp describe-current-input-method-function)
-               (fboundp describe-current-input-method-function))
+	       (fboundp describe-current-input-method-function))
 	  (funcall describe-current-input-method-function)
 	(message "No way to describe the current input method `%s'"
 		 (cdr current-input-method))
@@ -328,18 +326,18 @@
     (message "No input method is activated now")
     (ding)))
 
-;; (defun read-multilingual-string (prompt &optional initial-input
-;;                                         language-name method-name)
-;;   "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)))
+(defun read-multilingual-string (prompt &optional initial-input
+					language-name method-name)
+  "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)))
 
 ;; Variables to control behavior of input methods.  All input methods
 ;; should react to these variables.
@@ -350,14 +348,14 @@
 For instance, Quail input method does not show guidance buffer while
 inputting at minibuffer if this flag is t.")
 
-;; (defvar input-method-activate-hook nil
-;;   "Normal hook run just after an input method is activated.")
+(defvar input-method-activate-hook nil
+  "Normal hook run just after an input method is activated.")
 
-;; (defvar input-method-inactivate-hook nil
-;;   "Normal hook run just after an input method is inactivated.")
+(defvar input-method-inactivate-hook nil
+  "Normal hook run just after an input method is inactivated.")
 
-;; (defvar input-method-after-insert-chunk-hook nil
-;;   "Normal hook run just after an input method insert some chunk of text.")
+(defvar input-method-after-insert-chunk-hook nil
+  "Normal hook run just after an input method insert some chunk of text.")
 
 
 ;;; Language specific setup functions.
@@ -381,52 +379,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
 
@@ -469,6 +474,4 @@
 ;;             (nconc plist (list propname value))))
 ;;       (aset char-code-property-table char (list propname value)))))
 
-(provide 'mule-cmds)
-
 ;;; mule-cmds.el ends here