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