HCoop / bpt / emacs.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
Merge from emacs-23
[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,
5df4f04c 4;; 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc.
7976eda0 5;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
5df4f04c 6;; 2005, 2006, 2007, 2008, 2009, 2010, 2011
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)
368b3544
KH		 371 (let ((print-length 10) (print-level 2))
372 (princ (funcall (nth 2 elt) val) (current-buffer))))
feff73a4 373 (insert ?\n)))))))
4ed46869
KH		 374\f
375;;; CODING-SYSTEM
376
26b3dce6 377(defvar graphic-register) ; dynamic bondage
8285fa96
DL		 378
379;; Print information about designation of each graphic register in
380;; DESIGNATIONS in human readable format. See the documentation of
381;; `define-coding-system' for the meaning of DESIGNATIONS
382;; (`:designation' property).
383(defun print-designation (designations)
384 (let (charset)
385 (dotimes (graphic-register 4)
386 (setq charset (aref designations graphic-register))
4ed46869
KH		 387 (princ (format
388 " G%d -- %s\n"
389 graphic-register
390 (cond ((null charset)
391 "never used")
392 ((eq charset t)
393 "no initial designation, and used by any charsets")
394 ((symbolp charset)
395 (format "%s:%s"
396 charset (charset-description charset)))
397 ((listp charset)
398 (if (charsetp (car charset))
8285fa96 399 (format "%s:%s, and also used by the following:"
4ed46869
KH		 400 (car charset)
401 (charset-description (car charset)))
92c15c34 402 "no initial designation, and used by the following:"))
4ed46869
KH		 403 (t
404 "invalid designation information"))))
4472a77b
KH		 405 (when (listp charset)
406 (setq charset (cdr charset))
407 (while charset
408 (cond ((eq (car charset) t)
409 (princ "\tany other charsets\n"))
410 ((charsetp (car charset))
411 (princ (format "\t%s:%s\n"
412 (car charset)
413 (charset-description (car charset)))))
414 (t
187bd11c 415 "invalid designation information"))
8285fa96 416 (setq charset (cdr charset)))))))
4ed46869
KH		 417
418;;;###autoload
419(defun describe-coding-system (coding-system)
4527adca 420 "Display information about CODING-SYSTEM."
5b76833f 421 (interactive "zDescribe coding system (default current choices): ")
426f97dc
KH		 422 (if (null coding-system)
423 (describe-current-coding-system)
55140940 424 (help-setup-xref (list #'describe-coding-system coding-system)
32226619 425 (called-interactively-p 'interactive))
55140940 426 (with-output-to-temp-buffer (help-buffer)
426f97dc 427 (print-coding-system-briefly coding-system 'doc-string)
02e91426 428 (let ((type (coding-system-type coding-system))
8f924df7
KH		 429 ;; Fixme: use this
430 (extra-spec (coding-system-plist coding-system)))
426f97dc 431 (princ "Type: ")
02e91426 432 (princ type)
2c390c27 433 (cond ((eq type 'undecided)
02e91426 434 (princ " (do automatic conversion)"))
2c390c27
KH		 435 ((eq type 'utf-8)
436 (princ " (UTF-8: Emacs internal multibyte form)"))
f3d983d8
DL		 437 ((eq type 'utf-16)
438 ;; (princ " (UTF-16)")
439 )
8285fa96 440 ((eq type 'shift-jis)
02e91426 441 (princ " (Shift-JIS, MS-KANJI)"))
2c390c27 442 ((eq type 'iso-2022)
02e91426
SM		 443 (princ " (variant of ISO-2022)\n")
444 (princ "Initial designations:\n")
8285fa96
DL		 445 (print-designation (coding-system-get coding-system
446 :designation))
447
448 (when (coding-system-get coding-system :flags)
449 (princ "Other specifications: \n ")
450 (apply #'print-list
451 (coding-system-get coding-system :flags))))
2c390c27
KH		 452 ((eq type 'charset)
453 (princ " (charset)"))
454 ((eq type 'ccl)
02e91426 455 (princ " (do conversion by CCL program)"))
2c390c27 456 ((eq type 'raw-text)
02e91426 457 (princ " (text with random binary characters)"))
9be33434
DL		 458 ((eq type 'emacs-mule)
459 (princ " (Emacs 21 internal encoding)"))
c451e59e 460 ((eq type 'big5))
2c390c27 461 (t (princ ": invalid coding-system.")))
753fd9ca 462 (princ "\nEOL type: ")
426f97dc
KH		 463 (let ((eol-type (coding-system-eol-type coding-system)))
464 (cond ((vectorp eol-type)
465 (princ "Automatic selection from:\n\t")
466 (princ eol-type)
467 (princ "\n"))
468 ((or (null eol-type) (eq eol-type 0)) (princ "LF\n"))
469 ((eq eol-type 1) (princ "CRLF\n"))
470 ((eq eol-type 2) (princ "CR\n"))
471 (t (princ "invalid\n")))))
3a1ef8f5 472 (let ((postread (coding-system-get coding-system :post-read-conversion)))
ff8909d8 473 (when postread
71527e5d
DL		 474 (princ "After decoding text normally,")
475 (princ " perform post-conversion using the function: ")
ff8909d8
KH		 476 (princ "\n ")
477 (princ postread)
478 (princ "\n")))
3a1ef8f5 479 (let ((prewrite (coding-system-get coding-system :pre-write-conversion)))
ff8909d8 480 (when prewrite
71527e5d
DL		 481 (princ "Before encoding text normally,")
482 (princ " perform pre-conversion using the function: ")
ff8909d8
KH		 483 (princ "\n ")
484 (princ prewrite)
485 (princ "\n")))
55140940 486 (with-current-buffer standard-output
9be33434
DL		 487 (let ((charsets (coding-system-charset-list coding-system)))
488 (when (and (not (eq (coding-system-base coding-system) 'raw-text))
97b14492 489 charsets)
9be33434
DL		 490 (cond
491 ((eq charsets 'iso-2022)
492 (insert "This coding system can encode all ISO 2022 charsets."))
493 ((eq charsets 'emacs-mule)
494 (insert "This coding system can encode all emacs-mule charsets\
495."""))
496 (t
71527e5d 497 (insert "This coding system encodes the following charsets:\n ")
a399ef7b
KH		 498 (while charsets
499 (insert " " (symbol-name (car charsets)))
500 (search-backward (symbol-name (car charsets)))
e8cdeaca 501 (help-xref-button 0 'help-character-set (car charsets))
a399ef7b 502 (goto-char (point-max))
9be33434 503 (setq charsets (cdr charsets)))))))))))
4ed46869
KH		 504
505;;;###autoload
506(defun describe-current-coding-system-briefly ()
795a5f84 507 "Display coding systems currently used in a brief format in echo area.
4ed46869 508
795a5f84 509The format is \"F[..],K[..],T[..],P>[..],P<[..], default F[..],P<[..],P<[..]\",
4ed46869 510where mnemonics of the following coding systems come in this order
7cc8aac3 511in place of `..':
187bd11c
SS		 512 `buffer-file-coding-system' (of the current buffer)
513 eol-type of `buffer-file-coding-system' (of the current buffer)
4527adca 514 Value returned by `keyboard-coding-system'
187bd11c
SS		 515 eol-type of `keyboard-coding-system'
516 Value returned by `terminal-coding-system'.
517 eol-type of `terminal-coding-system'
4527adca 518 `process-coding-system' for read (of the current buffer, if any)
187bd11c 519 eol-type of `process-coding-system' for read (of the current buffer, if any)
4527adca 520 `process-coding-system' for write (of the current buffer, if any)
187bd11c 521 eol-type of `process-coding-system' for write (of the current buffer, if any)
b56a5ae0
SM		 522 default `buffer-file-coding-system'
523 eol-type of default `buffer-file-coding-system'
4527adca 524 `default-process-coding-system' for read
187bd11c 525 eol-type of `default-process-coding-system' for read
4527adca 526 `default-process-coding-system' for write
187bd11c 527 eol-type of `default-process-coding-system'"
4ed46869
KH		 528 (interactive)
529 (let* ((proc (get-buffer-process (current-buffer)))
530 (process-coding-systems (if proc (process-coding-system proc))))
531 (message
bb89cd2a 532 "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 533 (coding-system-mnemonic buffer-file-coding-system)
795a5f84 534 (coding-system-eol-type-mnemonic buffer-file-coding-system)
4ed46869 535 (coding-system-mnemonic (keyboard-coding-system))
795a5f84 536 (coding-system-eol-type-mnemonic (keyboard-coding-system))
4ed46869 537 (coding-system-mnemonic (terminal-coding-system))
795a5f84 538 (coding-system-eol-type-mnemonic (terminal-coding-system))
4ed46869 539 (coding-system-mnemonic (car process-coding-systems))
795a5f84 540 (coding-system-eol-type-mnemonic (car process-coding-systems))
4ed46869 541 (coding-system-mnemonic (cdr process-coding-systems))
795a5f84 542 (coding-system-eol-type-mnemonic (cdr process-coding-systems))
b56a5ae0
SM		 543 (coding-system-mnemonic (default-value 'buffer-file-coding-system))
544 (coding-system-eol-type-mnemonic
545 (default-value 'buffer-file-coding-system))
4ed46869 546 (coding-system-mnemonic (car default-process-coding-system))
795a5f84 547 (coding-system-eol-type-mnemonic (car default-process-coding-system))
4ed46869 548 (coding-system-mnemonic (cdr default-process-coding-system))
795a5f84 549 (coding-system-eol-type-mnemonic (cdr default-process-coding-system))
4ed46869
KH		 550 )))
551
426f97dc 552(defun print-coding-system-briefly (coding-system &optional doc-string)
8f924df7
KH		 553 "Print symbol name and mnemonic letter of CODING-SYSTEM with `princ'.
554If DOC-STRING is non-nil, print also the docstring of CODING-SYSTEM.
555If DOC-STRING is `tightly', don't print an empty line before the
556docstring, and print only the first line of the docstring."
795a5f84
KH		 557 (if (not coding-system)
558 (princ "nil\n")
559 (princ (format "%c -- %s"
560 (coding-system-mnemonic coding-system)
561 coding-system))
a8692ed8 562 (let ((aliases (coding-system-aliases coding-system)))
91e854f2
KH		 563 (cond ((eq coding-system (car aliases))
564 (if (cdr aliases)
565 (princ (format " %S" (cons 'alias: (cdr aliases))))))
566 ((memq coding-system aliases)
567 (princ (format " (alias of %s)" (car aliases))))
568 (t
569 (let ((eol-type (coding-system-eol-type coding-system))
570 (base-eol-type (coding-system-eol-type (car aliases))))
571 (if (and (integerp eol-type)
572 (vectorp base-eol-type)
573 (not (eq coding-system (aref base-eol-type eol-type))))
574 (princ (format " (alias of %s)"
575 (aref base-eol-type eol-type))))))))
60b898c6
KH		 576 (princ "\n")
577 (or (eq doc-string 'tightly)
578 (princ "\n"))
579 (if doc-string
580 (let ((doc (or (coding-system-doc-string coding-system) "")))
581 (when (eq doc-string 'tightly)
582 (if (string-match "\n" doc)
583 (setq doc (substring doc 0 (match-beginning 0))))
584 (setq doc (concat " " doc)))
585 (princ (format "%s\n" doc))))))
4ed46869
KH		 586
587;;;###autoload
588(defun describe-current-coding-system ()
4527adca 589 "Display coding systems currently used, in detail."
4ed46869
KH		 590 (interactive)
591 (with-output-to-temp-buffer "*Help*"
592 (let* ((proc (get-buffer-process (current-buffer)))
593 (process-coding-systems (if proc (process-coding-system proc))))
e72e91e9 594 (princ "Coding system for saving this buffer:\n ")
795a5f84
KH		 595 (if (local-variable-p 'buffer-file-coding-system)
596 (print-coding-system-briefly buffer-file-coding-system)
e72e91e9
RS		 597 (princ "Not set locally, use the default.\n"))
598 (princ "Default coding system (for new files):\n ")
b56a5ae0 599 (print-coding-system-briefly (default-value 'buffer-file-coding-system))
e72e91e9 600 (princ "Coding system for keyboard input:\n ")
4ed46869 601 (print-coding-system-briefly (keyboard-coding-system))
e72e91e9 602 (princ "Coding system for terminal output:\n ")
4ed46869 603 (print-coding-system-briefly (terminal-coding-system))
0fe44409
SM		 604 (when (boundp 'selection-coding-system)
605 (princ "Coding system for inter-client cut and paste:\n ")
606 (print-coding-system-briefly selection-coding-system))
e72e91e9
RS		 607 (when (get-buffer-process (current-buffer))
608 (princ "Coding systems for process I/O:\n")
609 (princ " encoding input to the process: ")
610 (print-coding-system-briefly (cdr process-coding-systems))
611 (princ " decoding output from the process: ")
612 (print-coding-system-briefly (car process-coding-systems)))
1b76aedd 613 (princ "Defaults for subprocess I/O:\n")
795a5f84 614 (princ " decoding: ")
4ed46869 615 (print-coding-system-briefly (car default-process-coding-system))
795a5f84
KH		 616 (princ " encoding: ")
617 (print-coding-system-briefly (cdr default-process-coding-system)))
426f97dc 618
55140940 619 (with-current-buffer standard-output
426f97dc 620
7cc8aac3
PJ		 621 (princ "
622Priority order for recognizing coding systems when reading files:\n")
2c390c27
KH		 623 (let ((i 1))
624 (dolist (elt (coding-system-priority-list))
625 (princ (format " %d. %s " i elt))
626 (let ((aliases (coding-system-aliases elt)))
627 (if (eq elt (car aliases))
ff8909d8
KH		 628 (if (cdr aliases)
629 (princ (cons 'alias: (cdr aliases))))
2c390c27 630 (princ (list 'alias 'of (car aliases))))
5cfcd8bc 631 (terpri)
2c390c27 632 (setq i (1+ i)))))
ff8909d8 633
426f97dc
KH		 634 (princ "\n Other coding systems cannot be distinguished automatically
635 from these, and therefore cannot be recognized automatically
636 with the present coding system priorities.\n\n")
637
a8692ed8 638 ;; Fixme: should this be replaced or junked?
2c390c27 639 (if nil
b585fb6c 640 (let ((categories '(coding-category-iso-7 coding-category-iso-7-else))
426f97dc
KH		 641 coding-system codings)
642 (while categories
643 (setq coding-system (symbol-value (car categories)))
1249c1d1 644 (mapc
02e91426
SM		 645 (lambda (x)
646 (if (and (not (eq x coding-system))
feff73a4
DL		 647 (let ((flags (coding-system-get :flags)))
648 (not (or (memq 'use-roman flags)
649 (memq 'use-oldjis flags)))))
02e91426 650 (setq codings (cons x codings))))
426f97dc
KH		 651 (get (car categories) 'coding-systems))
652 (if codings
92c15c34 653 (let ((max-col (window-width))
426f97dc 654 pos)
7cc8aac3
PJ		 655 (princ (format "\
656 The following are decoded correctly but recognized as %s:\n "
657 coding-system))
426f97dc
KH		 658 (while codings
659 (setq pos (point))
660 (insert (format " %s" (car codings)))
4472a77b
KH		 661 (when (> (current-column) max-col)
662 (goto-char pos)
663 (insert "\n ")
664 (goto-char (point-max)))
426f97dc
KH		 665 (setq codings (cdr codings)))
666 (insert "\n\n")))
2c390c27 667 (setq categories (cdr categories)))))
426f97dc 668
e72e91e9 669 (princ "Particular coding systems specified for certain file names:\n")
426f97dc
KH		 670 (terpri)
671 (princ " OPERATION\tTARGET PATTERN\t\tCODING SYSTEM(s)\n")
672 (princ " ---------\t--------------\t\t----------------\n")
673 (let ((func (lambda (operation alist)
674 (princ " ")
675 (princ operation)
676 (if (not alist)
677 (princ "\tnothing specified\n")
678 (while alist
679 (indent-to 16)
680 (prin1 (car (car alist)))
ff8909d8
KH		 681 (if (>= (current-column) 40)
682 (newline))
426f97dc
KH		 683 (indent-to 40)
684 (princ (cdr (car alist)))
685 (princ "\n")
686 (setq alist (cdr alist)))))))
687 (funcall func "File I/O" file-coding-system-alist)
688 (funcall func "Process I/O" process-coding-system-alist)
689 (funcall func "Network I/O" network-coding-system-alist))
690 (help-mode))))
4ed46869 691
ff8909d8 692(defun print-coding-system (coding-system)
3a1ef8f5 693 "Print detailed information on CODING-SYSTEM."
4ed46869 694 (let ((type (coding-system-type coding-system))
795a5f84 695 (eol-type (coding-system-eol-type coding-system))
feff73a4 696 (flags (coding-system-get coding-system :flags))
a8692ed8 697 (aliases (coding-system-aliases coding-system)))
ff8909d8
KH		 698 (if (not (eq (car aliases) coding-system))
699 (princ (format "%s (alias of %s)\n" coding-system (car aliases)))
795a5f84 700 (princ coding-system)
18f515e4 701 (dolist (alias (cdr aliases))
4472a77b 702 (princ ",")
18f515e4 703 (princ alias))
795a5f84
KH		 704 (princ (format ":%s:%c:%d:"
705 type
706 (coding-system-mnemonic coding-system)
707 (if (integerp eol-type) eol-type 3)))
feff73a4 708 (cond ((eq type 'iso2022)
795a5f84
KH		 709 (let ((idx 0)
710 charset)
711 (while (< idx 4)
712 (setq charset (aref flags idx))
713 (cond ((null charset)
714 (princ -1))
715 ((eq charset t)
716 (princ -2))
717 ((charsetp charset)
718 (princ charset))
719 ((listp charset)
720 (princ "(")
4ed46869 721 (princ (car charset))
795a5f84
KH		 722 (setq charset (cdr charset))
723 (while charset
724 (princ ",")
725 (princ (car charset))
726 (setq charset (cdr charset)))
727 (princ ")")))
728 (princ ",")
729 (setq idx (1+ idx)))
730 (while (< idx 12)
731 (princ (if (aref flags idx) 1 0))
732 (princ ",")
733 (setq idx (1+ idx)))
734 (princ (if (aref flags idx) 1 0))))
feff73a4 735 ((eq type 'ccl)
795a5f84 736 (let (i len)
0d5f1e3a
RS		 737 (if (symbolp (car flags))
738 (princ (format " %s" (car flags)))
739 (setq i 0 len (length (car flags)))
740 (while (< i len)
741 (princ (format " %x" (aref (car flags) i)))
742 (setq i (1+ i))))
4ed46869 743 (princ ",")
0d5f1e3a
RS		 744 (if (symbolp (cdr flags))
745 (princ (format "%s" (cdr flags)))
746 (setq i 0 len (length (cdr flags)))
747 (while (< i len)
748 (princ (format " %x" (aref (cdr flags) i)))
749 (setq i (1+ i))))))
795a5f84
KH		 750 (t (princ 0)))
751 (princ ":")
752 (princ (coding-system-doc-string coding-system))
753 (princ "\n"))))
4ed46869 754
795a5f84 755;;;###autoload
4472a77b
KH		 756(defun list-coding-systems (&optional arg)
757 "Display a list of all coding systems.
4527adca 758This shows the mnemonic letter, name, and description of each coding system.
4472a77b 759
e4fe4569 760With prefix ARG, the output format gets more cryptic,
4527adca 761but still contains full information about each coding system."
4472a77b 762 (interactive "P")
4ed46869 763 (with-output-to-temp-buffer "*Help*"
13cef08d
KH		 764 (list-coding-systems-1 arg)))
765
766(defun list-coding-systems-1 (arg)
767 (if (null arg)
768 (princ "\
795a5f84
KH		 769###############################################
770# List of coding systems in the following format:
771# MNEMONIC-LETTER -- CODING-SYSTEM-NAME
60b898c6 772# DOC-STRING
795a5f84 773")
13cef08d 774 (princ "\
4ed46869
KH		 775#########################
776## LIST OF CODING SYSTEMS
777## Each line corresponds to one coding system
778## Format of a line is:
795a5f84
KH		 779## NAME[,ALIAS...]:TYPE:MNEMONIC:EOL:FLAGS:POST-READ-CONVERSION
780## :PRE-WRITE-CONVERSION:DOC-STRING,
4ed46869 781## where
795a5f84
KH		 782## NAME = coding system name
783## ALIAS = alias of the coding system
784## TYPE = nil (no conversion), t (undecided or automatic detection),
785## 0 (EMACS-MULE), 1 (SJIS), 2 (ISO2022), 3 (BIG5), or 4 (CCL)
4ed46869
KH		 786## EOL = 0 (LF), 1 (CRLF), 2 (CR), or 3 (Automatic detection)
787## FLAGS =
788## if TYPE = 2 then
92c15c34 789## comma (`,') separated data of the following:
4ed46869
KH		 790## G0, G1, G2, G3, SHORT-FORM, ASCII-EOL, ASCII-CNTL, SEVEN,
791## LOCKING-SHIFT, SINGLE-SHIFT, USE-ROMAN, USE-OLDJIS, NO-ISO6429
792## else if TYPE = 4 then
793## comma (`,') separated CCL programs for read and write
794## else
795## 0
795a5f84 796## POST-READ-CONVERSION, PRE-WRITE-CONVERSION = function name to be called
4ed46869 797##
795a5f84 798"))
60b898c6
KH		 799 (dolist (coding-system (sort-coding-systems (coding-system-list 'base-only)))
800 (if (null arg)
801 (print-coding-system-briefly coding-system 'tightly)
802 (print-coding-system coding-system))))
4472a77b 803
a8692ed8 804;; Fixme: delete?
867ef43a 805;;;###autoload
4472a77b
KH		 806(defun list-coding-categories ()
807 "Display a list of all coding categories."
808 (with-output-to-temp-buffer "*Help*"
809 (princ "\
4ed46869
KH		 810############################
811## LIST OF CODING CATEGORIES (ordered by priority)
812## CATEGORY:CODING-SYSTEM
813##
814")
4472a77b
KH		 815 (let ((l coding-category-list))
816 (while l
817 (princ (format "%s:%s\n" (car l) (symbol-value (car l))))
818 (setq l (cdr l))))))
4ed46869
KH		 819\f
820;;; FONT
821
aa360da1
GM		 822(declare-function font-info "font.c" (name &optional frame))
823
9291a2d6
CY		 824(defun describe-font-internal (font-info &optional ignored)
825 "Print information about a font in FONT-INFO.
826The IGNORED argument is ignored."
4ed46869
KH		 827 (print-list "name (opened by):" (aref font-info 0))
828 (print-list " full name:" (aref font-info 1))
b1e3566c
KH		 829 (print-list " size:" (format "%2d" (aref font-info 2)))
830 (print-list " height:" (format "%2d" (aref font-info 3)))
831 (print-list " baseline-offset:" (format "%2d" (aref font-info 4)))
832 (print-list "relative-compose:" (format "%2d" (aref font-info 5))))
4ed46869
KH		 833
834;;;###autoload
835(defun describe-font (fontname)
fca31fbb
KH		 836 "Display information about a font whose name is FONTNAME.
837The font must be already used by Emacs."
838 (interactive "sFont name (default current choice for ASCII chars): ")
ee5f768d 839 (or (and window-system (fboundp 'fontset-list))
fca31fbb 840 (error "No fonts being used"))
7736dabe
KH		 841 (let (font-info)
842 (if (or (not fontname) (= (length fontname) 0))
843 (setq fontname (face-attribute 'default :font)))
fca31fbb 844 (setq font-info (font-info fontname))
4ed46869 845 (if (null font-info)
7736dabe 846 (if (fontp fontname 'font-object)
fca31fbb
KH		 847 ;; The font should be surely used. So, there's some
848 ;; problem about getting information about it. It is
849 ;; better to print the fontname to show which font has
850 ;; this problem.
7736dabe
KH		 851 (message "No information about \"%s\"" (font-xlfd-name fontname))
852 (message "No matching font found"))
4ed46869 853 (with-output-to-temp-buffer "*Help*"
9291a2d6 854 (describe-font-internal font-info)))))
4ed46869 855
5c117135
KH		 856(defun print-fontset-element (val)
857 ;; VAL has this format:
858 ;; ((REQUESTED-FONT-NAME OPENED-FONT-NAME ...) ...)
859 ;; CHAR RANGE is already inserted. Get character codes from
860 ;; the current line.
861 (beginning-of-line)
862 (let ((from (following-char))
863 (to (if (looking-at "[^.]*[.]* ")
864 (char-after (match-end 0)))))
865 (if (re-search-forward "[ \t]*$" nil t)
866 (delete-region (match-beginning 0) (match-end 0)))
867
868 ;; For non-ASCII characters, insert also CODE RANGE.
869 (if (or (>= from 128) (and to (>= to 128)))
870 (if to
871 (insert (format " (#x%02X .. #x%02X)" from to))
872 (insert (format " (#x%02X)" from))))
873
874 ;; Insert a requested font name.
875 (dolist (elt val)
e94848ea
KH		 876 (if (not elt)
877 (insert "\n -- inhibit fallback fonts --")
878 (let ((requested (car elt)))
879 (if (stringp requested)
880 (insert "\n " requested)
881 (let (family registry weight slant width adstyle)
882 (if (and (fboundp 'fontp) (fontp requested))
883 (setq family (font-get requested :family)
884 registry (font-get requested :registry)
885 weight (font-get requested :weight)
886 slant (font-get requested :slant)
887 width (font-get requested :width)
888 adstyle (font-get requested :adstyle))
889 (setq family (aref requested 0)
890 registry (aref requested 5)
891 weight (aref requested 1)
892 slant (aref requested 2)
893 width (aref requested 3)
894 adstyle (aref requested 4)))
895 (if (not family)
896 (setq family "*-*")
897 (if (symbolp family)
898 (setq family (symbol-name family)))
899 (or (string-match "-" family)
900 (setq family (concat "*-" family))))
901 (if (not registry)
902 (setq registry "*-*")
903 (if (symbolp registry)
904 (setq registry (symbol-name registry)))
905 (or (string-match "-" registry)
906 (= (aref registry (1- (length registry))) ?*)
907 (setq registry (concat registry "*"))))
908 (insert (format"\n -%s-%s-%s-%s-%s-*-*-*-*-*-*-%s"
909 family (or weight "*") (or slant "*") (or width "*")
910 (or adstyle "*") registry)))))
911
912 ;; Insert opened font names (if any).
913 (if (and (boundp 'print-opened) (symbol-value 'print-opened))
914 (dolist (opened (cdr elt))
915 (insert "\n\t[" opened "]")))))))
5c117135 916
aa360da1
GM		 917(declare-function query-fontset "fontset.c" (pattern &optional regexpp))
918(declare-function fontset-info "fontset.c" (fontset &optional frame))
919
5c117135 920(defun print-fontset (fontset &optional print-opened)
7cc8aac3 921 "Print information about FONTSET.
d102151d
KH		 922FONTSET nil means the fontset of the selected frame, t means the
923default fontset.
5c117135 924If optional arg PRINT-OPENED is non-nil, also print names of all opened
7cc8aac3
PJ		 925fonts for FONTSET. This function actually inserts the information in
926the current buffer."
d102151d
KH		 927 (if (eq fontset t)
928 (setq fontset (query-fontset "fontset-default"))
929 (if (eq fontset nil)
930 (setq fontset (face-attribute 'default :fontset))))
b827d571 931 (beginning-of-line)
d102151d 932 (narrow-to-region (point) (point))
b827d571 933 (insert "Fontset: " fontset "\n")
5c117135
KH		 934 (insert (propertize "CHAR RANGE" 'face 'underline)
935 " (" (propertize "CODE RANGE" 'face 'underline) ")\n")
936 (insert " " (propertize "FONT NAME" 'face 'underline)
937 " (" (propertize "REQUESTED" 'face 'underline)
938 " and [" (propertize "OPENED" 'face 'underline) "])")
d102151d
KH		 939 (let* ((info (fontset-info fontset))
940 (default-info (char-table-extra-slot info 0))
941 start1 end1 start2 end2)
5c117135 942 (describe-vector info 'print-fontset-element)
d102151d
KH		 943 (when (char-table-range info nil)
944 ;; The default of FONTSET is described.
945 (setq start1 (re-search-backward "^default"))
946 (delete-region (point) (line-end-position))
947 (insert "\n ---<fallback to the default of the specified fontset>---")
948 (put-text-property (line-beginning-position) (point) 'face 'highlight)
949 (goto-char (point-max))
950 (setq end1 (setq start2 (point))))
951 (when default-info
952 (insert "\n ---<fallback to the default fontset>---")
953 (put-text-property (line-beginning-position) (point) 'face 'highlight)
954 (describe-vector default-info 'print-fontset-element)
955 (when (char-table-range default-info nil)
956 ;; The default of the default fontset is described.
957 (setq end2 (re-search-backward "^default"))
958 (delete-region (point) (line-end-position))
959 (insert "\n ---<fallback to the default of the default fontset>---")
960 (put-text-property (line-beginning-position) (point) 'face 'highlight)))
961 (if (and start1 end2)
962 ;; Reoder the printed information to match with the font
963 ;; searching strategy; i.e. FONTSET, the default fontset,
964 ;; default of FONTSET, default of the default fontset.
965 (transpose-regions start1 end1 start2 end2))
966 (goto-char (point-max)))
967 (widen))
4ed46869 968
aa360da1
GM		 969(defvar fontset-alias-alist)
970(declare-function fontset-list "fontset.c" ())
971
4ed46869
KH		 972;;;###autoload
973(defun describe-fontset (fontset)
7cc8aac3 974 "Display information about FONTSET.
b1e3566c 975This shows which font is used for which character(s)."
4ed46869 976 (interactive
ee5f768d 977 (if (not (and window-system (fboundp 'fontset-list)))
effd4e82 978 (error "No fontsets being used")
71527e5d 979 (let ((fontset-list (nconc
f95b7b89
SM		 980 (fontset-list)
981 (mapcar 'cdr fontset-alias-alist)))
4472a77b
KH		 982 (completion-ignore-case t))
983 (list (completing-read
5b76833f 984 "Fontset (default used by the current frame): "
4472a77b
KH		 985 fontset-list nil t)))))
986 (if (= (length fontset) 0)
d102151d
KH		 987 (setq fontset (face-attribute 'default :fontset))
988 (setq fontset (query-fontset fontset)))
32226619
JB		 989 (help-setup-xref (list #'describe-fontset fontset)
990 (called-interactively-p 'interactive))
55140940
SM		 991 (with-output-to-temp-buffer (help-buffer)
992 (with-current-buffer standard-output
b1e3566c 993 (print-fontset fontset t))))
4472a77b 994
aa360da1
GM		 995(declare-function fontset-plain-name "fontset" (fontset))
996
4472a77b
KH		 997;;;###autoload
998(defun list-fontsets (arg)
999 "Display a list of all fontsets.
4527adca 1000This shows the name, size, and style of each fontset.
7cc8aac3 1001With prefix arg, also list the fonts contained in each fontset;
4527adca 1002see the function `describe-fontset' for the format of the list."
4472a77b 1003 (interactive "P")
ee5f768d 1004 (if (not (and window-system (fboundp 'fontset-list)))
effd4e82 1005 (error "No fontsets being used")
32226619
JB		 1006 (help-setup-xref (list #'list-fontsets arg)
1007 (called-interactively-p 'interactive))
55140940
SM		 1008 (with-output-to-temp-buffer (help-buffer)
1009 (with-current-buffer standard-output
13cef08d 1010 ;; This code is duplicated near the end of mule-diag.
dc1f8c72
KH		 1011 (let ((fontsets
1012 (sort (fontset-list)
02e91426
SM		 1013 (lambda (x y)
1014 (string< (fontset-plain-name x)
1015 (fontset-plain-name y))))))
effd4e82 1016 (while fontsets
b1e3566c
KH		 1017 (if arg
1018 (print-fontset (car fontsets) nil)
1019 (insert "Fontset: " (car fontsets) "\n"))
effd4e82 1020 (setq fontsets (cdr fontsets))))))))
426f97dc
KH		 1021\f
1022;;;###autoload
1023(defun list-input-methods ()
4527adca 1024 "Display information about all input methods."
426f97dc 1025 (interactive)
32226619
JB		 1026 (help-setup-xref '(list-input-methods)
1027 (called-interactively-p 'interactive))
02e91426 1028 (with-output-to-temp-buffer (help-buffer)
7cc8aac3
PJ		 1029 (list-input-methods-1)
1030 (with-current-buffer standard-output
1031 (save-excursion
1032 (goto-char (point-min))
1033 (while (re-search-forward
1034 "^ \\([^ ]+\\) (`.*' in mode line)$" nil t)
ee592269 1035 (help-xref-button 1 'help-input-method (match-string 1)))))))
13cef08d
KH		 1036
1037(defun list-input-methods-1 ()
1038 (if (not input-method-alist)
18f515e4 1039 (princ "
10de7378 1040No input method is available, perhaps because you have not
18f515e4 1041installed LEIM (Libraries of Emacs Input Methods).")
13cef08d
KH		 1042 (princ "LANGUAGE\n NAME (`TITLE' in mode line)\n")
1043 (princ " SHORT-DESCRIPTION\n------------------------------\n")
1044 (setq input-method-alist
1045 (sort input-method-alist
02e91426 1046 (lambda (x y) (string< (nth 1 x) (nth 1 y)))))
18f515e4
JB		 1047
1048 (let (language)
1049 (dolist (elt input-method-alist)
13cef08d
KH		 1050 (when (not (equal language (nth 1 elt)))
1051 (setq language (nth 1 elt))
1052 (princ language)
1053 (terpri))
1054 (princ (format " %s (`%s' in mode line)\n %s\n"
1055 (car elt)
1056 (let ((title (nth 3 elt)))
1057 (if (and (consp title) (stringp (car title)))
1058 (car title)
1059 title))
18f515e4 1060 (nth 4 elt)))))))
4ed46869
KH		 1061\f
1062;;; DIAGNOSIS
1063
4472a77b
KH		 1064;; Insert a header of a section with SECTION-NUMBER and TITLE.
1065(defun insert-section (section-number title)
4ed46869 1066 (insert "########################################\n"
4472a77b 1067 "# Section " (format "%d" section-number) ". " title "\n"
4ed46869
KH		 1068 "########################################\n\n"))
1069
1070;;;###autoload
1071(defun mule-diag ()
3fdaafa6 1072 "Display diagnosis of the multilingual environment (Mule).
4472a77b 1073
4527adca 1074This shows various information related to the current multilingual
4472a77b 1075environment, including lists of input methods, coding systems,
4527adca 1076character sets, and fontsets (if Emacs is running under a window
effd4e82 1077system which uses fontsets)."
4ed46869 1078 (interactive)
4472a77b 1079 (with-output-to-temp-buffer "*Mule-Diagnosis*"
55140940 1080 (with-current-buffer standard-output
13cef08d
KH		 1081 (insert "###############################################\n"
1082 "### Current Status of Multilingual Features ###\n"
1083 "###############################################\n\n"
4ed46869
KH		 1084 "CONTENTS: Section 1. General Information\n"
1085 " Section 2. Display\n"
1086 " Section 3. Input methods\n"
1087 " Section 4. Coding systems\n"
4472a77b 1088 " Section 5. Character sets\n")
ee5f768d 1089 (if (and window-system (fboundp 'fontset-list))
4472a77b 1090 (insert " Section 6. Fontsets\n"))
4ed46869
KH		 1091 (insert "\n")
1092
1093 (insert-section 1 "General Information")
7bce107c 1094 (insert "Version of this emacs:\n " (emacs-version) "\n\n")
cbbe6489
KH		 1095 (insert "Configuration options:\n " system-configuration-options "\n\n")
1096 (insert "Multibyte characters awareness:\n"
597e2240
GM		 1097 (format " default: %S\n" (default-value
1098 'enable-multibyte-characters))
cbbe6489
KH		 1099 (format " current-buffer: %S\n\n" enable-multibyte-characters))
1100 (insert "Current language environment: " current-language-environment
1101 "\n\n")
4ed46869
KH		 1102
1103 (insert-section 2 "Display")
1104 (if window-system
f7980931
JB		 1105 (insert (format "Window-system: %s, version %s"
1106 window-system window-system-version))
4ed46869
KH		 1107 (insert "Terminal: " (getenv "TERM")))
1108 (insert "\n\n")
1109
18f515e4 1110 (if window-system
4ed46869 1111 (let ((font (cdr (assq 'font (frame-parameters)))))
d102151d
KH		 1112 (insert "The font and fontset of the selected frame are:\n"
1113 " font: " font "\n"
1114 " fontset: " (face-attribute 'default :fontset) "\n"))
4ed46869
KH		 1115 (insert "Coding system of the terminal: "
1116 (symbol-name (terminal-coding-system))))
1117 (insert "\n\n")
1118
1119 (insert-section 3 "Input methods")
13cef08d 1120 (list-input-methods-1)
4ed46869
KH		 1121 (insert "\n")
1122 (if default-input-method
d4b11c67 1123 (insert (format "Default input method: %s\n" default-input-method))
1b76aedd 1124 (insert "No default input method is specified\n"))
4ed46869
KH		 1125
1126 (insert-section 4 "Coding systems")
13cef08d 1127 (list-coding-systems-1 t)
4ed46869
KH		 1128 (insert "\n")
1129
4472a77b 1130 (insert-section 5 "Character sets")
efdd2d79 1131 (list-character-sets-2)
4ed46869
KH		 1132 (insert "\n")
1133
ee5f768d 1134 (when (and window-system (fboundp 'fontset-list))
13cef08d 1135 ;; This code duplicates most of list-fontsets.
4472a77b 1136 (insert-section 6 "Fontsets")
13cef08d
KH		 1137 (insert "Fontset-Name\t\t\t\t\t\t WDxHT Style\n")
1138 (insert "------------\t\t\t\t\t\t ----- -----\n")
18f515e4
JB		 1139 (dolist (fontset (fontset-list))
1140 (print-fontset fontset t)))
d5d105e8 1141 (help-print-return-message))))
4ed46869 1142
fa5ee889 1143;;;###autoload
73650060 1144(defun font-show-log (&optional limit)
4ab088c0 1145 "Show log of font listing and opening.
73650060
KH		 1146Prefix arg LIMIT says how many fonts to show for each listing.
1147The default is 20. If LIMIT is negative, do not limit the listing."
1148 (interactive "P")
1149 (setq limit (if limit (prefix-numeric-value limit) 20))
fa5ee889
KH		 1150 (if (eq font-log t)
1151 (message "Font logging is currently suppressed")
1152 (with-output-to-temp-buffer "*Help*"
1153 (set-buffer standard-output)
1154 (dolist (elt (reverse font-log))
1155 (insert (format "%s: %s\n" (car elt) (cadr elt)))
1156 (setq elt (nth 2 elt))
1157 (if (or (vectorp elt) (listp elt))
4ab088c0 1158 (let ((i 0))
bcd79f83
KH		 1159 (catch 'tag
1160 (mapc #'(lambda (x)
1161 (setq i (1+ i))
73650060 1162 (when (= i limit)
bcd79f83
KH		 1163 (insert " ...\n")
1164 (throw 'tag nil))
1165 (insert (format " %s\n" x)))
1166 elt)))
fa5ee889
KH		 1167 (insert (format " %s\n" elt)))))))
1168
1169
bfe77626
DL		 1170(provide 'mule-diag)
1171
cbee283d 1172;; arch-tag: cd3b607c-2893-45a0-a4fa-a6535754dbee
795a5f84 1173;;; mule-diag.el ends here
Unnamed repository; edit this file 'description' to name the repository.