From 13cef08d9d28029c66622f8f2aeda2b1aa3c3a6f Mon Sep 17 00:00:00 2001 From: Karl Heuer Date: Wed, 3 Jun 1998 14:38:07 +0000 Subject: [PATCH] (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. --- lisp/international/mule-diag.el | 178 ++++++++++++++++++-------------- 1 file changed, 99 insertions(+), 79 deletions(-) diff --git a/lisp/international/mule-diag.el b/lisp/international/mule-diag.el index 2ebf0eaf7e0..188a681370c 100644 --- 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))))))) ;;; 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)))))))) ;;; 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)))) -- 2.39.2