Mercurial > emacs

comparison lisp/international/mule-diag.el @ 88534:27fb0f57ffe3

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Doc fixes. (sort-charset-list, charset-multibyte-form-string): Removed. (list-character-sets, list-character-sets-1) (list-character-sets-2): Re-written. (non-iso-charset-alist): Set to nil and made obsolete. (decode-codepage-char): Re-written and made obsolete. (read-charset, describe-character-set): Don't use non-iso-charset-alist. (describe-coding-system): Use keyword properties.
author Dave Love <fx@gnu.org>
date Thu, 16 May 2002 19:23:55 +0000
parents 524f9b5b2ac5
children 4668340a1e0d
comparison
equal deleted inserted replaced
88533:3348b18fc9a7 88534:27fb0f57ffe3
33 ;; Make sure the help-xref button type is defined. 33 ;; Make sure the help-xref button type is defined.
34 (require 'help-fns) 34 (require 'help-fns)
35 35
36 ;;; General utility function 36 ;;; General utility function
37 37
38 ;; Print all arguments with single space separator in one line.
39 (defun print-list (&rest args) 38 (defun print-list (&rest args)
39 "Print all arguments with single space separator in one line."
40 (while (cdr args) 40 (while (cdr args)
41 (when (car args) 41 (when (car args)
42 (princ (car args)) 42 (princ (car args))
43 (princ " ")) 43 (princ " "))
44 (setq args (cdr args))) 44 (setq args (cdr args)))
45 (princ (car args)) 45 (princ (car args))
46 (princ "\n")) 46 (princ "\n"))
47
48 ;; Re-order the elements of charset-list.
49 (defun sort-charset-list ()
50 (setq charset-list
51 (sort charset-list
52 (function (lambda (x y) (< (charset-id x) (charset-id y)))))))
53 47
54 ;;; CHARSET 48 ;;; CHARSET
55 49
56 (define-button-type 'sort-listed-character-sets 50 (define-button-type 'sort-listed-character-sets
57 'help-echo (purecopy "mouse-2, RET: sort on this column") 51 'help-echo (purecopy "mouse-2, RET: sort on this column")
96 (substitute-command-keys 90 (substitute-command-keys
97 (concat "Use " 91 (concat "Use "
98 (if (display-mouse-p) "\\[help-follow-mouse] or ") 92 (if (display-mouse-p) "\\[help-follow-mouse] or ")
99 "\\[help-follow]:\n"))) 93 "\\[help-follow]:\n")))
100 (insert " on a column title to sort by that title,") 94 (insert " on a column title to sort by that title,")
101 (indent-to 56) 95 (indent-to 48)
102 (insert "+----DIMENSION\n") 96 (insert "+----DIMENSION\n")
103 (insert " on a charset name to list characters.") 97 (insert " on a charset name to list characters.")
104 (indent-to 56) 98 (indent-to 48)
105 (insert "| +--CHARS\n") 99 (insert "| +--CHARS\n")
106 (let ((columns '(("ID-NUM" . id) "\t" 100 (let ((columns '(("CHARSET-NAME" . name) "\t\t\t\t\t"
107 ("CHARSET-NAME" . name) "\t\t\t" 101 ("D CH FINAL-CHAR" . iso-spec)))
108 ("MULTIBYTE-FORM" . id) "\t"
109 ("D CH FINAL-CHAR" . iso-spec)))
110 pos) 102 pos)
111 (while columns 103 (while columns
112 (if (stringp (car columns)) 104 (if (stringp (car columns))
113 (insert (car columns)) 105 (insert (car columns))
114 (insert-text-button (car (car columns)) 106 (insert-text-button (car (car columns))
115 :type 'sort-listed-character-sets 107 :type 'sort-listed-character-sets
116 'sort-key (cdr (car columns))) 108 'sort-key (cdr (car columns)))
117 (goto-char (point-max))) 109 (goto-char (point-max)))
118 (setq columns (cdr columns))) 110 (setq columns (cdr columns)))
119 (insert "\n")) 111 (insert "\n"))
120 (insert "------\t------------\t\t\t--------------\t- -- ----------\n") 112 (insert "------------\t\t\t\t\t- --- ----------\n")
121 113
122 ;; Insert body sorted by charset IDs. 114 ;; Insert body sorted by charset IDs.
123 (list-character-sets-1 'id))))) 115 (list-character-sets-1 'name)))))
124 116
125 (defun sort-listed-character-sets (sort-key) 117 (defun sort-listed-character-sets (sort-key)
126 (if sort-key 118 (if sort-key
127 (save-excursion 119 (save-excursion
128 (help-setup-xref (list #'list-character-sets nil) t) 120 (help-setup-xref (list #'list-character-sets nil) t)
131 (re-search-forward "[0-9][0-9][0-9]") 123 (re-search-forward "[0-9][0-9][0-9]")
132 (beginning-of-line) 124 (beginning-of-line)
133 (delete-region (point) (point-max)) 125 (delete-region (point) (point-max))
134 (list-character-sets-1 sort-key))))) 126 (list-character-sets-1 sort-key)))))
135 127
136 (defun charset-multibyte-form-string (charset)
137 (let ((info (charset-info charset)))
138 (cond ((eq charset 'ascii)
139 "xx")
140 ((eq charset 'eight-bit-control)
141 (format "%2X Xx" (aref info 6)))
142 ((eq charset 'eight-bit-graphic)
143 "XX")
144 (t
145 (let ((str (format "%2X" (aref info 6))))
146 (if (> (aref info 7) 0)
147 (setq str (format "%s %2X"
148 str (aref info 7))))
149 (setq str (concat str " XX"))
150 (if (> (aref info 2) 1)
151 (setq str (concat str " XX")))
152 str)))))
153
154 ;; Insert a list of character sets sorted by SORT-KEY. SORT-KEY
155 ;; should be one of `id', `name', and `iso-spec'. If SORT-KEY is nil,
156 ;; it defaults to `id'.
157
158 (defun list-character-sets-1 (sort-key) 128 (defun list-character-sets-1 (sort-key)
129 "Insert a list of character sets sorted by SORT-KEY.
130 SORT-KEY should be `name' or `iso-spec' (default `name')."
159 (or sort-key 131 (or sort-key
160 (setq sort-key 'id)) 132 (setq sort-key 'name))
161 (let ((tail (charset-list)) 133 (let ((tail charset-list)
162 charset-info-list elt charset info sort-func) 134 charset-info-list charset sort-func)
163 (while tail 135 (dolist (charset charset-list)
164 (setq charset (car tail) tail (cdr tail)
165 info (charset-info charset))
166
167 ;; Generate a list that contains all information to display. 136 ;; Generate a list that contains all information to display.
168 (setq charset-info-list 137 (push (list charset
169 (cons (list (charset-id charset) ; ID-NUM 138 (charset-dimension charset)
170 charset ; CHARSET-NAME 139 (charset-chars charset)
171 (charset-multibyte-form-string charset); MULTIBYTE-FORM 140 (charset-iso-final-char charset))
172 (aref info 2) ; DIMENSION 141 charset-info-list))
173 (aref info 3) ; CHARS
174 (aref info 8) ; FINAL-CHAR
175 )
176 charset-info-list)))
177 142
178 ;; Determine a predicate for `sort' by SORT-KEY. 143 ;; Determine a predicate for `sort' by SORT-KEY.
179 (setq sort-func 144 (setq sort-func
180 (cond ((eq sort-key 'id) 145 (cond ((eq sort-key 'name)
181 (function (lambda (x y) (< (car x) (car y))))) 146 (lambda (x y) (string< (car x) (car y))))
182
183 ((eq sort-key 'name)
184 (function (lambda (x y) (string< (nth 1 x) (nth 1 y)))))
185 147
186 ((eq sort-key 'iso-spec) 148 ((eq sort-key 'iso-spec)
187 ;; Sort by DIMENSION CHARS FINAL-CHAR 149 ;; Sort by DIMENSION CHARS FINAL-CHAR
188 (function 150 (function
189 (lambda (x y) 151 (lambda (x y)
190 (or (< (nth 3 x) (nth 3 y)) 152 (or (< (nth 1 x) (nth 1 y))
191 (and (= (nth 3 x) (nth 3 y)) 153 (and (= (nth 1 x) (nth 1 y))
192 (or (< (nth 4 x) (nth 4 y)) 154 (or (< (nth 2 x) (nth 2 y))
193 (and (= (nth 4 x) (nth 4 y)) 155 (and (= (nth 2 x) (nth 2 y))
194 (< (nth 5 x) (nth 5 y))))))))) 156 (< (nth 3 x) (nth 3 y)))))))))
195 (t 157 (t
196 (error "Invalid charset sort key: %s" sort-key)))) 158 (error "Invalid charset sort key: %s" sort-key))))
197 159
198 (setq charset-info-list (sort charset-info-list sort-func)) 160 (setq charset-info-list (sort charset-info-list sort-func))
199 161
200 ;; Insert information of character sets. 162 ;; Insert information of character sets.
201 (while charset-info-list 163 (while charset-info-list
202 (setq elt (car charset-info-list) 164 (setq elt (car charset-info-list)
203 charset-info-list (cdr charset-info-list)) 165 charset-info-list (cdr charset-info-list))
204 (insert (format "%03d(%02X)" (car elt) (car elt))) ; ID-NUM 166 (insert-text-button (symbol-name (car elt))
205 (indent-to 8)
206 (insert-text-button (symbol-name (nth 1 elt))
207 :type 'list-charset-chars 167 :type 'list-charset-chars
208 'help-args (list (nth 1 elt))) 168 'help-args (list (car elt)))
209 (goto-char (point-max)) 169 (goto-char (point-max))
210 (insert "\t") 170 (insert "\t")
211 (indent-to 40) 171 ;; (indent-to 40)
212 (insert (nth 2 elt)) ; MULTIBYTE-FORM 172 ;; (insert (nth 2 elt)) ; MULTIBYTE-FORM
213 (indent-to 56) 173 (indent-to 48)
214 (insert (format "%d %2d " (nth 3 elt) (nth 4 elt)) ; DIMENSION and CHARS 174 (insert (format "%d %3d " (nth 1 elt) (nth 2 elt)) ; DIMENSION and CHARS
215 (if (< (nth 5 elt) 0) "none" (nth 5 elt))) ; FINAL-CHAR 175 (if (< (nth 3 elt) 0)
176 "none"
177 (nth 3 elt))) ; FINAL-CHAR
216 (insert "\n")))) 178 (insert "\n"))))
217 179
218 180
219 ;; List all character sets in a form that a program can easily parse. 181 ;; List all character sets in a form that a program can easily parse.
220 182
222 (insert "######################### 184 (insert "#########################
223 ## LIST OF CHARSETS 185 ## LIST OF CHARSETS
224 ## Each line corresponds to one charset. 186 ## Each line corresponds to one charset.
225 ## The following attributes are listed in this order 187 ## The following attributes are listed in this order
226 ## separated by a colon `:' in one line. 188 ## separated by a colon `:' in one line.
227 ## CHARSET-ID,
228 ## CHARSET-SYMBOL-NAME, 189 ## CHARSET-SYMBOL-NAME,
229 ## DIMENSION (1 or 2) 190 ## DIMENSION (1 or 2)
230 ## CHARS (94 or 96) 191 ## CHARS (94 or 96)
231 ## BYTES (of multibyte form: 1, 2, 3, or 4),
232 ## WIDTH (occupied column numbers: 1 or 2), 192 ## WIDTH (occupied column numbers: 1 or 2),
233 ## DIRECTION (0:left-to-right, 1:right-to-left), 193 ## DIRECTION (0:left-to-right, 1:right-to-left),
234 ## ISO-FINAL-CHAR (character code of ISO-2022's final character) 194 ## ISO-FINAL-CHAR (character code of ISO-2022's final character)
235 ## ISO-GRAPHIC-PLANE (ISO-2022's graphic plane, 0:GL, 1:GR) 195 ## ISO-GRAPHIC-PLANE (ISO-2022's graphic plane, 0:GL, 1:GR)
236 ## DESCRIPTION (describing string of the charset) 196 ## DESCRIPTION (describing string of the charset)
237 ") 197 ")
238 (let ((l charset-list) 198 (let ((l charset-list)
239 charset) 199 charset)
240 (while l 200 (while l
241 (setq charset (car l) l (cdr l)) 201 (setq charset (car l) l (cdr l))
242 (princ (format "%03d:%s:%d:%d:%d:%d:%d:%d:%d:%s\n" 202 (princ (format "%s:%d:%d:%d:%d:%s\n"
243 (charset-id charset)
244 charset 203 charset
245 (charset-dimension charset) 204 (charset-dimension charset)
246 (charset-chars charset) 205 (charset-chars charset)
247 (charset-bytes charset) 206 (charset-bytes charset)
248 (charset-width charset) 207 (aref char-width-table (make-char charset))
249 (charset-direction charset) 208 ;;; (charset-direction charset)
250 (charset-iso-final-char charset) 209 (charset-iso-final-char charset)
251 (charset-iso-graphic-plane charset) 210 ;;; (charset-iso-graphic-plane charset)
252 (charset-description charset)))))) 211 (charset-description charset))))))
253 212
254 (defvar non-iso-charset-alist 213 (defvar non-iso-charset-alist nil
255 `((mac-roman 214 "Obsolete.")
256 nil 215 (make-obsolete-variable 'non-iso-charset-alist "no longer relevant" "22.1")
257 mac-roman-decoder
258 ((0 255)))
259 (viscii
260 (ascii vietnamese-viscii-lower vietnamese-viscii-upper)
261 viet-viscii-nonascii-translation-table
262 ((0 255)))
263 (koi8-r
264 (ascii cyrillic-iso8859-5)
265 cyrillic-koi8-r-nonascii-translation-table
266 ((32 255)))
267 (alternativnyj
268 (ascii cyrillic-iso8859-5)
269 cyrillic-alternativnyj-nonascii-translation-table
270 ((32 255)))
271 (big5
272 (ascii chinese-big5-1 chinese-big5-2)
273 decode-big5-char
274 ((32 127)
275 ((?\xA1 ?\xFE) . (?\x40 ?\x7E ?\xA1 ?\xFE))))
276 (sjis
277 (ascii katakana-jisx0201 japanese-jisx0208)
278 decode-sjis-char
279 ((32 127 ?\xA1 ?\xDF)
280 ((?\x81 ?\x9F ?\xE0 ?\xEF) . (?\x40 ?\x7E ?\x80 ?\xFC)))))
281 "Alist of charset names vs the corresponding information.
282 This is mis-named for historical reasons. The charsets are actually
283 non-built-in ones. They correspond to Emacs coding systems, not Emacs
284 charsets, i.e. what Emacs can read (or write) by mapping to (or
285 from) Emacs internal charsets that typically correspond to a limited
286 set of ISO charsets.
287
288 Each element has the following format:
289 (CHARSET CHARSET-LIST TRANSLATION-METHOD [ CODE-RANGE ])
290
291 CHARSET is the name (symbol) of the charset.
292
293 CHARSET-LIST is a list of Emacs charsets into which characters of
294 CHARSET are mapped.
295
296 TRANSLATION-METHOD is a translation table (symbol) to translate a
297 character code of CHARSET to the corresponding Emacs character
298 code. It can also be a function to call with one argument, a
299 character code in CHARSET.
300
301 CODE-RANGE specifies the valid code ranges of CHARSET.
302 It is a list of RANGEs, where each RANGE is of the form:
303 (FROM1 TO1 FROM2 TO2 ...)
304 or
305 ((FROM1-1 TO1-1 FROM1-2 TO1-2 ...) . (FROM2-1 TO2-1 FROM2-2 TO2-2 ...))
306 In the first form, valid codes are between FROM1 and TO1, or FROM2 and
307 TO2, or...
308 The second form is used for 2-byte codes. The car part is the ranges
309 of the first byte, and the cdr part is the ranges of the second byte.")
310
311 216
312 (defun decode-codepage-char (codepage code) 217 (defun decode-codepage-char (codepage code)
313 "Decode a character that has code CODE in CODEPAGE. 218 "Decode a character that has code CODE in CODEPAGE.
314 Return a decoded character string. Each CODEPAGE corresponds to a 219 Return a decoded character string. Each CODEPAGE corresponds to a
315 coding system cpCODEPAGE." 220 coding system cpCODEPAGE. This function is obsolete."
316 (let ((coding-system (intern (format "cp%d" codepage)))) 221 (decode-char (intern (format "cp%d" codepage)) code))
317 (or (coding-system-p coding-system) 222 (make-obsolete 'decode-codepage-char 'decode-char "22.1")
318 (codepage-setup codepage))
319 (string-to-char
320 (decode-coding-string (char-to-string code) coding-system))))
321
322
323 ;; Add DOS codepages to `non-iso-charset-alist'.
324
325 (let ((tail (cp-supported-codepages))
326 elt)
327 (while tail
328 (setq elt (car tail) tail (cdr tail))
329 ;; Now ELT is (CODEPAGE . CHARSET), where CODEPAGE is a string
330 ;; (e.g. "850"), CHARSET is a charset that characters in CODEPAGE
331 ;; are mapped to.
332 (unless (assq (intern (concat "cp" (car elt))) non-iso-charset-alist)
333 (setq non-iso-charset-alist
334 (cons (list (intern (concat "cp" (car elt)))
335 (list 'ascii (cdr elt))
336 `(lambda (code)
337 (decode-codepage-char ,(string-to-int (car elt))
338 code))
339 (list (list 0 255)))
340 non-iso-charset-alist)))))
341
342 223
343 ;; A variable to hold charset input history. 224 ;; A variable to hold charset input history.
344 (defvar charset-history nil) 225 (defvar charset-history nil)
345 226
346 227
347 ;;;###autoload 228 ;;;###autoload
348 (defun read-charset (prompt &optional default-value initial-input) 229 (defun read-charset (prompt &optional default-value initial-input)
349 "Read a character set from the minibuffer, prompting with string PROMPT. 230 "Read a character set from the minibuffer, prompting with string PROMPT.
350 It must be an Emacs character set listed in the variable `charset-list' 231 It must be an Emacs character set listed in the variable `charset-list'.
351 or a non-ISO character set listed in the variable
352 `non-iso-charset-alist'.
353 232
354 Optional arguments are DEFAULT-VALUE and INITIAL-INPUT. 233 Optional arguments are DEFAULT-VALUE and INITIAL-INPUT.
355 DEFAULT-VALUE, if non-nil, is the default value. 234 DEFAULT-VALUE, if non-nil, is the default value.
356 INITIAL-INPUT, if non-nil, is a string inserted in the minibuffer initially. 235 INITIAL-INPUT, if non-nil, is a string inserted in the minibuffer initially.
357 See the documentation of the function `completing-read' for the 236 See the documentation of the function `completing-read' for the
358 detailed meanings of these arguments." 237 detailed meanings of these arguments."
359 (let* ((table (append (mapcar (function (lambda (x) (list (symbol-name x)))) 238 (let* ((table (mapcar (lambda (x) (list (symbol-name x))) charset-list))
360 charset-list)
361 (mapcar (function (lambda (x)
362 (list (symbol-name (car x)))))
363 non-iso-charset-alist)))
364 (charset (completing-read prompt table 239 (charset (completing-read prompt table
365 nil t initial-input 'charset-history 240 nil t initial-input 'charset-history
366 default-value))) 241 default-value)))
367 (if (> (length charset) 0) 242 (if (> (length charset) 0)
368 (intern charset)))) 243 (intern charset))))
485 (setq row (1+ row))))))))) 360 (setq row (1+ row)))))))))
486 361
487 362
488 ;;;###autoload 363 ;;;###autoload
489 (defun list-charset-chars (charset) 364 (defun list-charset-chars (charset)
490 "Display a list of characters in the specified character set. 365 "Display a list of characters in character set CHARSET.
491 This can list both Emacs `official' (ISO standard) charsets and the 366 This can list both Emacs `official' (ISO standard) charsets and the
492 characters encoded by various Emacs coding systems which correspond to 367 characters encoded by various Emacs coding systems which correspond to
493 PC `codepages' and other coded character sets. See `non-iso-charset-alist'." 368 PC `codepages' and other coded character sets."
494 (interactive (list (read-charset "Character set: "))) 369 (interactive (list (read-charset "Character set: ")))
495 (with-output-to-temp-buffer "*Help*" 370 (with-output-to-temp-buffer "*Help*"
496 (with-current-buffer standard-output 371 (with-current-buffer standard-output
497 (setq indent-tabs-mode nil) 372 (setq indent-tabs-mode nil)
498 (set-buffer-multibyte t) 373 (set-buffer-multibyte t)
499 (cond ((charsetp charset) 374 (cond ((charsetp charset)
500 (list-iso-charset-chars charset)) 375 (list-iso-charset-chars charset))
501 ((assq charset non-iso-charset-alist)
502 (list-non-iso-charset-chars charset))
503 (t 376 (t
504 (error "Invalid character set %s" charset)))))) 377 (error "Invalid character set %s" charset))))))
505 378
506 379
507 ;;;###autoload 380 ;;;###autoload
508 (defun describe-character-set (charset) 381 (defun describe-character-set (charset)
509 "Display information about built-in character set CHARSET." 382 "Display information about built-in character set CHARSET."
510 (interactive (list (let ((non-iso-charset-alist nil)) 383 (interactive (list (read-charset "Charset: ")))
511 (read-charset "Charset: "))))
512 (or (charsetp charset) 384 (or (charsetp charset)
513 (error "Invalid charset: %S" charset)) 385 (error "Invalid charset: %S" charset))
514 (let ((info (charset-info charset))) 386 (let ((info (charset-info charset)))
515 (help-setup-xref (list #'describe-character-set charset) (interactive-p)) 387 (help-setup-xref (list #'describe-character-set charset) (interactive-p))
516 (with-output-to-temp-buffer (help-buffer) 388 (with-output-to-temp-buffer (help-buffer)
691 (aset gr i (list t)))))) 563 (aset gr i (list t))))))
692 (dolist (elt request) 564 (dolist (elt request)
693 (let ((reg (cdr elt))) 565 (let ((reg (cdr elt)))
694 (nconc (aref gr reg) (list (car elt))))) 566 (nconc (aref gr reg) (list (car elt)))))
695 (dotimes (i 4) 567 (dotimes (i 4)
568 ;; Fixme:
696 (setq charset (aref flags graphic-register)) 569 (setq charset (aref flags graphic-register))
697 (princ (format 570 (princ (format
698 " G%d -- %s\n" 571 " G%d -- %s\n"
699 i 572 i
700 (cond ((null charset) 573 (cond ((null charset)
745 (help-setup-xref (list #'describe-coding-system coding-system) 618 (help-setup-xref (list #'describe-coding-system coding-system)
746 (interactive-p)) 619 (interactive-p))
747 (with-output-to-temp-buffer (help-buffer) 620 (with-output-to-temp-buffer (help-buffer)
748 (print-coding-system-briefly coding-system 'doc-string) 621 (print-coding-system-briefly coding-system 'doc-string)
749 (let* ((type (coding-system-type coding-system)) 622 (let* ((type (coding-system-type coding-system))
750 (extra-spec (coding-system-extra-spec coding-system))) 623 ;; Fixme: use this
624 (extra-spec (coding-system-plist coding-system)))
751 (princ "Type: ") 625 (princ "Type: ")
752 (princ type) 626 (princ type)
753 (cond ((eq type 'undecided) 627 (cond ((eq type 'undecided)
754 (princ " (do automatic conversion)")) 628 (princ " (do automatic conversion)"))
755 ((eq type 'utf-8) 629 ((eq type 'utf-8)
778 (princ "\n")) 652 (princ "\n"))
779 ((or (null eol-type) (eq eol-type 0)) (princ "LF\n")) 653 ((or (null eol-type) (eq eol-type 0)) (princ "LF\n"))
780 ((eq eol-type 1) (princ "CRLF\n")) 654 ((eq eol-type 1) (princ "CRLF\n"))
781 ((eq eol-type 2) (princ "CR\n")) 655 ((eq eol-type 2) (princ "CR\n"))
782 (t (princ "invalid\n"))))) 656 (t (princ "invalid\n")))))
783 (let ((postread (coding-system-get coding-system 'post-read-conversion))) 657 (let ((postread (coding-system-get coding-system :post-read-conversion)))
784 (when postread 658 (when postread
785 (princ "After decoding text normally,") 659 (princ "After decoding text normally,")
786 (princ " perform post-conversion using the function: ") 660 (princ " perform post-conversion using the function: ")
787 (princ "\n ") 661 (princ "\n ")
788 (princ postread) 662 (princ postread)
789 (princ "\n"))) 663 (princ "\n")))
790 (let ((prewrite (coding-system-get coding-system 'pre-write-conversion))) 664 (let ((prewrite (coding-system-get coding-system :pre-write-conversion)))
791 (when prewrite 665 (when prewrite
792 (princ "Before encoding text normally,") 666 (princ "Before encoding text normally,")
793 (princ " perform pre-conversion using the function: ") 667 (princ " perform pre-conversion using the function: ")
794 (princ "\n ") 668 (princ "\n ")
795 (princ prewrite) 669 (princ prewrite)
796 (princ "\n"))) 670 (princ "\n")))
797 (with-current-buffer standard-output 671 (with-current-buffer standard-output
798 (let ((charsets (coding-system-get coding-system 'safe-charsets))) 672 (let ((charsets (coding-system-get coding-system :charset-list)))
799 (when (and (not (memq (coding-system-base coding-system) 673 (when (and (not (memq (coding-system-base coding-system)
800 '(raw-text emacs-mule))) 674 '(raw-text emacs-mule)))
801 charsets) 675 charsets)
802 (if (eq charsets t) 676 (if (eq charsets t)
803 (insert "This coding system can encode all charsets except for 677 (insert "This coding system can encode all charsets except for
855 (coding-system-eol-type-mnemonic (car default-process-coding-system)) 729 (coding-system-eol-type-mnemonic (car default-process-coding-system))
856 (coding-system-mnemonic (cdr default-process-coding-system)) 730 (coding-system-mnemonic (cdr default-process-coding-system))
857 (coding-system-eol-type-mnemonic (cdr default-process-coding-system)) 731 (coding-system-eol-type-mnemonic (cdr default-process-coding-system))
858 ))) 732 )))
859 733
860 ;; Print symbol name and mnemonic letter of CODING-SYSTEM with `princ'.
861 (defun print-coding-system-briefly (coding-system &optional doc-string) 734 (defun print-coding-system-briefly (coding-system &optional doc-string)
735 "Print symbol name and mnemonic letter of CODING-SYSTEM with `princ'."
862 (if (not coding-system) 736 (if (not coding-system)
863 (princ "nil\n") 737 (princ "nil\n")
864 (princ (format "%c -- %s" 738 (princ (format "%c -- %s"
865 (coding-system-mnemonic coding-system) 739 (coding-system-mnemonic coding-system)
866 coding-system)) 740 coding-system))
912 (dolist (elt (coding-system-priority-list)) 786 (dolist (elt (coding-system-priority-list))
913 (princ (format " %d. %s " i elt)) 787 (princ (format " %d. %s " i elt))
914 (let ((aliases (coding-system-aliases elt))) 788 (let ((aliases (coding-system-aliases elt)))
915 (if (eq elt (car aliases)) 789 (if (eq elt (car aliases))
916 (if (cdr aliases) 790 (if (cdr aliases)
791 ;; Fixme:
917 (princ (cons 'alias: (cdr base-aliases)))) 792 (princ (cons 'alias: (cdr base-aliases))))
918 (princ (list 'alias 'of (car aliases)))) 793 (princ (list 'alias 'of (car aliases))))
919 (terpri) 794 (terpri)
920 (setq i (1+ i))))) 795 (setq i (1+ i)))))
921 796
975 (funcall func "File I/O" file-coding-system-alist) 850 (funcall func "File I/O" file-coding-system-alist)
976 (funcall func "Process I/O" process-coding-system-alist) 851 (funcall func "Process I/O" process-coding-system-alist)
977 (funcall func "Network I/O" network-coding-system-alist)) 852 (funcall func "Network I/O" network-coding-system-alist))
978 (help-mode)))) 853 (help-mode))))
979 854
980 ;; Print detailed information on CODING-SYSTEM.
981 (defun print-coding-system (coding-system) 855 (defun print-coding-system (coding-system)
856 "Print detailed information on CODING-SYSTEM."
982 (let ((type (coding-system-type coding-system)) 857 (let ((type (coding-system-type coding-system))
983 (eol-type (coding-system-eol-type coding-system)) 858 (eol-type (coding-system-eol-type coding-system))
984 (flags (coding-system-flags coding-system)) 859 (flags (coding-system-flags coding-system))
985 (aliases (coding-system-get coding-system 'alias-coding-systems))) 860 (aliases (coding-system-get coding-system 'alias-coding-systems)))
986 (if (not (eq (car aliases) coding-system)) 861 (if (not (eq (car aliases) coding-system))
1110 (princ (format "%s:%s\n" (car l) (symbol-value (car l)))) 985 (princ (format "%s:%s\n" (car l) (symbol-value (car l))))
1111 (setq l (cdr l)))))) 986 (setq l (cdr l))))))
1112 987
1113 ;;; FONT 988 ;;; FONT
1114 989
1115 ;; Print information of a font in FONTINFO.
1116 (defun describe-font-internal (font-info &optional verbose) 990 (defun describe-font-internal (font-info &optional verbose)
991 "Print information about a font in FONT-INFO."
1117 (print-list "name (opened by):" (aref font-info 0)) 992 (print-list "name (opened by):" (aref font-info 0))
1118 (print-list " full name:" (aref font-info 1)) 993 (print-list " full name:" (aref font-info 1))
1119 (print-list " size:" (format "%2d" (aref font-info 2))) 994 (print-list " size:" (format "%2d" (aref font-info 2)))
1120 (print-list " height:" (format "%2d" (aref font-info 3))) 995 (print-list " height:" (format "%2d" (aref font-info 3)))
1121 (print-list " baseline-offset:" (format "%2d" (aref font-info 4))) 996 (print-list " baseline-offset:" (format "%2d" (aref font-info 4)))