|
17052
|
1 ;; mule-diag.el -- show diagnosis of multilingual environment (MULE)
|
|
|
2
|
|
|
3 ;; Copyright (C) 1995 Free Software Foundation, Inc.
|
|
|
4 ;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN.
|
|
|
5
|
|
|
6 ;; Keywords: multilingual, charset, coding system, fontset, diagnosis
|
|
|
7
|
|
|
8 ;; This file is part of GNU Emacs.
|
|
|
9
|
|
|
10 ;; GNU Emacs is free software; you can redistribute it and/or modify
|
|
|
11 ;; it under the terms of the GNU General Public License as published by
|
|
|
12 ;; the Free Software Foundation; either version 2, or (at your option)
|
|
|
13 ;; any later version.
|
|
|
14
|
|
|
15 ;; GNU Emacs is distributed in the hope that it will be useful,
|
|
|
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
|
18 ;; GNU General Public License for more details.
|
|
|
19
|
|
|
20 ;; You should have received a copy of the GNU General Public License
|
|
17071
|
21 ;; along with GNU Emacs; see the file COPYING. If not, write to the
|
|
|
22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
|
|
|
23 ;; Boston, MA 02111-1307, USA.
|
|
17052
|
24
|
|
|
25 ;;; General utility function
|
|
|
26
|
|
|
27 ;; Print all arguments with single space separator in one line.
|
|
|
28 (defun print-list (&rest args)
|
|
|
29 (while (cdr args)
|
|
|
30 (if (car args)
|
|
|
31 (progn (princ (car args)) (princ " ")))
|
|
|
32 (setq args (cdr args)))
|
|
|
33 (princ (car args))
|
|
|
34 (princ "\n"))
|
|
|
35
|
|
|
36 ;;; CHARSET
|
|
|
37
|
|
|
38 ;;;###autoload
|
|
|
39 (defun list-character-sets ()
|
|
|
40 "Display a list of all charsets."
|
|
|
41 (interactive)
|
|
|
42 (with-output-to-temp-buffer "*Help*"
|
|
|
43 (print-character-sets)))
|
|
|
44
|
|
|
45 (defvar charset-other-info-func nil)
|
|
|
46
|
|
|
47 (defun print-character-sets ()
|
|
|
48 "Print information on all charsets in a machine readable format."
|
|
|
49 (princ "\
|
|
|
50 #########################
|
|
|
51 ## LIST OF CHARSETS
|
|
|
52 ## Each line corresponds to one charset.
|
|
|
53 ## The following attributes are listed in this order
|
|
|
54 ## separated by a colon `:' in one line.
|
|
|
55 ## CHARSET-SYMBOL-NAME,
|
|
|
56 ## CHARSET-ID,
|
|
|
57 ## DIMENSION (1 or 2)
|
|
|
58 ## CHARS (94 or 96)
|
|
|
59 ## BYTES (of multibyte form: 1, 2, 3, or 4),
|
|
|
60 ## WIDTH (occupied column numbers: 1 or 2),
|
|
|
61 ## DIRECTION (0:left-to-right, 1:right-to-left),
|
|
|
62 ## ISO-FINAL-CHAR (character code of ISO-2022's final character)
|
|
|
63 ## ISO-GRAPHIC-PLANE (ISO-2022's graphic plane, 0:GL, 1:GR)
|
|
|
64 ## DESCRIPTION (describing string of the charset)
|
|
|
65 ")
|
|
|
66 (let ((charsets charset-list)
|
|
|
67 charset)
|
|
|
68 (while charsets
|
|
|
69 (setq charset (car charsets))
|
|
|
70 (princ (format "%s:%03d:%d:%d:%d:%d:%d:%d:%d:%s\n"
|
|
|
71 charset
|
|
|
72 (charset-id charset)
|
|
|
73 (charset-dimension charset)
|
|
|
74 (charset-chars charset)
|
|
|
75 (charset-bytes charset)
|
|
|
76 (charset-width charset)
|
|
|
77 (charset-direction charset)
|
|
|
78 (charset-iso-final-char charset)
|
|
|
79 (charset-iso-graphic-plane charset)
|
|
|
80 (charset-description charset)))
|
|
|
81 (setq charsets (cdr charsets)))))
|
|
|
82
|
|
|
83
|
|
|
84 ;;; CODING-SYSTEM
|
|
|
85
|
|
|
86 ;; Print information of designation of each graphic register in FLAGS
|
|
|
87 ;; in human readable format. See the documentation of
|
|
|
88 ;; `make-coding-system' for the meaning of FLAGS.
|
|
|
89 (defun print-designation (flags)
|
|
|
90 (let ((graphic-register 0)
|
|
|
91 charset)
|
|
|
92 (while (< graphic-register 4)
|
|
|
93 (setq charset (aref flags graphic-register))
|
|
|
94 (princ (format
|
|
|
95 " G%d -- %s\n"
|
|
|
96 graphic-register
|
|
|
97 (cond ((null charset)
|
|
|
98 "never used")
|
|
|
99 ((eq charset t)
|
|
|
100 "no initial designation, and used by any charsets")
|
|
|
101 ((symbolp charset)
|
|
|
102 (format "%s:%s"
|
|
|
103 charset (charset-description charset)))
|
|
|
104 ((listp charset)
|
|
|
105 (if (charsetp (car charset))
|
|
|
106 (format "%s:%s, and also used by the followings:"
|
|
|
107 (car charset)
|
|
|
108 (charset-description (car charset)))
|
|
|
109 "no initial designation, and used by the followings:"))
|
|
|
110 (t
|
|
|
111 "invalid designation information"))))
|
|
|
112 (if (listp charset)
|
|
|
113 (progn
|
|
|
114 (setq charset (cdr charset))
|
|
|
115 (while charset
|
|
|
116 (cond ((eq (car charset) t)
|
|
|
117 (princ "\tany other charsets\n"))
|
|
|
118 ((charsetp (car charset))
|
|
|
119 (princ (format "\t%s:%s\n"
|
|
|
120 (car charset)
|
|
|
121 (charset-description (car charset)))))
|
|
|
122 (t
|
|
|
123 "invalid designation information"))
|
|
|
124 (setq charset (cdr charset)))))
|
|
|
125 (setq graphic-register (1+ graphic-register)))))
|
|
|
126
|
|
|
127 ;;;###autoload
|
|
|
128 (defun describe-coding-system (coding-system)
|
|
|
129 "Display information of CODING-SYSTEM."
|
|
|
130 (interactive "zCoding-system: ")
|
|
|
131 (check-coding-system coding-system)
|
|
|
132 (with-output-to-temp-buffer "*Help*"
|
|
|
133 (let ((coding-vector (coding-system-vector coding-system)))
|
|
|
134 (princ "Coding-system ")
|
|
|
135 (princ coding-system)
|
|
|
136 (princ " [")
|
|
|
137 (princ (char-to-string (coding-vector-mnemonic coding-vector)))
|
|
|
138 (princ "]: \n")
|
|
|
139 (princ " ")
|
|
|
140 (princ (coding-vector-docstring coding-vector))
|
|
|
141 (princ "\nType: ")
|
|
|
142 (let ((type (coding-vector-type coding-vector))
|
|
|
143 (flags (coding-vector-flags coding-vector)))
|
|
|
144 (princ type)
|
|
|
145 (princ ", which means ")
|
|
|
146 (cond ((eq type nil)
|
|
|
147 (princ "do no conversion."))
|
|
|
148 ((eq type t)
|
|
|
149 (princ "do automatic conversion."))
|
|
|
150 ((eq type 0)
|
|
|
151 (princ "Emacs internal multibyte form."))
|
|
|
152 ((eq type 1)
|
|
|
153 (princ "Shift-JIS (MS-KANJI)."))
|
|
|
154 ((eq type 2)
|
|
|
155 (princ "a variant of ISO-2022.\n")
|
|
|
156 (princ "Initial designations:\n")
|
|
|
157 (print-designation flags)
|
|
|
158 (princ "Other Form: \n")
|
|
|
159 (princ (if (aref flags 4) "short-form" "long-form"))
|
|
|
160 (if (aref flags 5) (princ ", ASCII@EOL"))
|
|
|
161 (if (aref flags 6) (princ ", ASCII@CNTL"))
|
|
|
162 (princ (if (aref flags 7) ", 7-bit" ", 8-bit"))
|
|
|
163 (if (aref flags 8) (princ ", use-locking-shift"))
|
|
|
164 (if (aref flags 9) (princ ", use-single-shift"))
|
|
|
165 (if (aref flags 10) (princ ", use-roman"))
|
|
|
166 (if (aref flags 10) (princ ", use-old-jis"))
|
|
|
167 (if (aref flags 11) (princ ", no-ISO6429"))
|
|
|
168 (princ "."))
|
|
|
169 ((eq type 3)
|
|
|
170 (princ "Big5."))
|
|
|
171 ((eq type 4)
|
|
|
172 (princ "do conversion by CCL program."))
|
|
|
173 (t (princ "invalid coding-system."))))
|
|
|
174 (princ "\nEOL-Type: ")
|
|
|
175 (let ((eol-type (coding-system-eoltype coding-system)))
|
|
|
176 (cond ((vectorp eol-type)
|
|
|
177 (princ "Automatic selection from ")
|
|
|
178 (princ eol-type)
|
|
|
179 (princ "\n"))
|
|
|
180 ((or (null eol-type) (eq eol-type 0)) (princ "LF\n"))
|
|
|
181 ((eq eol-type 1) (princ "CRLF\n"))
|
|
|
182 ((eq eol-type 2) (princ "CR\n"))
|
|
|
183 (t (princ "invalid\n"))))
|
|
|
184 )))
|
|
|
185
|
|
|
186 ;;;###autoload
|
|
|
187 (defun describe-current-coding-system-briefly ()
|
|
|
188 "Display coding systems currently used in a brief format in mini-buffer.
|
|
|
189
|
|
|
190 The format is \"current: [FKTPp=........] default: [FPp=......]\",
|
|
|
191 where mnemonics of the following coding systems come in this order
|
|
|
192 at the place of `...':
|
|
|
193 buffer-file-coding-system (of the current buffer)
|
|
|
194 eol-type of buffer-file-coding-system (of the current buffer)
|
|
|
195 keyboard-coding-system
|
|
|
196 terminal-coding-system
|
|
|
197 process-coding-system for read (of the current buffer, if any)
|
|
|
198 eol-type of process-coding-system for read (of the current buffer, if any)
|
|
|
199 process-coding-system for write (of the current buffer, if any)
|
|
|
200 eol-type of process-coding-system for write (of the current buffer, if any)
|
|
|
201 default buffer-file-coding-system
|
|
|
202 eol-type of default buffer-file-coding-system
|
|
|
203 default process-coding-system for read
|
|
|
204 default eol-type of process-coding-system for read
|
|
|
205 default process-coding-system for write
|
|
|
206 default eol-type of process-coding-system"
|
|
|
207 (interactive)
|
|
|
208 (let* ((proc (get-buffer-process (current-buffer)))
|
|
|
209 (process-coding-systems (if proc (process-coding-system proc))))
|
|
|
210 (message
|
|
|
211 "current: [FKTPp=%c%c%c%c%c%c%c%c] default: [FPp=%c%c%c%c%c%c]"
|
|
|
212 (coding-system-mnemonic buffer-file-coding-system)
|
|
|
213 (coding-system-eoltype-mnemonic buffer-file-coding-system)
|
|
|
214 (coding-system-mnemonic (keyboard-coding-system))
|
|
|
215 (coding-system-mnemonic (terminal-coding-system))
|
|
|
216 (coding-system-mnemonic (car process-coding-systems))
|
|
|
217 (coding-system-eoltype-mnemonic (car process-coding-systems))
|
|
|
218 (coding-system-mnemonic (cdr process-coding-systems))
|
|
|
219 (coding-system-eoltype-mnemonic (cdr process-coding-systems))
|
|
|
220 (coding-system-mnemonic (default-value 'buffer-file-coding-system))
|
|
|
221 (coding-system-eoltype-mnemonic (default-value 'buffer-file-coding-system))
|
|
|
222 (coding-system-mnemonic (car default-process-coding-system))
|
|
|
223 (coding-system-eoltype-mnemonic (car default-process-coding-system))
|
|
|
224 (coding-system-mnemonic (cdr default-process-coding-system))
|
|
|
225 (coding-system-eoltype-mnemonic (cdr default-process-coding-system))
|
|
|
226 )))
|
|
|
227
|
|
|
228 ;; Print symbol name and mnemonics of CODING-SYSTEM by `princ'.
|
|
|
229 (defsubst print-coding-system-briefly (coding-system)
|
|
|
230 (print-list ":"
|
|
|
231 coding-system
|
|
|
232 (format "[%c%c]"
|
|
|
233 (coding-system-mnemonic coding-system)
|
|
|
234 (coding-system-eoltype-mnemonic coding-system))))
|
|
|
235
|
|
|
236 ;;;###autoload
|
|
|
237 (defun describe-current-coding-system ()
|
|
|
238 "Display coding systems currently used in a detailed format."
|
|
|
239 (interactive)
|
|
|
240 (with-output-to-temp-buffer "*Help*"
|
|
|
241 (let* ((proc (get-buffer-process (current-buffer)))
|
|
|
242 (process-coding-systems (if proc (process-coding-system proc))))
|
|
|
243 (princ "Current:\n buffer-file-coding-system")
|
|
|
244 (print-coding-system-briefly buffer-file-coding-system)
|
|
|
245 (princ " keyboard-coding-system")
|
|
|
246 (print-coding-system-briefly (keyboard-coding-system))
|
|
|
247 (princ " terminal-coding-system")
|
|
|
248 (print-coding-system-briefly (terminal-coding-system))
|
|
|
249 (if process-coding-systems
|
|
|
250 (progn (princ " process-coding-system (read)")
|
|
|
251 (print-coding-system-briefly (car process-coding-systems))
|
|
|
252 (princ " process-coding-system (write)")
|
|
|
253 (print-coding-system-briefly (cdr process-coding-systems))))
|
|
|
254 (princ "Default:\n buffer-file-coding-system")
|
|
|
255 (print-coding-system-briefly (default-value 'buffer-file-coding-system))
|
|
|
256 (princ " process-coding-system (read)")
|
|
|
257 (print-coding-system-briefly (car default-process-coding-system))
|
|
|
258 (princ " process-coding-system (write)")
|
|
|
259 (print-coding-system-briefly (cdr default-process-coding-system))
|
|
|
260 (princ "coding-system-alist:\n")
|
|
|
261 (pp coding-system-alist))
|
|
|
262 (let ((l coding-category-list))
|
|
|
263 (princ "\nCoding categories (in the order of priority):\n")
|
|
|
264 (while l
|
|
|
265 (princ (format "%s -> %s\n" (car l) (symbol-value (car l))))
|
|
|
266 (setq l (cdr l))))))
|
|
|
267
|
|
|
268 ;; Print detailed information on CODING-SYSTEM.
|
|
|
269 (defun print-coding-system (coding-system)
|
|
|
270 (let ((type (coding-system-type coding-system))
|
|
|
271 (eol-type (coding-system-eoltype coding-system))
|
|
|
272 (flags (coding-system-flags coding-system)))
|
|
|
273 (princ (format "%s:%s:%c:%d:"
|
|
|
274 coding-system
|
|
|
275 type
|
|
|
276 (coding-system-mnemonic coding-system)
|
|
|
277 (if (integerp eol-type) eol-type 3)))
|
|
|
278 (cond ((eq type 2) ; ISO-2022
|
|
|
279 (let ((idx 0)
|
|
|
280 charset)
|
|
|
281 (while (< idx 4)
|
|
|
282 (setq charset (aref flags idx))
|
|
|
283 (cond ((null charset)
|
|
|
284 (princ -1))
|
|
|
285 ((eq charset t)
|
|
|
286 (princ -2))
|
|
|
287 ((charsetp charset)
|
|
|
288 (princ charset))
|
|
|
289 ((listp charset)
|
|
|
290 (princ "(")
|
|
|
291 (princ (car charset))
|
|
|
292 (setq charset (cdr charset))
|
|
|
293 (while charset
|
|
|
294 (princ ",")
|
|
|
295 (princ (car charset))
|
|
|
296 (setq charset (cdr charset)))
|
|
|
297 (princ ")")))
|
|
|
298 (princ ",")
|
|
|
299 (setq idx (1+ idx)))
|
|
|
300 (while (< idx 12)
|
|
|
301 (princ (if (aref flags idx) 1 0))
|
|
|
302 (princ ",")
|
|
|
303 (setq idx (1+ idx)))
|
|
|
304 (princ (if (aref flags idx) 1 0))))
|
|
|
305 ((eq type 4) ; CCL
|
|
|
306 (let (i len)
|
|
|
307 (setq i 0 len (length (car flags)))
|
|
|
308 (while (< i len)
|
|
|
309 (princ (format " %x" (aref (car flags) i)))
|
|
|
310 (setq i (1+ i)))
|
|
|
311 (princ ",")
|
|
|
312 (setq i 0 len (length (cdr flags)))
|
|
|
313 (while (< i len)
|
|
|
314 (princ (format " %x" (aref (cdr flags) i)))
|
|
|
315 (setq i (1+ i)))))
|
|
|
316 (t (princ 0)))
|
|
|
317 (princ ":")
|
|
|
318 (princ (coding-system-docstring coding-system))
|
|
|
319 (princ "\n")))
|
|
|
320
|
|
|
321 (defun list-coding-systems ()
|
|
|
322 "Print information on all coding systems in a machine readable format."
|
|
|
323 (with-output-to-temp-buffer "*Help*"
|
|
|
324 (princ "\
|
|
|
325 #########################
|
|
|
326 ## LIST OF CODING SYSTEMS
|
|
|
327 ## Each line corresponds to one coding system
|
|
|
328 ## Format of a line is:
|
|
|
329 ## NAME:TYPE:MNEMONIC:EOL:FLAGS:DOCSTRING,
|
|
|
330 ## where
|
|
|
331 ## TYPE = nil (no conversion), t (auto conversion),
|
|
|
332 ## 0 (Mule internal), 1 (SJIS), 2 (ISO2022), 3 (BIG5), or 4 (CCL)
|
|
|
333 ## EOL = 0 (LF), 1 (CRLF), 2 (CR), or 3 (Automatic detection)
|
|
|
334 ## FLAGS =
|
|
|
335 ## if TYPE = 2 then
|
|
|
336 ## comma (`,') separated data of the followings:
|
|
|
337 ## G0, G1, G2, G3, SHORT-FORM, ASCII-EOL, ASCII-CNTL, SEVEN,
|
|
|
338 ## LOCKING-SHIFT, SINGLE-SHIFT, USE-ROMAN, USE-OLDJIS, NO-ISO6429
|
|
|
339 ## else if TYPE = 4 then
|
|
|
340 ## comma (`,') separated CCL programs for read and write
|
|
|
341 ## else
|
|
|
342 ## 0
|
|
|
343 ##
|
|
|
344 ")
|
|
|
345 (let ((codings (make-vector 7 nil)))
|
|
|
346 (mapatoms
|
|
|
347 (function
|
|
|
348 (lambda (arg)
|
|
|
349 (if (and arg
|
|
|
350 (coding-system-p arg)
|
|
|
351 (null (get arg 'pre-write-conversion))
|
|
|
352 (null (get arg 'post-read-conversion)))
|
|
|
353 (let* ((type (coding-system-type arg))
|
|
|
354 (idx (if (null type) 0 (if (eq type t) 1 (+ type 2)))))
|
|
|
355 (if (or (= idx 0)
|
|
|
356 (vectorp (coding-system-eoltype arg)))
|
|
|
357 (aset codings idx (cons arg (aref codings idx)))))))))
|
|
|
358 (let ((idx 0) elt)
|
|
|
359 (while (< idx 7)
|
|
|
360 (setq elt (aref codings idx))
|
|
|
361 (while elt
|
|
|
362 (print-coding-system (car elt))
|
|
|
363 (setq elt (cdr elt)))
|
|
|
364 (setq idx (1+ idx)))))
|
|
|
365 (princ "\
|
|
|
366 ############################
|
|
|
367 ## LIST OF CODING CATEGORIES (ordered by priority)
|
|
|
368 ## CATEGORY:CODING-SYSTEM
|
|
|
369 ##
|
|
|
370 ")
|
|
|
371 (let ((l coding-category-list))
|
|
|
372 (while l
|
|
|
373 (princ (format "%s:%s\n" (car l) (symbol-value (car l))))
|
|
|
374 (setq l (cdr l))))
|
|
|
375 ))
|
|
|
376
|
|
|
377 ;;; FONT
|
|
|
378
|
|
|
379 ;; Print information of a font in FONTINFO.
|
|
|
380 (defun describe-font-internal (font-info &optional verbose)
|
|
|
381 (print-list "name (opened by):" (aref font-info 0))
|
|
|
382 (print-list " full name:" (aref font-info 1))
|
|
|
383 (let ((charset (aref font-info 2)))
|
|
|
384 (print-list " charset:"
|
|
|
385 (format "%s (%s)" charset (charset-description charset))))
|
|
|
386 (print-list " size:" (format "%d" (aref font-info 3)))
|
|
|
387 (print-list " height:" (format "%d" (aref font-info 4)))
|
|
|
388 (print-list " baseline-offset:" (format "%d" (aref font-info 5)))
|
|
|
389 (print-list "relative-compose:" (format "%d" (aref font-info 6))))
|
|
|
390
|
|
|
391 ;;;###autoload
|
|
|
392 (defun describe-font (fontname)
|
|
|
393 "Display information about fonts which partially match FONTNAME."
|
|
|
394 (interactive "sFontname: ")
|
|
|
395 (or window-system
|
|
|
396 (error "No window system being used"))
|
|
|
397 (let ((font-info (font-info fontname)))
|
|
|
398 (if (null font-info)
|
|
|
399 (message "No matching font")
|
|
|
400 (with-output-to-temp-buffer "*Help*"
|
|
|
401 (describe-font-internal font-info 'verbose)))))
|
|
|
402
|
|
|
403 ;; Print information in FONTINFO of a fontset named FONTSET.
|
|
|
404 (defun describe-fontset-internal (fontset fontset-info)
|
|
|
405 (print-list "Fontset:" fontset)
|
|
|
406 (let ((size (aref fontset-info 0)))
|
|
|
407 (print-list " size:" (format "%d" size)
|
|
|
408 (if (= size 0) "... which means not yet used" "")))
|
|
|
409 (print-list " height:" (format "%d" (aref fontset-info 1)))
|
|
|
410 (print-list " fonts: (charset : font name)")
|
|
|
411 (let* ((fonts (aref fontset-info 2))
|
|
|
412 elt charset requested opened)
|
|
|
413 (while fonts
|
|
|
414 (setq elt (car fonts)
|
|
|
415 charset (car elt)
|
|
|
416 requested (nth 1 elt)
|
|
|
417 opened (nth 2 elt))
|
|
|
418 (print-list " " charset ":" requested)
|
|
|
419 (if (stringp opened)
|
|
|
420 (print-list " Opened as: " opened)
|
|
|
421 (if (null opened) " -- open failed --"))
|
|
|
422 (setq fonts (cdr fonts)))))
|
|
|
423
|
|
|
424 ;;;###autoload
|
|
|
425 (defun describe-fontset (fontset)
|
|
|
426 "Display information about FONTSET."
|
|
|
427 (interactive
|
|
|
428 (if (not window-system)
|
|
|
429 (error "No window system being used")
|
|
|
430 (let ((fontset-list (mapcar '(lambda (x) (list x)) (fontset-list))))
|
|
|
431 (list (completing-read "Fontset: " fontset-list)))))
|
|
|
432 (setq fontset (query-fontset fontset))
|
|
|
433 (if (null fontset)
|
|
|
434 (error "No matching fontset")
|
|
|
435 (let ((fontset-info (fontset-info fontset)))
|
|
|
436 (with-output-to-temp-buffer "*Help*"
|
|
|
437 (describe-fontset-internal fontset fontset-info)))))
|
|
|
438
|
|
|
439
|
|
|
440 ;;; DIAGNOSIS
|
|
|
441
|
|
|
442 (defun insert-list (args)
|
|
|
443 (while (cdr args)
|
|
|
444 (insert (or (car args) "nil") " ")
|
|
|
445 (setq args (cdr args)))
|
|
|
446 (if args (insert (or (car args) "nil")))
|
|
|
447 (insert "\n"))
|
|
|
448
|
|
|
449 (defun insert-section (sec title)
|
|
|
450 (insert "########################################\n"
|
|
|
451 "# Section " (format "%d" sec) ". " title "\n"
|
|
|
452 "########################################\n\n"))
|
|
|
453
|
|
|
454 ;;;###autoload
|
|
|
455 (defun mule-diag ()
|
|
|
456 "Show diagnosis of the running Mule."
|
|
|
457 (interactive)
|
|
|
458 (let ((buf (get-buffer-create "*Diagnosis*")))
|
|
|
459 (save-excursion
|
|
|
460 (set-buffer buf)
|
|
|
461 (erase-buffer)
|
|
|
462 (insert "\t###############################\n"
|
|
|
463 "\t### Diagnosis of your Emacs ###\n"
|
|
|
464 "\t###############################\n\n"
|
|
|
465 "CONTENTS: Section 1. General Information\n"
|
|
|
466 " Section 2. Display\n"
|
|
|
467 " Section 3. Input methods\n"
|
|
|
468 " Section 4. Coding systems\n"
|
|
|
469 " Section 5. Charsets\n")
|
|
|
470 (if window-system
|
|
|
471 (insert " Section 6. Fontset list\n"))
|
|
|
472 (insert "\n")
|
|
|
473
|
|
|
474 (insert-section 1 "General Information")
|
|
|
475 (insert "Version of this emacs:\n " (emacs-version) "\n"
|
|
|
476 "Primary language:\n " primary-language "\n\n")
|
|
|
477
|
|
|
478 (insert-section 2 "Display")
|
|
|
479 (if window-system
|
|
|
480 (insert "Window-system: "
|
|
|
481 (symbol-name window-system)
|
|
|
482 (format "%s" window-system-version))
|
|
|
483 (insert "Terminal: " (getenv "TERM")))
|
|
|
484 (insert "\n\n")
|
|
|
485
|
|
|
486 (if (eq window-system 'x)
|
|
|
487 (let ((font (cdr (assq 'font (frame-parameters)))))
|
|
|
488 (insert "The selected frame is using the "
|
|
|
489 (if (query-fontset font) "fontset" "font")
|
|
|
490 ":\n\t" font))
|
|
|
491 (insert "Coding system of the terminal: "
|
|
|
492 (symbol-name (terminal-coding-system))))
|
|
|
493 (insert "\n\n")
|
|
|
494
|
|
|
495 (insert-section 3 "Input methods")
|
|
|
496 (insert "language\tinput-method\n"
|
|
|
497 "--------\t------------\n")
|
|
|
498 (let ((alist language-info-alist))
|
|
|
499 (while alist
|
|
|
500 (insert (car (car alist)))
|
|
|
501 (indent-to 16)
|
|
|
502 (let ((methods (get-language-info (car (car alist)) 'input-method)))
|
|
|
503 (if methods
|
|
|
504 (insert-list (mapcar 'car methods))
|
|
|
505 (insert "none\n")))
|
|
|
506 (setq alist (cdr alist))))
|
|
|
507 (insert "\n")
|
|
|
508 (if default-input-method
|
|
|
509 (insert "The input method used last time is: "
|
|
|
510 (cdr default-input-method)
|
|
|
511 "\n"
|
|
|
512 " for inputting the language: "
|
|
|
513 (car default-input-method)
|
|
|
514 "\n")
|
|
|
515 (insert "No input method has ever been selected.\n"))
|
|
|
516
|
|
|
517 (insert "\n")
|
|
|
518
|
|
|
519 (insert-section 4 "Coding systems")
|
|
|
520 (save-excursion (list-coding-systems))
|
|
|
521 (insert-buffer "*Help*")
|
|
|
522 (goto-char (point-max))
|
|
|
523 (insert "\n")
|
|
|
524
|
|
|
525 (insert-section 5 "Charsets")
|
|
|
526 (save-excursion (list-character-sets))
|
|
|
527 (insert-buffer "*Help*")
|
|
|
528 (goto-char (point-max))
|
|
|
529 (insert "\n")
|
|
|
530
|
|
|
531 (if window-system
|
|
|
532 (let ((fontsets (fontset-list)))
|
|
|
533 (insert-section 6 "Fontset list")
|
|
|
534 (while fontsets
|
|
|
535 (describe-fontset (car fontsets))
|
|
|
536 (insert-buffer "*Help*")
|
|
|
537 (setq fontsets (cdr fontsets)))))
|
|
|
538
|
|
|
539 (set-buffer-modified-p nil)
|
|
|
540 )
|
|
|
541 (let ((win (display-buffer buf)))
|
|
|
542 (set-window-point win 1)
|
|
|
543 (set-window-start win 1))
|
|
|
544 ))
|
|
|
545
|
|
|
546
|
|
|
547 ;;; DUMP DATA FILE
|
|
|
548
|
|
|
549 ;;;###autoload
|
|
|
550 (defun dump-charsets ()
|
|
|
551 "Dump information of all charsets into the file \"charsets.dat\"."
|
|
|
552 (list-character-sets)
|
|
|
553 (set-buffer (get-buffer "*Help*"))
|
|
|
554 (let (make-backup-files)
|
|
|
555 (write-region (point-min) (point-max) "charsets.dat"))
|
|
|
556 (kill-emacs))
|
|
|
557
|
|
|
558 ;;;###autoload
|
|
|
559 (defun dump-codings ()
|
|
|
560 "Dump information of all coding systems into the file \"codings.dat\"."
|
|
|
561 (list-coding-systems)
|
|
|
562 (set-buffer (get-buffer "*Help*"))
|
|
|
563 (let (make-backup-files)
|
|
|
564 (write-region (point-min) (point-max) "codings.dat"))
|
|
|
565 (kill-emacs))
|
|
|
566
|
