HCoop / bpt / emacs.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
* international/mule-diag.el (print-list): Fix 2008-12-03 change.
[bpt/emacs.git] / lisp / international / mule-diag.el
CommitLineData
60370d40 1;;; mule-diag.el --- show diagnosis of multilingual environment (Mule)
4ed46869 2
26b3dce6 3;; Copyright (C) 1997, 1998, 2000, 2001, 2002, 2003, 2004, 2005, 2006,
ae940284 4;; 2007, 2008, 2009 Free Software Foundation, Inc.
7976eda0 5;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
ae940284 6;; 2005, 2006, 2007, 2008, 2009
2fd125a3
KH		 7;; National Institute of Advanced Industrial Science and Technology (AIST)
8;; Registration Number H14PRO021
8f924df7 9;; Copyright (C) 2003
2c390c27
KH		 10;; National Institute of Advanced Industrial Science and Technology (AIST)
11;; Registration Number H13PRO009
4ed46869 12
3a4df6e5 13;; Keywords: multilingual, charset, coding system, fontset, diagnosis, i18n
4ed46869
KH		 14
15;; This file is part of GNU Emacs.
16
4936186e 17;; GNU Emacs is free software: you can redistribute it and/or modify
4ed46869 18;; it under the terms of the GNU General Public License as published by
4936186e
GM		 19;; the Free Software Foundation, either version 3 of the License, or
20;; (at your option) any later version.
4ed46869
KH		 21
22;; GNU Emacs is distributed in the hope that it will be useful,
23;; but WITHOUT ANY WARRANTY; without even the implied warranty of
24;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
25;; GNU General Public License for more details.
26
27;; You should have received a copy of the GNU General Public License
4936186e 28;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
4ed46869 29
60370d40
PJ		 30;;; Commentary:
31
32;;; Code:
33
0abeb602 34;; Make sure the help-xref button type is defined.
abf545c4 35(require 'help-fns)
0abeb602 36
4ed46869
KH		 37;;; General utility function
38
4ed46869 39(defun print-list (&rest args)
3a1ef8f5 40 "Print all arguments with single space separator in one line."
ecbe9da5 41 (princ (mapconcat (lambda (arg) (prin1-to-string arg t)) args " "))
4ed46869
KH		 42 (princ "\n"))
43
44;;; CHARSET
45
e8cdeaca
MB		 46(define-button-type 'sort-listed-character-sets
47 'help-echo (purecopy "mouse-2, RET: sort on this column")
48 'face 'bold
49 'action #'(lambda (button)
50 (sort-listed-character-sets (button-get button 'sort-key))))
51
52(define-button-type 'list-charset-chars
53 :supertype 'help-xref
54 'help-function #'list-charset-chars
55 'help-echo "mouse-2, RET: show table of characters for this character set")
56
4ed46869 57;;;###autoload
efdd2d79 58(defun list-character-sets (arg)
4472a77b
KH		 59 "Display a list of all character sets.
60
7cc8aac3
PJ		 61The D column contains the dimension of this character set. The CH
62column contains the number of characters in a block of this character
63set. The FINAL-CHAR column contains an ISO-2022 <final-char> to use
64for designating this character set in ISO-2022-based coding systems.
4472a77b 65
18f515e4 66With prefix ARG, the output format gets more cryptic,
4527adca 67but still shows the full information."
4472a77b 68 (interactive "P")
55140940 69 (help-setup-xref (list #'list-character-sets arg) (interactive-p))
3aab6d06 70 (with-output-to-temp-buffer "*Character Set List*"
efdd2d79
KH		 71 (with-current-buffer standard-output
72 (if arg
73 (list-character-sets-2)
74 ;; Insert header.
875d7ad9 75 (insert "Supplementary character sets are shown below.\n")
efdd2d79
KH		 76 (insert
77 (substitute-command-keys
e5b99cff
KH		 78 (concat "Use "
79 (if (display-mouse-p) "\\[help-follow-mouse] or ")
80 "\\[help-follow]:\n")))
81 (insert " on a column title to sort by that title,")
3a1ef8f5 82 (indent-to 48)
efdd2d79 83 (insert "+----DIMENSION\n")
e5b99cff 84 (insert " on a charset name to list characters.")
3a1ef8f5 85 (indent-to 48)
efdd2d79 86 (insert "| +--CHARS\n")
3a1ef8f5
DL		 87 (let ((columns '(("CHARSET-NAME" . name) "\t\t\t\t\t"
88 ("D CH FINAL-CHAR" . iso-spec)))
efdd2d79
KH		 89 pos)
90 (while columns
91 (if (stringp (car columns))
92 (insert (car columns))
e8cdeaca
MB		 93 (insert-text-button (car (car columns))
94 :type 'sort-listed-character-sets
95 'sort-key (cdr (car columns)))
efdd2d79
KH		 96 (goto-char (point-max)))
97 (setq columns (cdr columns)))
98 (insert "\n"))
3a1ef8f5 99 (insert "------------\t\t\t\t\t- --- ----------\n")
13cef08d 100
efdd2d79 101 ;; Insert body sorted by charset IDs.
3a1ef8f5 102 (list-character-sets-1 'name)))))
efdd2d79 103
efdd2d79
KH		 104(defun sort-listed-character-sets (sort-key)
105 (if sort-key
106 (save-excursion
107 (let ((buffer-read-only nil))
108 (goto-char (point-min))
875d7ad9
KH		 109 (search-forward "\n-")
110 (forward-line 1)
111 (delete-region (point) (point-max))
112 (list-character-sets-1 sort-key)))))
efdd2d79 113
efdd2d79 114(defun list-character-sets-1 (sort-key)
3a1ef8f5
DL		 115 "Insert a list of character sets sorted by SORT-KEY.
116SORT-KEY should be `name' or `iso-spec' (default `name')."
efdd2d79 117 (or sort-key
3a1ef8f5
DL		 118 (setq sort-key 'name))
119 (let ((tail charset-list)
875d7ad9 120 charset-info-list supplementary-list charset sort-func)
3a1ef8f5 121 (dolist (charset charset-list)
efdd2d79 122 ;; Generate a list that contains all information to display.
875d7ad9
KH		 123 (let ((elt (list charset
124 (charset-dimension charset)
125 (charset-chars charset)
126 (charset-iso-final-char charset))))
127 (if (plist-get (charset-plist charset) :supplementary-p)
128 (push elt supplementary-list)
129 (push elt charset-info-list))))
efdd2d79
KH		 130
131 ;; Determine a predicate for `sort' by SORT-KEY.
132 (setq sort-func
3a1ef8f5
DL		 133 (cond ((eq sort-key 'name)
134 (lambda (x y) (string< (car x) (car y))))
efdd2d79
KH		 135
136 ((eq sort-key 'iso-spec)
137 ;; Sort by DIMENSION CHARS FINAL-CHAR
138 (function
139 (lambda (x y)
3a1ef8f5
DL		 140 (or (< (nth 1 x) (nth 1 y))
141 (and (= (nth 1 x) (nth 1 y))
142 (or (< (nth 2 x) (nth 2 y))
143 (and (= (nth 2 x) (nth 2 y))
144 (< (nth 3 x) (nth 3 y)))))))))
efdd2d79
KH		 145 (t
146 (error "Invalid charset sort key: %s" sort-key))))
147
148 (setq charset-info-list (sort charset-info-list sort-func))
875d7ad9 149 (setq supplementary-list (sort supplementary-list sort-func))
efdd2d79
KH		 150
151 ;; Insert information of character sets.
875d7ad9
KH		 152 (dolist (elt (append charset-info-list (list t) supplementary-list))
153 (if (eq elt t)
154 (insert "-------------- Supplementary Character Sets --------------")
155 (insert-text-button (symbol-name (car elt)) ; NAME
156 :type 'list-charset-chars
157 'help-args (list (car elt)))
158 (goto-char (point-max))
159 (insert "\t")
160 (indent-to 48)
161 (insert (format "%d %3d "
162 (nth 1 elt) (nth 2 elt)) ; DIMENSION and CHARS
163 (if (< (nth 3 elt) 0)
164 "none"
165 (nth 3 elt)))) ; FINAL-CHAR
efdd2d79
KH		 166 (insert "\n"))))
167
168
169;; List all character sets in a form that a program can easily parse.
170
171(defun list-character-sets-2 ()
172 (insert "#########################
4ed46869
KH		 173## LIST OF CHARSETS
174## Each line corresponds to one charset.
175## The following attributes are listed in this order
176## separated by a colon `:' in one line.
4472a77b 177## CHARSET-SYMBOL-NAME,
18f515e4
JB		 178## DIMENSION (1-4)
179## CHARS (number of characters in first dimension of charset)
4ed46869 180## ISO-FINAL-CHAR (character code of ISO-2022's final character)
f3df78db 181## -1 means that no final character is assigned.
4ed46869
KH		 182## DESCRIPTION (describing string of the charset)
183")
18f515e4
JB		 184 (dolist (charset charset-list)
185 (princ (format "%s:%d:%d:%d:%s\n"
186 charset
187 (charset-dimension charset)
188 (charset-chars charset)
189;;; (char-width (make-char charset))
190;;; (charset-direction charset)
191 (charset-iso-final-char charset)
192;;; (charset-iso-graphic-plane charset)
193 (charset-description charset)))))
efdd2d79 194
3a1ef8f5
DL		 195(defvar non-iso-charset-alist nil
196 "Obsolete.")
bc01a178 197(make-obsolete-variable 'non-iso-charset-alist "no longer relevant." "23.1")
efdd2d79 198
efdd2d79 199(defun decode-codepage-char (codepage code)
7cc8aac3
PJ		 200 "Decode a character that has code CODE in CODEPAGE.
201Return a decoded character string. Each CODEPAGE corresponds to a
bc01a178 202coding system cpCODEPAGE."
3a1ef8f5 203 (decode-char (intern (format "cp%d" codepage)) code))
8589dc17 204(make-obsolete 'decode-codepage-char 'decode-char "23.1")
efdd2d79
KH		 205
206;; A variable to hold charset input history.
207(defvar charset-history nil)
208
209
210;;;###autoload
211(defun read-charset (prompt &optional default-value initial-input)
212 "Read a character set from the minibuffer, prompting with string PROMPT.
3a1ef8f5 213It must be an Emacs character set listed in the variable `charset-list'.
efdd2d79
KH		 214
215Optional arguments are DEFAULT-VALUE and INITIAL-INPUT.
216DEFAULT-VALUE, if non-nil, is the default value.
217INITIAL-INPUT, if non-nil, is a string inserted in the minibuffer initially.
e4fe4569
JB		 218See the documentation of the function `completing-read' for the detailed
219meanings of these arguments."
3a1ef8f5 220 (let* ((table (mapcar (lambda (x) (list (symbol-name x))) charset-list))
efdd2d79
KH		 221 (charset (completing-read prompt table
222 nil t initial-input 'charset-history
223 default-value)))
224 (if (> (length charset) 0)
225 (intern charset))))
187bd11c 226
efdd2d79
KH		 227;; List characters of the range MIN and MAX of CHARSET. If dimension
228;; of CHARSET is two (i.e. 2-byte charset), ROW is the first byte
229;; (block index) of the characters, and MIN and MAX are the second
230;; bytes of the characters. If the dimension is one, ROW should be 0.
efdd2d79
KH		 231
232(defun list-block-of-chars (charset row min max)
233 (let (i ch)
35650cd2
KH		 234 (insert-char ?- (+ 7 (* 4 16)))
235 (insert "\n ")
efdd2d79
KH		 236 (setq i 0)
237 (while (< i 16)
8f924df7 238 (insert (format "%4X" i))
efdd2d79
KH		 239 (setq i (1+ i)))
240 (setq i (* (/ min 16) 16))
241 (while (<= i max)
242 (if (= (% i 16) 0)
35650cd2 243 (insert (format "\n%6Xx" (/ (+ (* row 256) i) 16))))
8f924df7
KH		 244 (setq ch (if (< i min)
245 32
246 (or (decode-char charset (+ (* row 256) i))
247 32))) ; gap in mapping
ea60d50f 248 ;; Don't insert control codes, non-Unicode characters.
8f924df7
KH		 249 (if (or (< ch 32) (= ch 127))
250 (setq ch (single-key-description ch))
251 (if (and (>= ch 128) (< ch 160))
ea60d50f
KH		 252 (setq ch (format "%02Xh" ch))
253 (if (> ch #x10FFFF)
254 (setq ch 32))))
35650cd2 255 (insert "\t" ch)
efdd2d79
KH		 256 (setq i (1+ i))))
257 (insert "\n"))
258
efdd2d79
KH		 259;;;###autoload
260(defun list-charset-chars (charset)
205a973c 261 "Display a list of characters in character set CHARSET."
efdd2d79 262 (interactive (list (read-charset "Character set: ")))
875d7ad9
KH		 263 (or (charsetp charset)
264 (error "Invalid character set: %s" charset))
3aab6d06 265 (with-output-to-temp-buffer "*Character List*"
efdd2d79 266 (with-current-buffer standard-output
8a97200f
DL		 267 (if (coding-system-p charset)
268 ;; Useful to be able to do C-u C-x = to find file code, for
269 ;; instance:
270 (set-buffer-file-coding-system charset))
3aab6d06
KH		 271 (setq mode-line-format (copy-sequence mode-line-format))
272 (let ((slot (memq 'mode-line-buffer-identification mode-line-format)))
273 (if slot
274 (setcdr slot
275 (cons (format " (%s)" charset)
276 (cdr slot)))))
35650cd2 277 (setq tab-width 4)
efdd2d79 278 (set-buffer-multibyte t)
205a973c
DL		 279 (let ((dim (charset-dimension charset))
280 (chars (charset-chars charset))
281 ;; (plane (charset-iso-graphic-plane charset))
282 (plane 1)
283 (range (plist-get (charset-plist charset) :code-space))
284 min max min2 max2)
285 (if (> dim 2)
286 (error "Can only list 1- and 2-dimensional charsets"))
287 (insert (format "Characters in the coded character set %s.\n" charset))
4a64ad45 288 (narrow-to-region (point) (point))
205a973c
DL		 289 (setq min (aref range 0)
290 max (aref range 1))
291 (if (= dim 1)
205a973c
DL		 292 (list-block-of-chars charset 0 min max)
293 (setq min2 (aref range 2)
294 max2 (aref range 3))
295 (let ((i min2))
296 (while (<= i max2)
297 (list-block-of-chars charset i min max)
4a64ad45
KH		 298 (setq i (1+ i)))))
299 (put-text-property (point-min) (point-max) 'charset charset)
300 (widen)))))
efdd2d79 301
b1e3566c 302
a399ef7b
KH		 303;;;###autoload
304(defun describe-character-set (charset)
7cc8aac3 305 "Display information about built-in character set CHARSET."
3a1ef8f5 306 (interactive (list (read-charset "Charset: ")))
a399ef7b
KH		 307 (or (charsetp charset)
308 (error "Invalid charset: %S" charset))
af279988
DL		 309 (help-setup-xref (list #'describe-character-set charset) (interactive-p))
310 (with-output-to-temp-buffer (help-buffer)
311 (with-current-buffer standard-output
feff73a4
DL		 312 (insert "Character set: " (symbol-name charset))
313 (let ((name (get-charset-property charset :name)))
314 (if (not (eq name charset))
315 (insert " (alias of " (symbol-name name) ?\))))
316 (insert "\n\n" (charset-description charset) "\n\n")
3918e9c9
DL		 317 (insert "Number of contained characters: ")
318 (dotimes (i (charset-dimension charset))
319 (unless (= i 0)
92c15c34 320 (insert ?x))
f21ee25f 321 (insert (format "%d" (charset-chars charset (1+ i)))))
3918e9c9 322 (insert ?\n)
feff73a4
DL		 323 (let ((char (charset-iso-final-char charset)))
324 (when (> char 0)
325 (insert "Final char of ISO2022 designation sequence: ")
326 (insert (format "`%c'\n" char))))
af279988 327 (insert (format "Width (how many columns on screen): %d\n"
205a973c 328 (aref char-width-table (make-char charset))))
feff73a4
DL		 329 (let (aliases)
330 (dolist (c charset-list)
331 (if (and (not (eq c charset))
332 (eq charset (get-charset-property c :name)))
333 (push c aliases)))
334 (if aliases
335 (insert "Aliases: " (mapconcat #'symbol-name aliases ", ") ?\n)))
bc01a178 336
feff73a4
DL		 337 (dolist (elt `((:ascii-compatible-p "ASCII compatible." nil)
338 (:map "Map file: " identity)
339 (:unify-map "Unification map file: " identity)
340 (:invalid-code
341 nil
342 ,(lambda (c)
343 (format "Invalid character: %c (code %d)" c c)))
344 (:emacs-mule-id "Id in emacs-mule coding system: "
345 number-to-string)
346 (:parents "Parents: "
347 (lambda (parents)
348 (mapconcat ,(lambda (elt)
349 (format "%s" elt))
350 parents
351 ", ")))
352 (:code-space "Code space: " ,(lambda (c)
353 (format "%s" c)))
354 (:code-offset "Code offset: " number-to-string)
355 (:iso-revision-number "ISO revision number: "
356 number-to-string)
357 (:supplementary-p
358 "Used only as a parent of some other charset." nil)))
359 (let ((val (get-charset-property charset (car elt))))
360 (when val
361 (if (cadr elt) (insert (cadr elt)))
362 (if (nth 2 elt)
363 (insert (funcall (nth 2 elt) val)))
364 (insert ?\n)))))))
4ed46869
KH		 365\f
366;;; CODING-SYSTEM
367
26b3dce6 368(defvar graphic-register) ; dynamic bondage
8285fa96
DL		 369
370;; Print information about designation of each graphic register in
371;; DESIGNATIONS in human readable format. See the documentation of
372;; `define-coding-system' for the meaning of DESIGNATIONS
373;; (`:designation' property).
374(defun print-designation (designations)
375 (let (charset)
376 (dotimes (graphic-register 4)
377 (setq charset (aref designations graphic-register))
4ed46869
KH		 378 (princ (format
379 " G%d -- %s\n"
380 graphic-register
381 (cond ((null charset)
382 "never used")
383 ((eq charset t)
384 "no initial designation, and used by any charsets")
385 ((symbolp charset)
386 (format "%s:%s"
387 charset (charset-description charset)))
388 ((listp charset)
389 (if (charsetp (car charset))
8285fa96 390 (format "%s:%s, and also used by the following:"
4ed46869
KH		 391 (car charset)
392 (charset-description (car charset)))
92c15c34 393 "no initial designation, and used by the following:"))
4ed46869
KH		 394 (t
395 "invalid designation information"))))
4472a77b
KH		 396 (when (listp charset)
397 (setq charset (cdr charset))
398 (while charset
399 (cond ((eq (car charset) t)
400 (princ "\tany other charsets\n"))
401 ((charsetp (car charset))
402 (princ (format "\t%s:%s\n"
403 (car charset)
404 (charset-description (car charset)))))
405 (t
187bd11c 406 "invalid designation information"))
8285fa96 407 (setq charset (cdr charset)))))))
4ed46869
KH		 408
409;;;###autoload
410(defun describe-coding-system (coding-system)
4527adca 411 "Display information about CODING-SYSTEM."
5b76833f 412 (interactive "zDescribe coding system (default current choices): ")
426f97dc
KH		 413 (if (null coding-system)
414 (describe-current-coding-system)
55140940
SM		 415 (help-setup-xref (list #'describe-coding-system coding-system)
416 (interactive-p))
417 (with-output-to-temp-buffer (help-buffer)
426f97dc 418 (print-coding-system-briefly coding-system 'doc-string)
02e91426 419 (let ((type (coding-system-type coding-system))
8f924df7
KH		 420 ;; Fixme: use this
421 (extra-spec (coding-system-plist coding-system)))
426f97dc 422 (princ "Type: ")
02e91426 423 (princ type)
2c390c27 424 (cond ((eq type 'undecided)
02e91426 425 (princ " (do automatic conversion)"))
2c390c27
KH		 426 ((eq type 'utf-8)
427 (princ " (UTF-8: Emacs internal multibyte form)"))
f3d983d8
DL		 428 ((eq type 'utf-16)
429 ;; (princ " (UTF-16)")
430 )
8285fa96 431 ((eq type 'shift-jis)
02e91426 432 (princ " (Shift-JIS, MS-KANJI)"))
2c390c27 433 ((eq type 'iso-2022)
02e91426
SM		 434 (princ " (variant of ISO-2022)\n")
435 (princ "Initial designations:\n")
8285fa96
DL		 436 (print-designation (coding-system-get coding-system
437 :designation))
438
439 (when (coding-system-get coding-system :flags)
440 (princ "Other specifications: \n ")
441 (apply #'print-list
442 (coding-system-get coding-system :flags))))
2c390c27
KH		 443 ((eq type 'charset)
444 (princ " (charset)"))
445 ((eq type 'ccl)
02e91426 446 (princ " (do conversion by CCL program)"))
2c390c27 447 ((eq type 'raw-text)
02e91426 448 (princ " (text with random binary characters)"))
9be33434
DL		 449 ((eq type 'emacs-mule)
450 (princ " (Emacs 21 internal encoding)"))
2c390c27 451 (t (princ ": invalid coding-system.")))
753fd9ca 452 (princ "\nEOL type: ")
426f97dc
KH		 453 (let ((eol-type (coding-system-eol-type coding-system)))
454 (cond ((vectorp eol-type)
455 (princ "Automatic selection from:\n\t")
456 (princ eol-type)
457 (princ "\n"))
458 ((or (null eol-type) (eq eol-type 0)) (princ "LF\n"))
459 ((eq eol-type 1) (princ "CRLF\n"))
460 ((eq eol-type 2) (princ "CR\n"))
461 (t (princ "invalid\n")))))
3a1ef8f5 462 (let ((postread (coding-system-get coding-system :post-read-conversion)))
ff8909d8 463 (when postread
71527e5d
DL		 464 (princ "After decoding text normally,")
465 (princ " perform post-conversion using the function: ")
ff8909d8
KH		 466 (princ "\n ")
467 (princ postread)
468 (princ "\n")))
3a1ef8f5 469 (let ((prewrite (coding-system-get coding-system :pre-write-conversion)))
ff8909d8 470 (when prewrite
71527e5d
DL		 471 (princ "Before encoding text normally,")
472 (princ " perform pre-conversion using the function: ")
ff8909d8
KH		 473 (princ "\n ")
474 (princ prewrite)
475 (princ "\n")))
55140940 476 (with-current-buffer standard-output
9be33434
DL		 477 (let ((charsets (coding-system-charset-list coding-system)))
478 (when (and (not (eq (coding-system-base coding-system) 'raw-text))
97b14492 479 charsets)
9be33434
DL		 480 (cond
481 ((eq charsets 'iso-2022)
482 (insert "This coding system can encode all ISO 2022 charsets."))
483 ((eq charsets 'emacs-mule)
484 (insert "This coding system can encode all emacs-mule charsets\
485."""))
486 (t
71527e5d 487 (insert "This coding system encodes the following charsets:\n ")
a399ef7b
KH		 488 (while charsets
489 (insert " " (symbol-name (car charsets)))
490 (search-backward (symbol-name (car charsets)))
e8cdeaca 491 (help-xref-button 0 'help-character-set (car charsets))
a399ef7b 492 (goto-char (point-max))
9be33434 493 (setq charsets (cdr charsets)))))))))))
4ed46869
KH		 494
495;;;###autoload
496(defun describe-current-coding-system-briefly ()
795a5f84 497 "Display coding systems currently used in a brief format in echo area.
4ed46869 498
795a5f84 499The format is \"F[..],K[..],T[..],P>[..],P<[..], default F[..],P<[..],P<[..]\",
4ed46869 500where mnemonics of the following coding systems come in this order
7cc8aac3 501in place of `..':
187bd11c
SS		 502 `buffer-file-coding-system' (of the current buffer)
503 eol-type of `buffer-file-coding-system' (of the current buffer)
4527adca 504 Value returned by `keyboard-coding-system'
187bd11c
SS		 505 eol-type of `keyboard-coding-system'
506 Value returned by `terminal-coding-system'.
507 eol-type of `terminal-coding-system'
4527adca 508 `process-coding-system' for read (of the current buffer, if any)
187bd11c 509 eol-type of `process-coding-system' for read (of the current buffer, if any)
4527adca 510 `process-coding-system' for write (of the current buffer, if any)
187bd11c 511 eol-type of `process-coding-system' for write (of the current buffer, if any)
4527adca 512 `default-buffer-file-coding-system'
187bd11c 513 eol-type of `default-buffer-file-coding-system'
4527adca 514 `default-process-coding-system' for read
187bd11c 515 eol-type of `default-process-coding-system' for read
4527adca 516 `default-process-coding-system' for write
187bd11c 517 eol-type of `default-process-coding-system'"
4ed46869
KH		 518 (interactive)
519 (let* ((proc (get-buffer-process (current-buffer)))
520 (process-coding-systems (if proc (process-coding-system proc))))
521 (message
bb89cd2a 522 "F[%c%s],K[%c%s],T[%c%s],P>[%c%s],P<[%c%s], default F[%c%s],P>[%c%s],P<[%c%s]"
4ed46869 523 (coding-system-mnemonic buffer-file-coding-system)
795a5f84 524 (coding-system-eol-type-mnemonic buffer-file-coding-system)
4ed46869 525 (coding-system-mnemonic (keyboard-coding-system))
795a5f84 526 (coding-system-eol-type-mnemonic (keyboard-coding-system))
4ed46869 527 (coding-system-mnemonic (terminal-coding-system))
795a5f84 528 (coding-system-eol-type-mnemonic (terminal-coding-system))
4ed46869 529 (coding-system-mnemonic (car process-coding-systems))
795a5f84 530 (coding-system-eol-type-mnemonic (car process-coding-systems))
4ed46869 531 (coding-system-mnemonic (cdr process-coding-systems))
795a5f84
KH		 532 (coding-system-eol-type-mnemonic (cdr process-coding-systems))
533 (coding-system-mnemonic default-buffer-file-coding-system)
534 (coding-system-eol-type-mnemonic default-buffer-file-coding-system)
4ed46869 535 (coding-system-mnemonic (car default-process-coding-system))
795a5f84 536 (coding-system-eol-type-mnemonic (car default-process-coding-system))
4ed46869 537 (coding-system-mnemonic (cdr default-process-coding-system))
795a5f84 538 (coding-system-eol-type-mnemonic (cdr default-process-coding-system))
4ed46869
KH		 539 )))
540
426f97dc 541(defun print-coding-system-briefly (coding-system &optional doc-string)
8f924df7
KH		 542 "Print symbol name and mnemonic letter of CODING-SYSTEM with `princ'.
543If DOC-STRING is non-nil, print also the docstring of CODING-SYSTEM.
544If DOC-STRING is `tightly', don't print an empty line before the
545docstring, and print only the first line of the docstring."
795a5f84
KH		 546 (if (not coding-system)
547 (princ "nil\n")
548 (princ (format "%c -- %s"
549 (coding-system-mnemonic coding-system)
550 coding-system))
a8692ed8 551 (let ((aliases (coding-system-aliases coding-system)))
91e854f2
KH		 552 (cond ((eq coding-system (car aliases))
553 (if (cdr aliases)
554 (princ (format " %S" (cons 'alias: (cdr aliases))))))
555 ((memq coding-system aliases)
556 (princ (format " (alias of %s)" (car aliases))))
557 (t
558 (let ((eol-type (coding-system-eol-type coding-system))
559 (base-eol-type (coding-system-eol-type (car aliases))))
560 (if (and (integerp eol-type)
561 (vectorp base-eol-type)
562 (not (eq coding-system (aref base-eol-type eol-type))))
563 (princ (format " (alias of %s)"
564 (aref base-eol-type eol-type))))))))
60b898c6
KH		 565 (princ "\n")
566 (or (eq doc-string 'tightly)
567 (princ "\n"))
568 (if doc-string
569 (let ((doc (or (coding-system-doc-string coding-system) "")))
570 (when (eq doc-string 'tightly)
571 (if (string-match "\n" doc)
572 (setq doc (substring doc 0 (match-beginning 0))))
573 (setq doc (concat " " doc)))
574 (princ (format "%s\n" doc))))))
4ed46869
KH		 575
576;;;###autoload
577(defun describe-current-coding-system ()
4527adca 578 "Display coding systems currently used, in detail."
4ed46869
KH		 579 (interactive)
580 (with-output-to-temp-buffer "*Help*"
581 (let* ((proc (get-buffer-process (current-buffer)))
582 (process-coding-systems (if proc (process-coding-system proc))))
e72e91e9 583 (princ "Coding system for saving this buffer:\n ")
795a5f84
KH		 584 (if (local-variable-p 'buffer-file-coding-system)
585 (print-coding-system-briefly buffer-file-coding-system)
e72e91e9
RS		 586 (princ "Not set locally, use the default.\n"))
587 (princ "Default coding system (for new files):\n ")
795a5f84 588 (print-coding-system-briefly default-buffer-file-coding-system)
e72e91e9 589 (princ "Coding system for keyboard input:\n ")
4ed46869 590 (print-coding-system-briefly (keyboard-coding-system))
e72e91e9 591 (princ "Coding system for terminal output:\n ")
4ed46869 592 (print-coding-system-briefly (terminal-coding-system))
0fe44409
SM		 593 (when (boundp 'selection-coding-system)
594 (princ "Coding system for inter-client cut and paste:\n ")
595 (print-coding-system-briefly selection-coding-system))
e72e91e9
RS		 596 (when (get-buffer-process (current-buffer))
597 (princ "Coding systems for process I/O:\n")
598 (princ " encoding input to the process: ")
599 (print-coding-system-briefly (cdr process-coding-systems))
600 (princ " decoding output from the process: ")
601 (print-coding-system-briefly (car process-coding-systems)))
1b76aedd 602 (princ "Defaults for subprocess I/O:\n")
795a5f84 603 (princ " decoding: ")
4ed46869 604 (print-coding-system-briefly (car default-process-coding-system))
795a5f84
KH		 605 (princ " encoding: ")
606 (print-coding-system-briefly (cdr default-process-coding-system)))
426f97dc 607
55140940 608 (with-current-buffer standard-output
426f97dc 609
7cc8aac3
PJ		 610 (princ "
611Priority order for recognizing coding systems when reading files:\n")
2c390c27
KH		 612 (let ((i 1))
613 (dolist (elt (coding-system-priority-list))
614 (princ (format " %d. %s " i elt))
615 (let ((aliases (coding-system-aliases elt)))
616 (if (eq elt (car aliases))
ff8909d8
KH		 617 (if (cdr aliases)
618 (princ (cons 'alias: (cdr aliases))))
2c390c27 619 (princ (list 'alias 'of (car aliases))))
5cfcd8bc 620 (terpri)
2c390c27 621 (setq i (1+ i)))))
ff8909d8 622
426f97dc
KH		 623 (princ "\n Other coding systems cannot be distinguished automatically
624 from these, and therefore cannot be recognized automatically
625 with the present coding system priorities.\n\n")
626
a8692ed8 627 ;; Fixme: should this be replaced or junked?
2c390c27 628 (if nil
b585fb6c 629 (let ((categories '(coding-category-iso-7 coding-category-iso-7-else))
426f97dc
KH		 630 coding-system codings)
631 (while categories
632 (setq coding-system (symbol-value (car categories)))
1249c1d1 633 (mapc
02e91426
SM		 634 (lambda (x)
635 (if (and (not (eq x coding-system))
feff73a4
DL		 636 (let ((flags (coding-system-get :flags)))
637 (not (or (memq 'use-roman flags)
638 (memq 'use-oldjis flags)))))
02e91426 639 (setq codings (cons x codings))))
426f97dc
KH		 640 (get (car categories) 'coding-systems))
641 (if codings
92c15c34 642 (let ((max-col (window-width))
426f97dc 643 pos)
7cc8aac3
PJ		 644 (princ (format "\
645 The following are decoded correctly but recognized as %s:\n "
646 coding-system))
426f97dc
KH		 647 (while codings
648 (setq pos (point))
649 (insert (format " %s" (car codings)))
4472a77b
KH		 650 (when (> (current-column) max-col)
651 (goto-char pos)
652 (insert "\n ")
653 (goto-char (point-max)))
426f97dc
KH		 654 (setq codings (cdr codings)))
655 (insert "\n\n")))
2c390c27 656 (setq categories (cdr categories)))))
426f97dc 657
e72e91e9 658 (princ "Particular coding systems specified for certain file names:\n")
426f97dc
KH		 659 (terpri)
660 (princ " OPERATION\tTARGET PATTERN\t\tCODING SYSTEM(s)\n")
661 (princ " ---------\t--------------\t\t----------------\n")
662 (let ((func (lambda (operation alist)
663 (princ " ")
664 (princ operation)
665 (if (not alist)
666 (princ "\tnothing specified\n")
667 (while alist
668 (indent-to 16)
669 (prin1 (car (car alist)))
ff8909d8
KH		 670 (if (>= (current-column) 40)
671 (newline))
426f97dc
KH		 672 (indent-to 40)
673 (princ (cdr (car alist)))
674 (princ "\n")
675 (setq alist (cdr alist)))))))
676 (funcall func "File I/O" file-coding-system-alist)
677 (funcall func "Process I/O" process-coding-system-alist)
678 (funcall func "Network I/O" network-coding-system-alist))
679 (help-mode))))
4ed46869 680
ff8909d8 681(defun print-coding-system (coding-system)
3a1ef8f5 682 "Print detailed information on CODING-SYSTEM."
4ed46869 683 (let ((type (coding-system-type coding-system))
795a5f84 684 (eol-type (coding-system-eol-type coding-system))
feff73a4 685 (flags (coding-system-get coding-system :flags))
a8692ed8 686 (aliases (coding-system-aliases coding-system)))
ff8909d8
KH		 687 (if (not (eq (car aliases) coding-system))
688 (princ (format "%s (alias of %s)\n" coding-system (car aliases)))
795a5f84 689 (princ coding-system)
18f515e4 690 (dolist (alias (cdr aliases))
4472a77b 691 (princ ",")
18f515e4 692 (princ alias))
795a5f84
KH		 693 (princ (format ":%s:%c:%d:"
694 type
695 (coding-system-mnemonic coding-system)
696 (if (integerp eol-type) eol-type 3)))
feff73a4 697 (cond ((eq type 'iso2022)
795a5f84
KH		 698 (let ((idx 0)
699 charset)
700 (while (< idx 4)
701 (setq charset (aref flags idx))
702 (cond ((null charset)
703 (princ -1))
704 ((eq charset t)
705 (princ -2))
706 ((charsetp charset)
707 (princ charset))
708 ((listp charset)
709 (princ "(")
4ed46869 710 (princ (car charset))
795a5f84
KH		 711 (setq charset (cdr charset))
712 (while charset
713 (princ ",")
714 (princ (car charset))
715 (setq charset (cdr charset)))
716 (princ ")")))
717 (princ ",")
718 (setq idx (1+ idx)))
719 (while (< idx 12)
720 (princ (if (aref flags idx) 1 0))
721 (princ ",")
722 (setq idx (1+ idx)))
723 (princ (if (aref flags idx) 1 0))))
feff73a4 724 ((eq type 'ccl)
795a5f84 725 (let (i len)
0d5f1e3a
RS		 726 (if (symbolp (car flags))
727 (princ (format " %s" (car flags)))
728 (setq i 0 len (length (car flags)))
729 (while (< i len)
730 (princ (format " %x" (aref (car flags) i)))
731 (setq i (1+ i))))
4ed46869 732 (princ ",")
0d5f1e3a
RS		 733 (if (symbolp (cdr flags))
734 (princ (format "%s" (cdr flags)))
735 (setq i 0 len (length (cdr flags)))
736 (while (< i len)
737 (princ (format " %x" (aref (cdr flags) i)))
738 (setq i (1+ i))))))
795a5f84
KH		 739 (t (princ 0)))
740 (princ ":")
741 (princ (coding-system-doc-string coding-system))
742 (princ "\n"))))
4ed46869 743
795a5f84 744;;;###autoload
4472a77b
KH		 745(defun list-coding-systems (&optional arg)
746 "Display a list of all coding systems.
4527adca 747This shows the mnemonic letter, name, and description of each coding system.
4472a77b 748
e4fe4569 749With prefix ARG, the output format gets more cryptic,
4527adca 750but still contains full information about each coding system."
4472a77b 751 (interactive "P")
4ed46869 752 (with-output-to-temp-buffer "*Help*"
13cef08d
KH		 753 (list-coding-systems-1 arg)))
754
755(defun list-coding-systems-1 (arg)
756 (if (null arg)
757 (princ "\
795a5f84
KH		 758###############################################
759# List of coding systems in the following format:
760# MNEMONIC-LETTER -- CODING-SYSTEM-NAME
60b898c6 761# DOC-STRING
795a5f84 762")
13cef08d 763 (princ "\
4ed46869
KH		 764#########################
765## LIST OF CODING SYSTEMS
766## Each line corresponds to one coding system
767## Format of a line is:
795a5f84
KH		 768## NAME[,ALIAS...]:TYPE:MNEMONIC:EOL:FLAGS:POST-READ-CONVERSION
769## :PRE-WRITE-CONVERSION:DOC-STRING,
4ed46869 770## where
795a5f84
KH		 771## NAME = coding system name
772## ALIAS = alias of the coding system
773## TYPE = nil (no conversion), t (undecided or automatic detection),
774## 0 (EMACS-MULE), 1 (SJIS), 2 (ISO2022), 3 (BIG5), or 4 (CCL)
4ed46869
KH		 775## EOL = 0 (LF), 1 (CRLF), 2 (CR), or 3 (Automatic detection)
776## FLAGS =
777## if TYPE = 2 then
92c15c34 778## comma (`,') separated data of the following:
4ed46869
KH		 779## G0, G1, G2, G3, SHORT-FORM, ASCII-EOL, ASCII-CNTL, SEVEN,
780## LOCKING-SHIFT, SINGLE-SHIFT, USE-ROMAN, USE-OLDJIS, NO-ISO6429
781## else if TYPE = 4 then
782## comma (`,') separated CCL programs for read and write
783## else
784## 0
795a5f84 785## POST-READ-CONVERSION, PRE-WRITE-CONVERSION = function name to be called
4ed46869 786##
795a5f84 787"))
60b898c6
KH		 788 (dolist (coding-system (sort-coding-systems (coding-system-list 'base-only)))
789 (if (null arg)
790 (print-coding-system-briefly coding-system 'tightly)
791 (print-coding-system coding-system))))
4472a77b 792
a8692ed8 793;; Fixme: delete?
867ef43a 794;;;###autoload
4472a77b
KH		 795(defun list-coding-categories ()
796 "Display a list of all coding categories."
797 (with-output-to-temp-buffer "*Help*"
798 (princ "\
4ed46869
KH		 799############################
800## LIST OF CODING CATEGORIES (ordered by priority)
801## CATEGORY:CODING-SYSTEM
802##
803")
4472a77b
KH		 804 (let ((l coding-category-list))
805 (while l
806 (princ (format "%s:%s\n" (car l) (symbol-value (car l))))
807 (setq l (cdr l))))))
4ed46869
KH		 808\f
809;;; FONT
810
aa360da1
GM		 811(declare-function font-info "font.c" (name &optional frame))
812
4ed46869 813(defun describe-font-internal (font-info &optional verbose)
3a1ef8f5 814 "Print information about a font in FONT-INFO."
4ed46869
KH		 815 (print-list "name (opened by):" (aref font-info 0))
816 (print-list " full name:" (aref font-info 1))
b1e3566c
KH		 817 (print-list " size:" (format "%2d" (aref font-info 2)))
818 (print-list " height:" (format "%2d" (aref font-info 3)))
819 (print-list " baseline-offset:" (format "%2d" (aref font-info 4)))
820 (print-list "relative-compose:" (format "%2d" (aref font-info 5))))
4ed46869
KH		 821
822;;;###autoload
823(defun describe-font (fontname)
fca31fbb
KH		 824 "Display information about a font whose name is FONTNAME.
825The font must be already used by Emacs."
826 (interactive "sFont name (default current choice for ASCII chars): ")
ee5f768d 827 (or (and window-system (fboundp 'fontset-list))
fca31fbb 828 (error "No fonts being used"))
7736dabe
KH		 829 (let (font-info)
830 (if (or (not fontname) (= (length fontname) 0))
831 (setq fontname (face-attribute 'default :font)))
fca31fbb 832 (setq font-info (font-info fontname))
4ed46869 833 (if (null font-info)
7736dabe 834 (if (fontp fontname 'font-object)
fca31fbb
KH		 835 ;; The font should be surely used. So, there's some
836 ;; problem about getting information about it. It is
837 ;; better to print the fontname to show which font has
838 ;; this problem.
7736dabe
KH		 839 (message "No information about \"%s\"" (font-xlfd-name fontname))
840 (message "No matching font found"))
4ed46869
KH		 841 (with-output-to-temp-buffer "*Help*"
842 (describe-font-internal font-info 'verbose)))))
843
5c117135
KH		 844(defun print-fontset-element (val)
845 ;; VAL has this format:
846 ;; ((REQUESTED-FONT-NAME OPENED-FONT-NAME ...) ...)
847 ;; CHAR RANGE is already inserted. Get character codes from
848 ;; the current line.
849 (beginning-of-line)
850 (let ((from (following-char))
851 (to (if (looking-at "[^.]*[.]* ")
852 (char-after (match-end 0)))))
853 (if (re-search-forward "[ \t]*$" nil t)
854 (delete-region (match-beginning 0) (match-end 0)))
855
856 ;; For non-ASCII characters, insert also CODE RANGE.
857 (if (or (>= from 128) (and to (>= to 128)))
858 (if to
859 (insert (format " (#x%02X .. #x%02X)" from to))
860 (insert (format " (#x%02X)" from))))
861
862 ;; Insert a requested font name.
863 (dolist (elt val)
e94848ea
KH		 864 (if (not elt)
865 (insert "\n -- inhibit fallback fonts --")
866 (let ((requested (car elt)))
867 (if (stringp requested)
868 (insert "\n " requested)
869 (let (family registry weight slant width adstyle)
870 (if (and (fboundp 'fontp) (fontp requested))
871 (setq family (font-get requested :family)
872 registry (font-get requested :registry)
873 weight (font-get requested :weight)
874 slant (font-get requested :slant)
875 width (font-get requested :width)
876 adstyle (font-get requested :adstyle))
877 (setq family (aref requested 0)
878 registry (aref requested 5)
879 weight (aref requested 1)
880 slant (aref requested 2)
881 width (aref requested 3)
882 adstyle (aref requested 4)))
883 (if (not family)
884 (setq family "*-*")
885 (if (symbolp family)
886 (setq family (symbol-name family)))
887 (or (string-match "-" family)
888 (setq family (concat "*-" family))))
889 (if (not registry)
890 (setq registry "*-*")
891 (if (symbolp registry)
892 (setq registry (symbol-name registry)))
893 (or (string-match "-" registry)
894 (= (aref registry (1- (length registry))) ?*)
895 (setq registry (concat registry "*"))))
896 (insert (format"\n -%s-%s-%s-%s-%s-*-*-*-*-*-*-%s"
897 family (or weight "*") (or slant "*") (or width "*")
898 (or adstyle "*") registry)))))
899
900 ;; Insert opened font names (if any).
901 (if (and (boundp 'print-opened) (symbol-value 'print-opened))
902 (dolist (opened (cdr elt))
903 (insert "\n\t[" opened "]")))))))
5c117135 904
aa360da1
GM		 905(declare-function query-fontset "fontset.c" (pattern &optional regexpp))
906(declare-function fontset-info "fontset.c" (fontset &optional frame))
907
5c117135 908(defun print-fontset (fontset &optional print-opened)
7cc8aac3 909 "Print information about FONTSET.
c0e70a9f 910If FONTSET is nil, print information about the default fontset.
5c117135 911If optional arg PRINT-OPENED is non-nil, also print names of all opened
7cc8aac3
PJ		 912fonts for FONTSET. This function actually inserts the information in
913the current buffer."
c0e70a9f
KH		 914 (or fontset
915 (setq fontset (query-fontset "fontset-default")))
b827d571
KH		 916 (beginning-of-line)
917 (insert "Fontset: " fontset "\n")
5c117135
KH		 918 (insert (propertize "CHAR RANGE" 'face 'underline)
919 " (" (propertize "CODE RANGE" 'face 'underline) ")\n")
920 (insert " " (propertize "FONT NAME" 'face 'underline)
921 " (" (propertize "REQUESTED" 'face 'underline)
922 " and [" (propertize "OPENED" 'face 'underline) "])")
923 (let ((info (fontset-info fontset)))
924 (describe-vector info 'print-fontset-element)
925 (insert "\n ---<fallback to the default fontset>---")
926 (describe-vector (char-table-extra-slot info 0) 'print-fontset-element)))
4ed46869 927
aa360da1
GM		 928(defvar fontset-alias-alist)
929(declare-function fontset-list "fontset.c" ())
930
4ed46869
KH		 931;;;###autoload
932(defun describe-fontset (fontset)
7cc8aac3 933 "Display information about FONTSET.
b1e3566c 934This shows which font is used for which character(s)."
4ed46869 935 (interactive
ee5f768d 936 (if (not (and window-system (fboundp 'fontset-list)))
effd4e82 937 (error "No fontsets being used")
71527e5d 938 (let ((fontset-list (nconc
f95b7b89
SM		 939 (fontset-list)
940 (mapcar 'cdr fontset-alias-alist)))
4472a77b
KH		 941 (completion-ignore-case t))
942 (list (completing-read
5b76833f 943 "Fontset (default used by the current frame): "
4472a77b
KH		 944 fontset-list nil t)))))
945 (if (= (length fontset) 0)
c0e70a9f
KH		 946 (setq fontset (frame-parameter nil 'font)))
947 (setq fontset (query-fontset fontset))
55140940
SM		 948 (help-setup-xref (list #'describe-fontset fontset) (interactive-p))
949 (with-output-to-temp-buffer (help-buffer)
950 (with-current-buffer standard-output
b1e3566c 951 (print-fontset fontset t))))
4472a77b 952
aa360da1
GM		 953(declare-function fontset-plain-name "fontset" (fontset))
954
4472a77b
KH		 955;;;###autoload
956(defun list-fontsets (arg)
957 "Display a list of all fontsets.
4527adca 958This shows the name, size, and style of each fontset.
7cc8aac3 959With prefix arg, also list the fonts contained in each fontset;
4527adca 960see the function `describe-fontset' for the format of the list."
4472a77b 961 (interactive "P")
ee5f768d 962 (if (not (and window-system (fboundp 'fontset-list)))
effd4e82 963 (error "No fontsets being used")
55140940
SM		 964 (help-setup-xref (list #'list-fontsets arg) (interactive-p))
965 (with-output-to-temp-buffer (help-buffer)
966 (with-current-buffer standard-output
13cef08d 967 ;; This code is duplicated near the end of mule-diag.
dc1f8c72
KH		 968 (let ((fontsets
969 (sort (fontset-list)
02e91426
SM		 970 (lambda (x y)
971 (string< (fontset-plain-name x)
972 (fontset-plain-name y))))))
effd4e82 973 (while fontsets
b1e3566c
KH		 974 (if arg
975 (print-fontset (car fontsets) nil)
976 (insert "Fontset: " (car fontsets) "\n"))
effd4e82 977 (setq fontsets (cdr fontsets))))))))
426f97dc
KH		 978\f
979;;;###autoload
980(defun list-input-methods ()
4527adca 981 "Display information about all input methods."
426f97dc 982 (interactive)
02e91426
SM		 983 (help-setup-xref '(list-input-methods) (interactive-p))
984 (with-output-to-temp-buffer (help-buffer)
7cc8aac3
PJ		 985 (list-input-methods-1)
986 (with-current-buffer standard-output
987 (save-excursion
988 (goto-char (point-min))
989 (while (re-search-forward
990 "^ \\([^ ]+\\) (`.*' in mode line)$" nil t)
ee592269 991 (help-xref-button 1 'help-input-method (match-string 1)))))))
13cef08d
KH		 992
993(defun list-input-methods-1 ()
994 (if (not input-method-alist)
18f515e4 995 (princ "
10de7378 996No input method is available, perhaps because you have not
18f515e4 997installed LEIM (Libraries of Emacs Input Methods).")
13cef08d
KH		 998 (princ "LANGUAGE\n NAME (`TITLE' in mode line)\n")
999 (princ " SHORT-DESCRIPTION\n------------------------------\n")
1000 (setq input-method-alist
1001 (sort input-method-alist
02e91426 1002 (lambda (x y) (string< (nth 1 x) (nth 1 y)))))
18f515e4
JB		 1003
1004 (let (language)
1005 (dolist (elt input-method-alist)
13cef08d
KH		 1006 (when (not (equal language (nth 1 elt)))
1007 (setq language (nth 1 elt))
1008 (princ language)
1009 (terpri))
1010 (princ (format " %s (`%s' in mode line)\n %s\n"
1011 (car elt)
1012 (let ((title (nth 3 elt)))
1013 (if (and (consp title) (stringp (car title)))
1014 (car title)
1015 title))
18f515e4 1016 (nth 4 elt)))))))
4ed46869
KH		 1017\f
1018;;; DIAGNOSIS
1019
4472a77b
KH		 1020;; Insert a header of a section with SECTION-NUMBER and TITLE.
1021(defun insert-section (section-number title)
4ed46869 1022 (insert "########################################\n"
4472a77b 1023 "# Section " (format "%d" section-number) ". " title "\n"
4ed46869
KH		 1024 "########################################\n\n"))
1025
1026;;;###autoload
1027(defun mule-diag ()
3fdaafa6 1028 "Display diagnosis of the multilingual environment (Mule).
4472a77b 1029
4527adca 1030This shows various information related to the current multilingual
4472a77b 1031environment, including lists of input methods, coding systems,
4527adca 1032character sets, and fontsets (if Emacs is running under a window
effd4e82 1033system which uses fontsets)."
4ed46869 1034 (interactive)
4472a77b 1035 (with-output-to-temp-buffer "*Mule-Diagnosis*"
55140940 1036 (with-current-buffer standard-output
13cef08d
KH		 1037 (insert "###############################################\n"
1038 "### Current Status of Multilingual Features ###\n"
1039 "###############################################\n\n"
4ed46869
KH		 1040 "CONTENTS: Section 1. General Information\n"
1041 " Section 2. Display\n"
1042 " Section 3. Input methods\n"
1043 " Section 4. Coding systems\n"
4472a77b 1044 " Section 5. Character sets\n")
ee5f768d 1045 (if (and window-system (fboundp 'fontset-list))
4472a77b 1046 (insert " Section 6. Fontsets\n"))
4ed46869
KH		 1047 (insert "\n")
1048
1049 (insert-section 1 "General Information")
7bce107c 1050 (insert "Version of this emacs:\n " (emacs-version) "\n\n")
cbbe6489
KH		 1051 (insert "Configuration options:\n " system-configuration-options "\n\n")
1052 (insert "Multibyte characters awareness:\n"
1053 (format " default: %S\n" default-enable-multibyte-characters)
1054 (format " current-buffer: %S\n\n" enable-multibyte-characters))
1055 (insert "Current language environment: " current-language-environment
1056 "\n\n")
4ed46869
KH		 1057
1058 (insert-section 2 "Display")
1059 (if window-system
f7980931
JB		 1060 (insert (format "Window-system: %s, version %s"
1061 window-system window-system-version))
4ed46869
KH		 1062 (insert "Terminal: " (getenv "TERM")))
1063 (insert "\n\n")
1064
18f515e4 1065 (if window-system
4ed46869
KH		 1066 (let ((font (cdr (assq 'font (frame-parameters)))))
1067 (insert "The selected frame is using the "
1068 (if (query-fontset font) "fontset" "font")
1069 ":\n\t" font))
1070 (insert "Coding system of the terminal: "
1071 (symbol-name (terminal-coding-system))))
1072 (insert "\n\n")
1073
1074 (insert-section 3 "Input methods")
13cef08d 1075 (list-input-methods-1)
4ed46869
KH		 1076 (insert "\n")
1077 (if default-input-method
d4b11c67 1078 (insert (format "Default input method: %s\n" default-input-method))
1b76aedd 1079 (insert "No default input method is specified\n"))
4ed46869
KH		 1080
1081 (insert-section 4 "Coding systems")
13cef08d 1082 (list-coding-systems-1 t)
4ed46869
KH		 1083 (insert "\n")
1084
4472a77b 1085 (insert-section 5 "Character sets")
efdd2d79 1086 (list-character-sets-2)
4ed46869
KH		 1087 (insert "\n")
1088
ee5f768d 1089 (when (and window-system (fboundp 'fontset-list))
13cef08d 1090 ;; This code duplicates most of list-fontsets.
4472a77b 1091 (insert-section 6 "Fontsets")
13cef08d
KH		 1092 (insert "Fontset-Name\t\t\t\t\t\t WDxHT Style\n")
1093 (insert "------------\t\t\t\t\t\t ----- -----\n")
18f515e4
JB		 1094 (dolist (fontset (fontset-list))
1095 (print-fontset fontset t)))
eabe0ad3 1096 (print-help-return-message))))
4ed46869 1097
fa5ee889 1098;;;###autoload
73650060 1099(defun font-show-log (&optional limit)
4ab088c0 1100 "Show log of font listing and opening.
73650060
KH		 1101Prefix arg LIMIT says how many fonts to show for each listing.
1102The default is 20. If LIMIT is negative, do not limit the listing."
1103 (interactive "P")
1104 (setq limit (if limit (prefix-numeric-value limit) 20))
fa5ee889
KH		 1105 (if (eq font-log t)
1106 (message "Font logging is currently suppressed")
1107 (with-output-to-temp-buffer "*Help*"
1108 (set-buffer standard-output)
1109 (dolist (elt (reverse font-log))
1110 (insert (format "%s: %s\n" (car elt) (cadr elt)))
1111 (setq elt (nth 2 elt))
1112 (if (or (vectorp elt) (listp elt))
4ab088c0 1113 (let ((i 0))
bcd79f83
KH		 1114 (catch 'tag
1115 (mapc #'(lambda (x)
1116 (setq i (1+ i))
73650060 1117 (when (= i limit)
bcd79f83
KH		 1118 (insert " ...\n")
1119 (throw 'tag nil))
1120 (insert (format " %s\n" x)))
1121 elt)))
fa5ee889
KH		 1122 (insert (format " %s\n" elt)))))))
1123
1124
bfe77626
DL		 1125(provide 'mule-diag)
1126
cbee283d 1127;; arch-tag: cd3b607c-2893-45a0-a4fa-a6535754dbee
795a5f84 1128;;; mule-diag.el ends here
Unnamed repository; edit this file 'description' to name the repository.