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