(list-character-sets-1): New subroutine.

(list-character-sets): Use it.
(list-coding-systems-1): New subroutine.
(list-coding-systems): Use it.
(list-input-methods-1): New subroutine.
(list-input-methods): Use it.
(mule-diag): Avoid method of displaying text in *Help* then copying it.
Instead, insert it directly into *Mule-Diagnosis*.
Use list-character-sets-1, list-coding-systems-1, list-input-methods-1.
Copy the code from list-fontsets and list-coding-categories.
Improve the display buffer's header.

diff --git a/lisp/international/mule-diag.el b/lisp/international/mule-diag.el
index 2ebf0eaf7e0effcc0db86f8dc1608fabcf7ee998..188a681370ca95d0833bd13e15a2d62c4c0ddeb8 100644 (file)
--- a/lisp/international/mule-diag.el
+++ b/lisp/international/mule-diag.el
@@ -59,21 +59,26 @@ but still shows the full information."
   (with-output-to-temp-buffer "*Help*"
     (save-excursion
       (set-buffer standard-output)
-      (let ((l charset-list)
-           charset)
-       (if (null arg)
-           (progn
-             (insert "ID  Name             B W Description\n")
-             (insert "--  ----             - - -----------\n")
-             (while l
-               (setq charset (car l) l (cdr l))
-               (insert (format "%03d %s" (charset-id charset) charset))
-               (indent-to 28)
-               (insert (format "%d %d %s\n"
-                               (charset-bytes charset)
-                               (charset-width charset)
-                               (charset-description charset)))))
-         (insert "\
+      (list-character-sets-1 arg)
+      (help-mode)
+      (setq truncate-lines t))))
+
+(defun list-character-sets-1 (arg)
+  (let ((l charset-list)
+       charset)
+    (if (null arg)
+       (progn
+         (insert "ID  Name                 B W Description\n")
+         (insert "--  ----                 - - -----------\n")
+         (while l
+           (setq charset (car l) l (cdr l))
+           (insert (format "%03d %s" (charset-id charset) charset))
+           (indent-to 28)
+           (insert (format "%d %d %s\n"
+                           (charset-bytes charset)
+                           (charset-width charset)
+                           (charset-description charset)))))
+      (insert "\
 #########################
 ## LIST OF CHARSETS
 ## Each line corresponds to one charset.
@@ -90,21 +95,19 @@ but still shows the full information."
 ##     ISO-GRAPHIC-PLANE (ISO-2022's graphic plane, 0:GL, 1:GR)
 ##     DESCRIPTION (describing string of the charset)
 ")
-         (while l
-           (setq charset (car l) l (cdr l))
-           (princ (format "%03d:%s:%d:%d:%d:%d:%d:%d:%d:%s\n" 
-                          (charset-id charset)
-                          charset
-                          (charset-dimension charset)
-                          (charset-chars charset)
-                          (charset-bytes charset)
-                          (charset-width charset)
-                          (charset-direction charset)
-                          (charset-iso-final-char charset)
-                          (charset-iso-graphic-plane charset)
-                          (charset-description charset))))))
-      (help-mode)
-      (setq truncate-lines t))))
+      (while l
+       (setq charset (car l) l (cdr l))
+       (princ (format "%03d:%s:%d:%d:%d:%d:%d:%d:%d:%s\n" 
+                      (charset-id charset)
+                      charset
+                      (charset-dimension charset)
+                      (charset-chars charset)
+                      (charset-bytes charset)
+                      (charset-width charset)
+                      (charset-direction charset)
+                      (charset-iso-final-char charset)
+                      (charset-iso-graphic-plane charset)
+                      (charset-description charset)))))))
 \f
 ;;; CODING-SYSTEM
 
