Mercurial > emacs

comparison lisp/international/mule-diag.el @ 48050:7f760c845427

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
(non-iso-charset-alist): Move to avoid compilation warning. (mule-diag): Provide.
author Dave Love <fx@gnu.org>
date Mon, 28 Oct 2002 18:44:39 +0000
parents 3eb5b2a7e514
children 6953cce6f3c8
comparison
equal deleted inserted replaced
48049:6382ab89734c 48050:7f760c845427
58 58
59 (define-button-type 'list-charset-chars 59 (define-button-type 'list-charset-chars
60 :supertype 'help-xref 60 :supertype 'help-xref
61 'help-function #'list-charset-chars 61 'help-function #'list-charset-chars
62 'help-echo "mouse-2, RET: show table of characters for this character set") 62 'help-echo "mouse-2, RET: show table of characters for this character set")
63
64
65 ;;;###autoload
66 (defun list-character-sets (arg)
67 "Display a list of all character sets.
68
69 The ID-NUM column contains a charset identification number for
70 internal Emacs use.
71
72 The MULTIBYTE-FORM column contains the format of the buffer and string
73 multibyte sequence of characters in the charset using one to four
74 hexadecimal digits.
75 `xx' stands for any byte in the range 0..127.
76 `XX' stands for any byte in the range 160..255.
77
78 The D column contains the dimension of this character set. The CH
79 column contains the number of characters in a block of this character
80 set. The FINAL-CHAR column contains an ISO-2022 <final-char> to use
81 for designating this character set in ISO-2022-based coding systems.
82
83 With prefix arg, the output format gets more cryptic,
84 but still shows the full information."
85 (interactive "P")
86 (help-setup-xref (list #'list-character-sets arg) (interactive-p))
87 (with-output-to-temp-buffer "*Character Set List*"
88 (with-current-buffer standard-output
89 (if arg
90 (list-character-sets-2)
91 ;; Insert header.
92 (insert "Indirectly supported character sets are shown below.\n")
93 (insert
94 (substitute-command-keys
95 (concat "Use "
96 (if (display-mouse-p) "\\[help-follow-mouse] or ")
97 "\\[help-follow]:\n")))
98 (insert " on a column title to sort by that title,")
99 (indent-to 56)
100 (insert "+----DIMENSION\n")
101 (insert " on a charset name to list characters.")
102 (indent-to 56)
103 (insert "| +--CHARS\n")
104 (let ((columns '(("ID-NUM" . id) "\t"
105 ("CHARSET-NAME" . name) "\t\t\t"
106 ("MULTIBYTE-FORM" . id) "\t"
107 ("D CH FINAL-CHAR" . iso-spec)))
108 pos)
109 (while columns
110 (if (stringp (car columns))
111 (insert (car columns))
112 (insert-text-button (car (car columns))
113 :type 'sort-listed-character-sets
114 'sort-key (cdr (car columns)))
115 (goto-char (point-max)))
116 (setq columns (cdr columns)))
117 (insert "\n"))
118 (insert "------\t------------\t\t\t--------------\t- -- ----------\n")
119
120 ;; Insert body sorted by charset IDs.
121 (list-character-sets-1 'id)
122
123 ;; Insert non-directly-supported charsets.
124 (insert-char ?- 72)
125 (insert "\n\nINDIRECTLY SUPPORTED CHARSETS SETS:\n\n"
126 (propertize "CHARSET NAME\tMAPPED TO" 'face 'bold)
127 "\n------------\t---------\n")
128 (dolist (elt non-iso-charset-alist)
129 (insert-text-button (symbol-name (car elt))
130 :type 'list-charset-chars
131 'help-args (list (car elt)))
132 (indent-to 16)
133 (dolist (e (nth 1 elt))
134 (when (>= (+ (current-column) 1 (string-width (symbol-name e)))
135 ;; This is an approximate value. We don't know
136 ;; the correct window width of this buffer yet.
137 78)
138 (insert "\n")
139 (indent-to 16))
140
141 (insert (format "%s " e)))
142 (insert "\n"))))))
143
144 (defun sort-listed-character-sets (sort-key)
145 (if sort-key
146 (save-excursion
147 (help-setup-xref (list #'list-character-sets nil) t)
148 (let ((buffer-read-only nil))
149 (goto-char (point-min))
150 (re-search-forward "[0-9][0-9][0-9]")
151 (beginning-of-line)
152 (let ((pos (point)))
153 (search-forward "----------")
154 (beginning-of-line)
155 (save-restriction
156 (narrow-to-region pos (point))
157 (delete-region (point-min) (point-max))
158 (list-character-sets-1 sort-key)))))))
159
160 (defun charset-multibyte-form-string (charset)
161 (let ((info (charset-info charset)))
162 (cond ((eq charset 'ascii)
163 "xx")
164 ((eq charset 'eight-bit-control)
165 (format "%2X Xx" (aref info 6)))
166 ((eq charset 'eight-bit-graphic)
167 "XX")
168 (t
169 (let ((str (format "%2X" (aref info 6))))
170 (if (> (aref info 7) 0)
171 (setq str (format "%s %2X"
172 str (aref info 7))))
173 (setq str (concat str " XX"))
174 (if (> (aref info 2) 1)
175 (setq str (concat str " XX")))
176 str)))))
177
178 ;; Insert a list of character sets sorted by SORT-KEY. SORT-KEY
179 ;; should be one of `id', `name', and `iso-spec'. If SORT-KEY is nil,
180 ;; it defaults to `id'.
181
182 (defun list-character-sets-1 (sort-key)
183 (or sort-key
184 (setq sort-key 'id))
185 (let ((tail (charset-list))
186 charset-info-list elt charset info sort-func)
187 (while tail
188 (setq charset (car tail) tail (cdr tail)
189 info (charset-info charset))
190
191 ;; Generate a list that contains all information to display.
192 (setq charset-info-list
193 (cons (list (charset-id charset) ; ID-NUM
194 charset ; CHARSET-NAME
195 (charset-multibyte-form-string charset); MULTIBYTE-FORM
196 (aref info 2) ; DIMENSION
197 (aref info 3) ; CHARS
198 (aref info 8) ; FINAL-CHAR
199 )
200 charset-info-list)))
201
202 ;; Determine a predicate for `sort' by SORT-KEY.
203 (setq sort-func
204 (cond ((eq sort-key 'id)
205 (lambda (x y) (< (car x) (car y))))
206
207 ((eq sort-key 'name)
208 (lambda (x y) (string< (nth 1 x) (nth 1 y))))
209
210 ((eq sort-key 'iso-spec)
211 ;; Sort by DIMENSION CHARS FINAL-CHAR
212 (lambda (x y)
213 (or (< (nth 3 x) (nth 3 y))
214 (and (= (nth 3 x) (nth 3 y))
215 (or (< (nth 4 x) (nth 4 y))
216 (and (= (nth 4 x) (nth 4 y))
217 (< (nth 5 x) (nth 5 y))))))))
218 (t
219 (error "Invalid charset sort key: %s" sort-key))))
220
221 (setq charset-info-list (sort charset-info-list sort-func))
222
223 ;; Insert information of character sets.
224 (while charset-info-list
225 (setq elt (car charset-info-list)
226 charset-info-list (cdr charset-info-list))
227 (insert (format "%03d(%02X)" (car elt) (car elt))) ; ID-NUM
228 (indent-to 8)
229 (insert-text-button (symbol-name (nth 1 elt))
230 :type 'list-charset-chars
231 'help-args (list (nth 1 elt)))
232 (goto-char (point-max))
233 (insert "\t")
234 (indent-to 40)
235 (insert (nth 2 elt)) ; MULTIBYTE-FORM
236 (indent-to 56)
237 (insert (format "%d %2d " (nth 3 elt) (nth 4 elt)) ; DIMENSION and CHARS
238 (if (< (nth 5 elt) 0) "none" (nth 5 elt))) ; FINAL-CHAR
239 (insert "\n"))))
240
241
242 ;; List all character sets in a form that a program can easily parse.
243
244 (defun list-character-sets-2 ()
245 (insert "#########################
246 ## LIST OF CHARSETS
247 ## Each line corresponds to one charset.
248 ## The following attributes are listed in this order
249 ## separated by a colon `:' in one line.
250 ## CHARSET-ID,
251 ## CHARSET-SYMBOL-NAME,
252 ## DIMENSION (1 or 2)
253 ## CHARS (94 or 96)
254 ## BYTES (of multibyte form: 1, 2, 3, or 4),
255 ## WIDTH (occupied column numbers: 1 or 2),
256 ## DIRECTION (0:left-to-right, 1:right-to-left),
257 ## ISO-FINAL-CHAR (character code of ISO-2022's final character)
258 ## ISO-GRAPHIC-PLANE (ISO-2022's graphic plane, 0:GL, 1:GR)
259 ## DESCRIPTION (describing string of the charset)
260 ")
261 (let ((l charset-list)
262 charset)
263 (while l
264 (setq charset (car l) l (cdr l))
265 (princ (format "%03d:%s:%d:%d:%d:%d:%d:%d:%d:%s\n"
266 (charset-id charset)
267 charset
268 (charset-dimension charset)
269 (charset-chars charset)
270 (charset-bytes charset)
271 (charset-width charset)
272 (charset-direction charset)
273 (charset-iso-final-char charset)
274 (charset-iso-graphic-plane charset)
275 (charset-description charset))))))
276 63
277 (defvar non-iso-charset-alist 64 (defvar non-iso-charset-alist
278 `((mac-roman 65 `((mac-roman
279 (ascii latin-iso8859-1 mule-unicode-2500-33ff 66 (ascii latin-iso8859-1 mule-unicode-2500-33ff
280 mule-unicode-0100-24ff mule-unicode-e000-ffff) 67 mule-unicode-0100-24ff mule-unicode-e000-ffff)
334 In the first form, valid codes are between FROM1 and TO1, or FROM2 and 121 In the first form, valid codes are between FROM1 and TO1, or FROM2 and
335 TO2, or... 122 TO2, or...
336 The second form is used for 2-byte codes. The car part is the ranges 123 The second form is used for 2-byte codes. The car part is the ranges
337 of the first byte, and the cdr part is the ranges of the second byte.") 124 of the first byte, and the cdr part is the ranges of the second byte.")
338 125
126 ;;;###autoload
127 (defun list-character-sets (arg)
128 "Display a list of all character sets.
129
130 The ID-NUM column contains a charset identification number for
131 internal Emacs use.
132
133 The MULTIBYTE-FORM column contains the format of the buffer and string
134 multibyte sequence of characters in the charset using one to four
135 hexadecimal digits.
136 `xx' stands for any byte in the range 0..127.
137 `XX' stands for any byte in the range 160..255.
138
139 The D column contains the dimension of this character set. The CH
140 column contains the number of characters in a block of this character
141 set. The FINAL-CHAR column contains an ISO-2022 <final-char> to use
142 for designating this character set in ISO-2022-based coding systems.
143
144 With prefix arg, the output format gets more cryptic,
145 but still shows the full information."
146 (interactive "P")
147 (help-setup-xref (list #'list-character-sets arg) (interactive-p))
148 (with-output-to-temp-buffer "*Character Set List*"
149 (with-current-buffer standard-output
150 (if arg
151 (list-character-sets-2)
152 ;; Insert header.
153 (insert "Indirectly supported character sets are shown below.\n")
154 (insert
155 (substitute-command-keys
156 (concat "Use "
157 (if (display-mouse-p) "\\[help-follow-mouse] or ")
158 "\\[help-follow]:\n")))
159 (insert " on a column title to sort by that title,")
160 (indent-to 56)
161 (insert "+----DIMENSION\n")
162 (insert " on a charset name to list characters.")
163 (indent-to 56)
164 (insert "| +--CHARS\n")
165 (let ((columns '(("ID-NUM" . id) "\t"
166 ("CHARSET-NAME" . name) "\t\t\t"
167 ("MULTIBYTE-FORM" . id) "\t"
168 ("D CH FINAL-CHAR" . iso-spec)))
169 pos)
170 (while columns
171 (if (stringp (car columns))
172 (insert (car columns))
173 (insert-text-button (car (car columns))
174 :type 'sort-listed-character-sets
175 'sort-key (cdr (car columns)))
176 (goto-char (point-max)))
177 (setq columns (cdr columns)))
178 (insert "\n"))
179 (insert "------\t------------\t\t\t--------------\t- -- ----------\n")
180
181 ;; Insert body sorted by charset IDs.
182 (list-character-sets-1 'id)
183
184 ;; Insert non-directly-supported charsets.
185 (insert-char ?- 72)
186 (insert "\n\nINDIRECTLY SUPPORTED CHARSETS SETS:\n\n"
187 (propertize "CHARSET NAME\tMAPPED TO" 'face 'bold)
188 "\n------------\t---------\n")
189 (dolist (elt non-iso-charset-alist)
190 (insert-text-button (symbol-name (car elt))
191 :type 'list-charset-chars
192 'help-args (list (car elt)))
193 (indent-to 16)
194 (dolist (e (nth 1 elt))
195 (when (>= (+ (current-column) 1 (string-width (symbol-name e)))
196 ;; This is an approximate value. We don't know
197 ;; the correct window width of this buffer yet.
198 78)
199 (insert "\n")
200 (indent-to 16))
201
202 (insert (format "%s " e)))
203 (insert "\n"))))))
204
205 (defun sort-listed-character-sets (sort-key)
206 (if sort-key
207 (save-excursion
208 (help-setup-xref (list #'list-character-sets nil) t)
209 (let ((buffer-read-only nil))
210 (goto-char (point-min))
211 (re-search-forward "[0-9][0-9][0-9]")
212 (beginning-of-line)
213 (let ((pos (point)))
214 (search-forward "----------")
215 (beginning-of-line)
216 (save-restriction
217 (narrow-to-region pos (point))
218 (delete-region (point-min) (point-max))
219 (list-character-sets-1 sort-key)))))))
220
221 (defun charset-multibyte-form-string (charset)
222 (let ((info (charset-info charset)))
223 (cond ((eq charset 'ascii)
224 "xx")
225 ((eq charset 'eight-bit-control)
226 (format "%2X Xx" (aref info 6)))
227 ((eq charset 'eight-bit-graphic)
228 "XX")
229 (t
230 (let ((str (format "%2X" (aref info 6))))
231 (if (> (aref info 7) 0)
232 (setq str (format "%s %2X"
233 str (aref info 7))))
234 (setq str (concat str " XX"))
235 (if (> (aref info 2) 1)
236 (setq str (concat str " XX")))
237 str)))))
238
239 ;; Insert a list of character sets sorted by SORT-KEY. SORT-KEY
240 ;; should be one of `id', `name', and `iso-spec'. If SORT-KEY is nil,
241 ;; it defaults to `id'.
242
243 (defun list-character-sets-1 (sort-key)
244 (or sort-key
245 (setq sort-key 'id))
246 (let ((tail (charset-list))
247 charset-info-list elt charset info sort-func)
248 (while tail
249 (setq charset (car tail) tail (cdr tail)
250 info (charset-info charset))
251
252 ;; Generate a list that contains all information to display.
253 (setq charset-info-list
254 (cons (list (charset-id charset) ; ID-NUM
255 charset ; CHARSET-NAME
256 (charset-multibyte-form-string charset); MULTIBYTE-FORM
257 (aref info 2) ; DIMENSION
258 (aref info 3) ; CHARS
259 (aref info 8) ; FINAL-CHAR
260 )
261 charset-info-list)))
262
263 ;; Determine a predicate for `sort' by SORT-KEY.
264 (setq sort-func
265 (cond ((eq sort-key 'id)
266 (lambda (x y) (< (car x) (car y))))
267
268 ((eq sort-key 'name)
269 (lambda (x y) (string< (nth 1 x) (nth 1 y))))
270
271 ((eq sort-key 'iso-spec)
272 ;; Sort by DIMENSION CHARS FINAL-CHAR
273 (lambda (x y)
274 (or (< (nth 3 x) (nth 3 y))
275 (and (= (nth 3 x) (nth 3 y))
276 (or (< (nth 4 x) (nth 4 y))
277 (and (= (nth 4 x) (nth 4 y))
278 (< (nth 5 x) (nth 5 y))))))))
279 (t
280 (error "Invalid charset sort key: %s" sort-key))))
281
282 (setq charset-info-list (sort charset-info-list sort-func))
283
284 ;; Insert information of character sets.
285 (while charset-info-list
286 (setq elt (car charset-info-list)
287 charset-info-list (cdr charset-info-list))
288 (insert (format "%03d(%02X)" (car elt) (car elt))) ; ID-NUM
289 (indent-to 8)
290 (insert-text-button (symbol-name (nth 1 elt))
291 :type 'list-charset-chars
292 'help-args (list (nth 1 elt)))
293 (goto-char (point-max))
294 (insert "\t")
295 (indent-to 40)
296 (insert (nth 2 elt)) ; MULTIBYTE-FORM
297 (indent-to 56)
298 (insert (format "%d %2d " (nth 3 elt) (nth 4 elt)) ; DIMENSION and CHARS
299 (if (< (nth 5 elt) 0) "none" (nth 5 elt))) ; FINAL-CHAR
300 (insert "\n"))))
301
302
303 ;; List all character sets in a form that a program can easily parse.
304
305 (defun list-character-sets-2 ()
306 (insert "#########################
307 ## LIST OF CHARSETS
308 ## Each line corresponds to one charset.
309 ## The following attributes are listed in this order
310 ## separated by a colon `:' in one line.
311 ## CHARSET-ID,
312 ## CHARSET-SYMBOL-NAME,
313 ## DIMENSION (1 or 2)
314 ## CHARS (94 or 96)
315 ## BYTES (of multibyte form: 1, 2, 3, or 4),
316 ## WIDTH (occupied column numbers: 1 or 2),
317 ## DIRECTION (0:left-to-right, 1:right-to-left),
318 ## ISO-FINAL-CHAR (character code of ISO-2022's final character)
319 ## ISO-GRAPHIC-PLANE (ISO-2022's graphic plane, 0:GL, 1:GR)
320 ## DESCRIPTION (describing string of the charset)
321 ")
322 (let ((l charset-list)
323 charset)
324 (while l
325 (setq charset (car l) l (cdr l))
326 (princ (format "%03d:%s:%d:%d:%d:%d:%d:%d:%d:%s\n"
327 (charset-id charset)
328 charset
329 (charset-dimension charset)
330 (charset-chars charset)
331 (charset-bytes charset)
332 (charset-width charset)
333 (charset-direction charset)
334 (charset-iso-final-char charset)
335 (charset-iso-graphic-plane charset)
336 (charset-description charset))))))
339 337
340 (defun decode-codepage-char (codepage code) 338 (defun decode-codepage-char (codepage code)
341 "Decode a character that has code CODE in CODEPAGE. 339 "Decode a character that has code CODE in CODEPAGE.
342 Return a decoded character string. Each CODEPAGE corresponds to a 340 Return a decoded character string. Each CODEPAGE corresponds to a
343 coding system cpCODEPAGE." 341 coding system cpCODEPAGE."
1304 (while fontsets 1302 (while fontsets
1305 (print-fontset (car fontsets) t) 1303 (print-fontset (car fontsets) t)
1306 (setq fontsets (cdr fontsets))))) 1304 (setq fontsets (cdr fontsets)))))
1307 (print-help-return-message)))) 1305 (print-help-return-message))))
1308 1306
1307 (provide 'mule-diag)
1308
1309 ;;; mule-diag.el ends here 1309 ;;; mule-diag.el ends here