HCoop / bpt / emacs.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
Add 2010 to copyright years.
[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,
114f9c96 4;; 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
7976eda0 5;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
114f9c96 6;; 2005, 2006, 2007, 2008, 2009, 2010
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.
0f0ea87e 35(require 'help-mode)
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
43930e44
KH		 63set. The FINAL-BYTE column contains an ISO-2022 <final-byte> to use
64in the designation escape sequence for this character set in
65ISO-2022-based coding systems.
4472a77b 66
18f515e4 67With prefix ARG, the output format gets more cryptic,
4527adca 68but still shows the full information."
4472a77b 69 (interactive "P")
32226619
JB		 70 (help-setup-xref (list #'list-character-sets arg)
71 (called-interactively-p 'interactive))
3aab6d06 72 (with-output-to-temp-buffer "*Character Set List*"
efdd2d79
KH		 73 (with-current-buffer standard-output
74 (if arg
75 (list-character-sets-2)
76 ;; Insert header.
875d7ad9 77 (insert "Supplementary character sets are shown below.\n")
efdd2d79
KH		 78 (insert
79 (substitute-command-keys
e5b99cff
KH		 80 (concat "Use "
81 (if (display-mouse-p) "\\[help-follow-mouse] or ")
82 "\\[help-follow]:\n")))
83 (insert " on a column title to sort by that title,")
3a1ef8f5 84 (indent-to 48)
efdd2d79 85 (insert "+----DIMENSION\n")
e5b99cff 86 (insert " on a charset name to list characters.")
3a1ef8f5 87 (indent-to 48)
efdd2d79 88 (insert "| +--CHARS\n")
3a1ef8f5 89 (let ((columns '(("CHARSET-NAME" . name) "\t\t\t\t\t"
43930e44 90 ("D CH FINAL-BYTE" . iso-spec)))
efdd2d79
KH		 91 pos)
92 (while columns
93 (if (stringp (car columns))
94 (insert (car columns))
e8cdeaca
MB		 95 (insert-text-button (car (car columns))
96 :type 'sort-listed-character-sets
97 'sort-key (cdr (car columns)))
efdd2d79
KH		 98 (goto-char (point-max)))
99 (setq columns (cdr columns)))
100 (insert "\n"))
3a1ef8f5 101 (insert "------------\t\t\t\t\t- --- ----------\n")
13cef08d 102
efdd2d79 103 ;; Insert body sorted by charset IDs.
3a1ef8f5 104 (list-character-sets-1 'name)))))
efdd2d79 105
efdd2d79
KH		 106(defun sort-listed-character-sets (sort-key)
107 (if sort-key
108 (save-excursion
109 (let ((buffer-read-only nil))
110 (goto-char (point-min))
875d7ad9
KH		 111 (search-forward "\n-")
112 (forward-line 1)
113 (delete-region (point) (point-max))
114 (list-character-sets-1 sort-key)))))
efdd2d79 115
efdd2d79 116(defun list-character-sets-1 (sort-key)
3a1ef8f5
DL		 117 "Insert a list of character sets sorted by SORT-KEY.
118SORT-KEY should be `name' or `iso-spec' (default `name')."
efdd2d79 119 (or sort-key
3a1ef8f5
DL		 120 (setq sort-key 'name))
121 (let ((tail charset-list)
875d7ad9 122 charset-info-list supplementary-list charset sort-func)
3a1ef8f5 123 (dolist (charset charset-list)
efdd2d79 124 ;; Generate a list that contains all information to display.
875d7ad9
KH		 125 (let ((elt (list charset
126 (charset-dimension charset)
127 (charset-chars charset)
128 (charset-iso-final-char charset))))
129 (if (plist-get (charset-plist charset) :supplementary-p)
130 (push elt supplementary-list)
131 (push elt charset-info-list))))
efdd2d79
KH		 132
133 ;; Determine a predicate for `sort' by SORT-KEY.
134 (setq sort-func
3a1ef8f5
DL		 135 (cond ((eq sort-key 'name)
136 (lambda (x y) (string< (car x) (car y))))
efdd2d79
KH		 137
138 ((eq sort-key 'iso-spec)
139 ;; Sort by DIMENSION CHARS FINAL-CHAR
140 (function
141 (lambda (x y)
3a1ef8f5
DL		 142 (or (< (nth 1 x) (nth 1 y))
143 (and (= (nth 1 x) (nth 1 y))
144 (or (< (nth 2 x) (nth 2 y))
145 (and (= (nth 2 x) (nth 2 y))
146 (< (nth 3 x) (nth 3 y)))))))))
efdd2d79
KH		 147 (t
148 (error "Invalid charset sort key: %s" sort-key))))
149
150 (setq charset-info-list (sort charset-info-list sort-func))
875d7ad9 151 (setq supplementary-list (sort supplementary-list sort-func))
efdd2d79
KH		 152
153 ;; Insert information of character sets.
875d7ad9
KH		 154 (dolist (elt (append charset-info-list (list t) supplementary-list))
155 (if (eq elt t)
43930e44
KH		 156 (progn
157 (insert "\n-------------- ")
158 (insert-text-button "Supplementary Character Sets"
159 'type 'help-info
160 'help-args '("(emacs)Charsets"))
161 (insert " --------------
5c2dce75 162Character sets for defining other charsets, or for backward compatibility
43930e44 163"))
875d7ad9
KH		 164 (insert-text-button (symbol-name (car elt)) ; NAME
165 :type 'list-charset-chars
166 'help-args (list (car elt)))
167 (goto-char (point-max))
168 (insert "\t")
169 (indent-to 48)
170 (insert (format "%d %3d "
171 (nth 1 elt) (nth 2 elt)) ; DIMENSION and CHARS
172 (if (< (nth 3 elt) 0)
173 "none"
174 (nth 3 elt)))) ; FINAL-CHAR
efdd2d79
KH		 175 (insert "\n"))))
176
177
178;; List all character sets in a form that a program can easily parse.
179
180(defun list-character-sets-2 ()
181 (insert "#########################
4ed46869
KH		 182## LIST OF CHARSETS
183## Each line corresponds to one charset.
184## The following attributes are listed in this order
185## separated by a colon `:' in one line.
4472a77b 186## CHARSET-SYMBOL-NAME,
18f515e4
JB		 187## DIMENSION (1-4)
188## CHARS (number of characters in first dimension of charset)
4ed46869 189## ISO-FINAL-CHAR (character code of ISO-2022's final character)
f3df78db 190## -1 means that no final character is assigned.
4ed46869
KH		 191## DESCRIPTION (describing string of the charset)
192")
18f515e4
JB		 193 (dolist (charset charset-list)
194 (princ (format "%s:%d:%d:%d:%s\n"
195 charset
196 (charset-dimension charset)
197 (charset-chars charset)
198;;; (char-width (make-char charset))
199;;; (charset-direction charset)
200 (charset-iso-final-char charset)
201;;; (charset-iso-graphic-plane charset)
202 (charset-description charset)))))
efdd2d79 203
3a1ef8f5
DL		 204(defvar non-iso-charset-alist nil
205 "Obsolete.")
bc01a178 206(make-obsolete-variable 'non-iso-charset-alist "no longer relevant." "23.1")
efdd2d79 207
efdd2d79 208(defun decode-codepage-char (codepage code)
7cc8aac3
PJ		 209 "Decode a character that has code CODE in CODEPAGE.
210Return a decoded character string. Each CODEPAGE corresponds to a
bc01a178 211coding system cpCODEPAGE."
3a1ef8f5 212 (decode-char (intern (format "cp%d" codepage)) code))
8589dc17 213(make-obsolete 'decode-codepage-char 'decode-char "23.1")
efdd2d79
KH		 214
215;; A variable to hold charset input history.
216(defvar charset-history nil)
217
218
219;;;###autoload
220(defun read-charset (prompt &optional default-value initial-input)
221 "Read a character set from the minibuffer, prompting with string PROMPT.
3a1ef8f5 222It must be an Emacs character set listed in the variable `charset-list'.
efdd2d79
KH		 223
224Optional arguments are DEFAULT-VALUE and INITIAL-INPUT.
225DEFAULT-VALUE, if non-nil, is the default value.
226INITIAL-INPUT, if non-nil, is a string inserted in the minibuffer initially.
e4fe4569
JB		 227See the documentation of the function `completing-read' for the detailed
228meanings of these arguments."
3a1ef8f5 229 (let* ((table (mapcar (lambda (x) (list (symbol-name x))) charset-list))
efdd2d79
KH		 230 (charset (completing-read prompt table
231 nil t initial-input 'charset-history
232 default-value)))
233 (if (> (length charset) 0)
234 (intern charset))))
187bd11c 235
efdd2d79
KH		 236;; List characters of the range MIN and MAX of CHARSET. If dimension
237;; of CHARSET is two (i.e. 2-byte charset), ROW is the first byte
238;; (block index) of the characters, and MIN and MAX are the second
239;; bytes of the characters. If the dimension is one, ROW should be 0.
efdd2d79
KH		 240
241(defun list-block-of-chars (charset row min max)
242 (let (i ch)
35650cd2
KH		 243 (insert-char ?- (+ 7 (* 4 16)))
244 (insert "\n ")
efdd2d79
KH		 245 (setq i 0)
246 (while (< i 16)
8f924df7 247 (insert (format "%4X" i))
efdd2d79
KH		 248 (setq i (1+ i)))
249 (setq i (* (/ min 16) 16))
250 (while (<= i max)
251 (if (= (% i 16) 0)
35650cd2 252 (insert (format "\n%6Xx" (/ (+ (* row 256) i) 16))))
8f924df7
KH		 253 (setq ch (if (< i min)
254 32
255 (or (decode-char charset (+ (* row 256) i))
256 32))) ; gap in mapping
ea60d50f 257 ;; Don't insert control codes, non-Unicode characters.
8f924df7
KH		 258 (if (or (< ch 32) (= ch 127))
259 (setq ch (single-key-description ch))
260 (if (and (>= ch 128) (< ch 160))
ea60d50f
KH		 261 (setq ch (format "%02Xh" ch))
262 (if (> ch #x10FFFF)
263 (setq ch 32))))
35650cd2 264 (insert "\t" ch)
efdd2d79
KH		 265 (setq i (1+ i))))
266 (insert "\n"))
267
efdd2d79
KH		 268;;;###autoload
269(defun list-charset-chars (charset)
205a973c 270 "Display a list of characters in character set CHARSET."
efdd2d79 271 (interactive (list (read-charset "Character set: ")))
875d7ad9
KH		 272 (or (charsetp charset)
273 (error "Invalid character set: %s" charset))
3aab6d06 274 (with-output-to-temp-buffer "*Character List*"
efdd2d79 275 (with-current-buffer standard-output
8a97200f
DL		 276 (if (coding-system-p charset)
277 ;; Useful to be able to do C-u C-x = to find file code, for
278 ;; instance:
279 (set-buffer-file-coding-system charset))
3aab6d06
KH		 280 (setq mode-line-format (copy-sequence mode-line-format))
281 (let ((slot (memq 'mode-line-buffer-identification mode-line-format)))
282 (if slot
283 (setcdr slot
284 (cons (format " (%s)" charset)
285 (cdr slot)))))
35650cd2 286 (setq tab-width 4)
efdd2d79 287 (set-buffer-multibyte t)
205a973c
DL		 288 (let ((dim (charset-dimension charset))
289 (chars (charset-chars charset))
290 ;; (plane (charset-iso-graphic-plane charset))
291 (plane 1)
292 (range (plist-get (charset-plist charset) :code-space))
293 min max min2 max2)
294 (if (> dim 2)
295 (error "Can only list 1- and 2-dimensional charsets"))
296 (insert (format "Characters in the coded character set %s.\n" charset))
4a64ad45 297 (narrow-to-region (point) (point))
205a973c
DL		 298 (setq min (aref range 0)
299 max (aref range 1))
300 (if (= dim 1)
205a973c
DL		 301 (list-block-of-chars charset 0 min max)
302 (setq min2 (aref range 2)
303 max2 (aref range 3))
304 (let ((i min2))
305 (while (<= i max2)
306 (list-block-of-chars charset i min max)
4a64ad45
KH		 307 (setq i (1+ i)))))
308 (put-text-property (point-min) (point-max) 'charset charset)
309 (widen)))))
efdd2d79 310
b1e3566c 311
a399ef7b
KH		 312;;;###autoload
313(defun describe-character-set (charset)
7cc8aac3 314 "Display information about built-in character set CHARSET."
3a1ef8f5 315 (interactive (list (read-charset "Charset: ")))
a399ef7b
KH		 316 (or (charsetp charset)
317 (error "Invalid charset: %S" charset))
32226619
JB		 318 (help-setup-xref (list #'describe-character-set charset)
319 (called-interactively-p 'interactive))
af279988
DL		 320 (with-output-to-temp-buffer (help-buffer)
321 (with-current-buffer standard-output
feff73a4
DL		 322 (insert "Character set: " (symbol-name charset))
323 (let ((name (get-charset-property charset :name)))
324 (if (not (eq name charset))
325 (insert " (alias of " (symbol-name name) ?\))))
326 (insert "\n\n" (charset-description charset) "\n\n")
3918e9c9
DL		 327 (insert "Number of contained characters: ")
328 (dotimes (i (charset-dimension charset))
329 (unless (= i 0)
92c15c34 330 (insert ?x))
f21ee25f 331 (insert (format "%d" (charset-chars charset (1+ i)))))
3918e9c9 332 (insert ?\n)
feff73a4
DL		 333 (let ((char (charset-iso-final-char charset)))
334 (when (> char 0)
335 (insert "Final char of ISO2022 designation sequence: ")
336 (insert (format "`%c'\n" char))))
feff73a4
DL		 337 (let (aliases)
338 (dolist (c charset-list)
339 (if (and (not (eq c charset))
340 (eq charset (get-charset-property c :name)))
341 (push c aliases)))
342 (if aliases
343 (insert "Aliases: " (mapconcat #'symbol-name aliases ", ") ?\n)))
bc01a178 344
feff73a4
DL		 345 (dolist (elt `((:ascii-compatible-p "ASCII compatible." nil)
346 (:map "Map file: " identity)
347 (:unify-map "Unification map file: " identity)
348 (:invalid-code
349 nil
350 ,(lambda (c)
351 (format "Invalid character: %c (code %d)" c c)))
352 (:emacs-mule-id "Id in emacs-mule coding system: "
353 number-to-string)
354 (:parents "Parents: "
355 (lambda (parents)
356 (mapconcat ,(lambda (elt)
357 (format "%s" elt))
358 parents
359 ", ")))
360 (:code-space "Code space: " ,(lambda (c)
361 (format "%s" c)))
362 (:code-offset "Code offset: " number-to-string)
363 (:iso-revision-number "ISO revision number: "
364 number-to-string)
365 (:supplementary-p
366 "Used only as a parent of some other charset." nil)))
367 (let ((val (get-charset-property charset (car elt))))
368 (when val
369 (if (cadr elt) (insert (cadr elt)))
370 (if (nth 2 elt)
371 (insert (funcall (nth 2 elt) val)))
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)
961 ;; Reoder the printed information to match with the font
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))
18f515e4 1059 (nth 4 elt)))))))
4ed46869
KH		 1060\f
1061;;; DIAGNOSIS
1062
4472a77b
KH		 1063;; Insert a header of a section with SECTION-NUMBER and TITLE.
1064(defun insert-section (section-number title)
4ed46869 1065 (insert "########################################\n"
4472a77b 1066 "# Section " (format "%d" section-number) ". " title "\n"
4ed46869
KH		 1067 "########################################\n\n"))
1068
1069;;;###autoload
1070(defun mule-diag ()
3fdaafa6 1071 "Display diagnosis of the multilingual environment (Mule).
4472a77b 1072
4527adca 1073This shows various information related to the current multilingual
4472a77b 1074environment, including lists of input methods, coding systems,
4527adca 1075character sets, and fontsets (if Emacs is running under a window
effd4e82 1076system which uses fontsets)."
4ed46869 1077 (interactive)
4472a77b 1078 (with-output-to-temp-buffer "*Mule-Diagnosis*"
55140940 1079 (with-current-buffer standard-output
13cef08d
KH		 1080 (insert "###############################################\n"
1081 "### Current Status of Multilingual Features ###\n"
1082 "###############################################\n\n"
4ed46869
KH		 1083 "CONTENTS: Section 1. General Information\n"
1084 " Section 2. Display\n"
1085 " Section 3. Input methods\n"
1086 " Section 4. Coding systems\n"
4472a77b 1087 " Section 5. Character sets\n")
ee5f768d 1088 (if (and window-system (fboundp 'fontset-list))
4472a77b 1089 (insert " Section 6. Fontsets\n"))
4ed46869
KH		 1090 (insert "\n")
1091
1092 (insert-section 1 "General Information")
7bce107c 1093 (insert "Version of this emacs:\n " (emacs-version) "\n\n")
cbbe6489
KH		 1094 (insert "Configuration options:\n " system-configuration-options "\n\n")
1095 (insert "Multibyte characters awareness:\n"
597e2240
GM		 1096 (format " default: %S\n" (default-value
1097 'enable-multibyte-characters))
cbbe6489
KH		 1098 (format " current-buffer: %S\n\n" enable-multibyte-characters))
1099 (insert "Current language environment: " current-language-environment
1100 "\n\n")
4ed46869
KH		 1101
1102 (insert-section 2 "Display")
1103 (if window-system
f7980931
JB		 1104 (insert (format "Window-system: %s, version %s"
1105 window-system window-system-version))
4ed46869
KH		 1106 (insert "Terminal: " (getenv "TERM")))
1107 (insert "\n\n")
1108
18f515e4 1109 (if window-system
4ed46869 1110 (let ((font (cdr (assq 'font (frame-parameters)))))
d102151d
KH		 1111 (insert "The font and fontset of the selected frame are:\n"
1112 " font: " font "\n"
1113 " fontset: " (face-attribute 'default :fontset) "\n"))
4ed46869
KH		 1114 (insert "Coding system of the terminal: "
1115 (symbol-name (terminal-coding-system))))
1116 (insert "\n\n")
1117
1118 (insert-section 3 "Input methods")
13cef08d 1119 (list-input-methods-1)
4ed46869
KH		 1120 (insert "\n")
1121 (if default-input-method
d4b11c67 1122 (insert (format "Default input method: %s\n" default-input-method))
1b76aedd 1123 (insert "No default input method is specified\n"))
4ed46869
KH		 1124
1125 (insert-section 4 "Coding systems")
13cef08d 1126 (list-coding-systems-1 t)
4ed46869
KH		 1127 (insert "\n")
1128
4472a77b 1129 (insert-section 5 "Character sets")
efdd2d79 1130 (list-character-sets-2)
4ed46869
KH		 1131 (insert "\n")
1132
ee5f768d 1133 (when (and window-system (fboundp 'fontset-list))
13cef08d 1134 ;; This code duplicates most of list-fontsets.
4472a77b 1135 (insert-section 6 "Fontsets")
13cef08d
KH		 1136 (insert "Fontset-Name\t\t\t\t\t\t WDxHT Style\n")
1137 (insert "------------\t\t\t\t\t\t ----- -----\n")
18f515e4
JB		 1138 (dolist (fontset (fontset-list))
1139 (print-fontset fontset t)))
d5d105e8 1140 (help-print-return-message))))
4ed46869 1141
fa5ee889 1142;;;###autoload
73650060 1143(defun font-show-log (&optional limit)
4ab088c0 1144 "Show log of font listing and opening.
73650060
KH		 1145Prefix arg LIMIT says how many fonts to show for each listing.
1146The default is 20. If LIMIT is negative, do not limit the listing."
1147 (interactive "P")
1148 (setq limit (if limit (prefix-numeric-value limit) 20))
fa5ee889
KH		 1149 (if (eq font-log t)
1150 (message "Font logging is currently suppressed")
1151 (with-output-to-temp-buffer "*Help*"
1152 (set-buffer standard-output)
1153 (dolist (elt (reverse font-log))
1154 (insert (format "%s: %s\n" (car elt) (cadr elt)))
1155 (setq elt (nth 2 elt))
1156 (if (or (vectorp elt) (listp elt))
4ab088c0 1157 (let ((i 0))
bcd79f83
KH		 1158 (catch 'tag
1159 (mapc #'(lambda (x)
1160 (setq i (1+ i))
73650060 1161 (when (= i limit)
bcd79f83
KH		 1162 (insert " ...\n")
1163 (throw 'tag nil))
1164 (insert (format " %s\n" x)))
1165 elt)))
fa5ee889
KH		 1166 (insert (format " %s\n" elt)))))))
1167
1168
bfe77626
DL		 1169(provide 'mule-diag)
1170
cbee283d 1171;; arch-tag: cd3b607c-2893-45a0-a4fa-a6535754dbee
795a5f84 1172;;; mule-diag.el ends here
Unnamed repository; edit this file 'description' to name the repository.