@@ -475,14 +478,17 @@ With prefix arg, the output format gets more cryptic,
 but still contains full information about each coding system."
   (interactive "P")
   (with-output-to-temp-buffer "*Help*"
-    (if (null arg)
-       (princ "\
+    (list-coding-systems-1 arg)))
+
+(defun list-coding-systems-1 (arg)
+  (if (null arg)
+      (princ "\
 ###############################################
 # List of coding systems in the following format:
 # MNEMONIC-LETTER -- CODING-SYSTEM-NAME
 #      DOC-STRING
 ")
-      (princ "\
+    (princ "\
 #########################
 ## LIST OF CODING SYSTEMS
 ## Each line corresponds to one coding system
@@ -507,14 +513,14 @@ but still contains full information about each coding system."
 ##  POST-READ-CONVERSION, PRE-WRITE-CONVERSION = function name to be called
 ##
 "))
-    (let ((bases (coding-system-list 'base-only))
-         coding-system)
-      (while bases
-       (setq coding-system (car bases))
-       (if (null arg)
-           (print-coding-system-briefly coding-system 'doc-string)
-         (print-coding-system coding-system))
-       (setq bases (cdr bases))))))
+  (let ((bases (coding-system-list 'base-only))
+       coding-system)
+    (while bases
+      (setq coding-system (car bases))
+      (if (null arg)
+         (print-coding-system-briefly coding-system 'doc-string)
+       (print-coding-system coding-system))
+      (setq bases (cdr bases)))))
 
 ;;;###automatic
 (defun list-coding-categories ()
@@ -662,6 +668,7 @@ see the function `describe-fontset' for the format of the list."
       (error "No fontsets being used")
     (with-output-to-temp-buffer "*Help*"
       (save-excursion
+       ;; This code is duplicated near the end of mule-diag.
        (set-buffer standard-output)
        (insert "Fontset-Name\t\t\t\t\t\t  WDxHT Style\n")
        (insert "------------\t\t\t\t\t\t  ----- -----\n")
@@ -675,9 +682,12 @@ see the function `describe-fontset' for the format of the list."
   "Display information about all input methods."
   (interactive)
   (with-output-to-temp-buffer "*Help*"
-    (if (not input-method-alist)
-       (progn
-         (princ "
+    (list-input-methods-1)))
+
+(defun list-input-methods-1 ()
+  (if (not input-method-alist)
+      (progn
+       (princ "
 No input method is available, perhaps because you have not yet
 installed LEIM (Libraries of Emacs Input Method).
 
@@ -686,28 +696,28 @@ if there exists an archive file `emacs-20.N.tar.gz', there should also
 be a file `leim-20.N.tar.gz'.  When you extract this file, LEIM files
 are put under the subdirectory `emacs-20.N/leim'.  When you install
 Emacs again, you should be able to use various input methods."))
-      (princ "LANGUAGE\n  NAME (`TITLE' in mode line)\n")
-      (princ "    SHORT-DESCRIPTION\n------------------------------\n")
-      (setq input-method-alist
-           (sort input-method-alist
-                 (function (lambda (x y) (string< (nth 1 x) (nth 1 y))))))
-      (let ((l input-method-alist)
-           language elt)
-       (while l
-         (setq elt (car l) l (cdr l))
-         (when (not (equal language (nth 1 elt)))
-           (setq language (nth 1 elt))
-           (princ language)
-           (terpri))
-         (princ (format "  %s (`%s' in mode line)\n    %s\n"
-                        (car elt)
-                        (let ((title (nth 3 elt)))
-                          (if (and (consp title) (stringp (car title)))
-                              (car title)
-                            title))
-                        (let ((description (nth 4 elt)))
-                          (string-match ".*" description)
-                          (match-string 0 description)))))))))
+    (princ "LANGUAGE\n  NAME (`TITLE' in mode line)\n")
+    (princ "    SHORT-DESCRIPTION\n------------------------------\n")
+    (setq input-method-alist
+         (sort input-method-alist
+               (function (lambda (x y) (string< (nth 1 x) (nth 1 y))))))
+    (let ((l input-method-alist)
+         language elt)
+      (while l
+       (setq elt (car l) l (cdr l))
+       (when (not (equal language (nth 1 elt)))
+         (setq language (nth 1 elt))
+         (princ language)
+         (terpri))
+       (princ (format "  %s (`%s' in mode line)\n    %s\n"
+                      (car elt)
+                      (let ((title (nth 3 elt)))
+                        (if (and (consp title) (stringp (car title)))
+                            (car title)
+                          title))
+                      (let ((description (nth 4 elt)))
+                        (string-match ".*" description)
+                        (match-string 0 description))))))))
 \f
 ;;; DIAGNOSIS
 
@@ -729,9 +739,9 @@ system which uses fontsets)."
   (with-output-to-temp-buffer "*Mule-Diagnosis*"
     (save-excursion
       (set-buffer standard-output)
-      (insert "\t###############################\n"
-             "\t### Diagnosis of your Emacs ###\n"
-             "\t###############################\n\n"
+      (insert "###############################################\n"
+             "### Current Status of Multilingual Features ###\n"
+             "###############################################\n\n"
              "CONTENTS: Section 1.  General Information\n"
              "          Section 2.  Display\n"
              "          Section 3.  Input methods\n"
@@ -762,29 +772,39 @@ system which uses fontsets)."
       (insert "\n\n")
 
       (insert-section 3 "Input methods")
-      (save-excursion (list-input-methods))
-      (insert-buffer-substring "*Help*")
+      (list-input-methods-1)
       (insert "\n")
       (if default-input-method
          (insert "Default input method: " default-input-method "\n")
        (insert "No default input method is specified\n"))
 
       (insert-section 4 "Coding systems")
-      (save-excursion (list-coding-systems t))
-      (insert-buffer-substring "*Help*")
-      (save-excursion (list-coding-categories))
-      (insert-buffer-substring "*Help*")
+      (list-coding-systems-1 t)
+      (princ "\
+############################
+## LIST OF CODING CATEGORIES (ordered by priority)
+## CATEGORY:CODING-SYSTEM
+##
+")
+      (let ((l coding-category-list))
+       (while l
+         (princ (format "%s:%s\n" (car l) (symbol-value (car l))))
+         (setq l (cdr l))))
       (insert "\n")
 
       (insert-section 5 "Character sets")
-      (save-excursion (list-character-sets t))
-      (insert-buffer-substring "*Help*")
+      (list-character-sets-1 t)
       (insert "\n")
 
       (when (and window-system (boundp 'global-fontset-alist))
+       ;; This code duplicates most of list-fontsets.
        (insert-section 6 "Fontsets")
-       (save-excursion (list-fontsets t))
-       (insert-buffer-substring "*Help*"))
+       (insert "Fontset-Name\t\t\t\t\t\t  WDxHT Style\n")
+       (insert "------------\t\t\t\t\t\t  ----- -----\n")
+       (let ((fontsets (fontset-list)))
+         (while fontsets
+           (print-fontset (car fontsets) t)
+           (setq fontsets (cdr fontsets)))))
       (print-help-return-message))))
 
 \f