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