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