46 |
(defun sort-charset-list () |
(defun sort-charset-list () |
47 |
(setq charset-list |
(setq charset-list |
48 |
(sort charset-list |
(sort charset-list |
49 |
(function (lambda (x y) (< (charset-id x) (charset-id y))))))) |
(lambda (x y) (< (charset-id x) (charset-id y)))))) |
50 |
|
|
51 |
;;; CHARSET |
;;; CHARSET |
52 |
|
|
61 |
'help-function #'list-charset-chars |
'help-function #'list-charset-chars |
62 |
'help-echo "mouse-2, RET: show table of characters for this character set") |
'help-echo "mouse-2, RET: show table of characters for this character set") |
63 |
|
|
64 |
|
(defvar non-iso-charset-alist |
65 |
|
`((mac-roman |
66 |
|
(ascii latin-iso8859-1 mule-unicode-2500-33ff |
67 |
|
mule-unicode-0100-24ff mule-unicode-e000-ffff) |
68 |
|
mac-roman-decoder |
69 |
|
((0 255))) |
70 |
|
(viscii |
71 |
|
(ascii vietnamese-viscii-lower vietnamese-viscii-upper) |
72 |
|
viet-viscii-nonascii-translation-table |
73 |
|
((0 255))) |
74 |
|
(vietnamese-tcvn |
75 |
|
(ascii vietnamese-viscii-lower vietnamese-viscii-upper) |
76 |
|
viet-tcvn-nonascii-translation-table |
77 |
|
((0 255))) |
78 |
|
(koi8-r |
79 |
|
(ascii cyrillic-iso8859-5) |
80 |
|
cyrillic-koi8-r-nonascii-translation-table |
81 |
|
((32 255))) |
82 |
|
(alternativnyj |
83 |
|
(ascii cyrillic-iso8859-5) |
84 |
|
cyrillic-alternativnyj-nonascii-translation-table |
85 |
|
((32 255))) |
86 |
|
(koi8-u |
87 |
|
(ascii cyrillic-iso8859-5 mule-unicode-0100-24ff) |
88 |
|
cyrillic-koi8-u-nonascii-translation-table |
89 |
|
((32 255))) |
90 |
|
(big5 |
91 |
|
(ascii chinese-big5-1 chinese-big5-2) |
92 |
|
decode-big5-char |
93 |
|
((32 127) |
94 |
|
((?\xA1 ?\xFE) . (?\x40 ?\x7E ?\xA1 ?\xFE)))) |
95 |
|
(sjis |
96 |
|
(ascii katakana-jisx0201 japanese-jisx0208) |
97 |
|
decode-sjis-char |
98 |
|
((32 127 ?\xA1 ?\xDF) |
99 |
|
((?\x81 ?\x9F ?\xE0 ?\xEF) . (?\x40 ?\x7E ?\x80 ?\xFC))))) |
100 |
|
"Alist of charset names vs the corresponding information. |
101 |
|
This is mis-named for historical reasons. The charsets are actually |
102 |
|
non-built-in ones. They correspond to Emacs coding systems, not Emacs |
103 |
|
charsets, i.e. what Emacs can read (or write) by mapping to (or |
104 |
|
from) Emacs internal charsets that typically correspond to a limited |
105 |
|
set of ISO charsets. |
106 |
|
|
107 |
|
Each element has the following format: |
108 |
|
(CHARSET CHARSET-LIST TRANSLATION-METHOD [ CODE-RANGE ]) |
109 |
|
|
110 |
|
CHARSET is the name (symbol) of the charset. |
111 |
|
|
112 |
|
CHARSET-LIST is a list of Emacs charsets into which characters of |
113 |
|
CHARSET are mapped. |
114 |
|
|
115 |
|
TRANSLATION-METHOD is a translation table (symbol) to translate a |
116 |
|
character code of CHARSET to the corresponding Emacs character |
117 |
|
code. It can also be a function to call with one argument, a |
118 |
|
character code in CHARSET. |
119 |
|
|
120 |
|
CODE-RANGE specifies the valid code ranges of CHARSET. |
121 |
|
It is a list of RANGEs, where each RANGE is of the form: |
122 |
|
(FROM1 TO1 FROM2 TO2 ...) |
123 |
|
or |
124 |
|
((FROM1-1 TO1-1 FROM1-2 TO1-2 ...) . (FROM2-1 TO2-1 FROM2-2 TO2-2 ...)) |
125 |
|
In the first form, valid codes are between FROM1 and TO1, or FROM2 and |
126 |
|
TO2, or... |
127 |
|
The second form is used for 2-byte codes. The car part is the ranges |
128 |
|
of the first byte, and the cdr part is the ranges of the second byte.") |
129 |
|
|
130 |
;;;###autoload |
;;;###autoload |
131 |
(defun list-character-sets (arg) |
(defun list-character-sets (arg) |
149 |
but still shows the full information." |
but still shows the full information." |
150 |
(interactive "P") |
(interactive "P") |
151 |
(help-setup-xref (list #'list-character-sets arg) (interactive-p)) |
(help-setup-xref (list #'list-character-sets arg) (interactive-p)) |
152 |
(with-output-to-temp-buffer (help-buffer) |
(with-output-to-temp-buffer "*Character Set List*" |
153 |
(with-current-buffer standard-output |
(with-current-buffer standard-output |
154 |
(if arg |
(if arg |
155 |
(list-character-sets-2) |
(list-character-sets-2) |
156 |
;; Insert header. |
;; Insert header. |
157 |
|
(insert "Indirectly supported character sets are shown below.\n") |
158 |
(insert |
(insert |
159 |
(substitute-command-keys |
(substitute-command-keys |
160 |
(concat "Use " |
(concat "Use " |
183 |
(insert "------\t------------\t\t\t--------------\t- -- ----------\n") |
(insert "------\t------------\t\t\t--------------\t- -- ----------\n") |
184 |
|
|
185 |
;; Insert body sorted by charset IDs. |
;; Insert body sorted by charset IDs. |
186 |
(list-character-sets-1 'id))))) |
(list-character-sets-1 'id) |
187 |
|
|
188 |
|
;; Insert non-directly-supported charsets. |
189 |
|
(insert-char ?- 72) |
190 |
|
(insert "\n\nINDIRECTLY SUPPORTED CHARSETS SETS:\n\n" |
191 |
|
(propertize "CHARSET NAME\tMAPPED TO" 'face 'bold) |
192 |
|
"\n------------\t---------\n") |
193 |
|
(dolist (elt non-iso-charset-alist) |
194 |
|
(insert-text-button (symbol-name (car elt)) |
195 |
|
:type 'list-charset-chars |
196 |
|
'help-args (list (car elt))) |
197 |
|
(indent-to 16) |
198 |
|
(dolist (e (nth 1 elt)) |
199 |
|
(when (>= (+ (current-column) 1 (string-width (symbol-name e))) |
200 |
|
;; This is an approximate value. We don't know |
201 |
|
;; the correct window width of this buffer yet. |
202 |
|
78) |
203 |
|
(insert "\n") |
204 |
|
(indent-to 16)) |
205 |
|
|
206 |
|
(insert (format "%s " e))) |
207 |
|
(insert "\n")))))) |
208 |
|
|
209 |
(defun sort-listed-character-sets (sort-key) |
(defun sort-listed-character-sets (sort-key) |
210 |
(if sort-key |
(if sort-key |
214 |
(goto-char (point-min)) |
(goto-char (point-min)) |
215 |
(re-search-forward "[0-9][0-9][0-9]") |
(re-search-forward "[0-9][0-9][0-9]") |
216 |
(beginning-of-line) |
(beginning-of-line) |
217 |
(delete-region (point) (point-max)) |
(let ((pos (point))) |
218 |
(list-character-sets-1 sort-key))))) |
(search-forward "----------") |
219 |
|
(beginning-of-line) |
220 |
|
(save-restriction |
221 |
|
(narrow-to-region pos (point)) |
222 |
|
(delete-region (point-min) (point-max)) |
223 |
|
(list-character-sets-1 sort-key))))))) |
224 |
|
|
225 |
(defun charset-multibyte-form-string (charset) |
(defun charset-multibyte-form-string (charset) |
226 |
(let ((info (charset-info charset))) |
(let ((info (charset-info charset))) |
267 |
;; Determine a predicate for `sort' by SORT-KEY. |
;; Determine a predicate for `sort' by SORT-KEY. |
268 |
(setq sort-func |
(setq sort-func |
269 |
(cond ((eq sort-key 'id) |
(cond ((eq sort-key 'id) |
270 |
(function (lambda (x y) (< (car x) (car y))))) |
(lambda (x y) (< (car x) (car y)))) |
271 |
|
|
272 |
((eq sort-key 'name) |
((eq sort-key 'name) |
273 |
(function (lambda (x y) (string< (nth 1 x) (nth 1 y))))) |
(lambda (x y) (string< (nth 1 x) (nth 1 y)))) |
274 |
|
|
275 |
((eq sort-key 'iso-spec) |
((eq sort-key 'iso-spec) |
276 |
;; Sort by DIMENSION CHARS FINAL-CHAR |
;; Sort by DIMENSION CHARS FINAL-CHAR |
277 |
(function |
(lambda (x y) |
278 |
(lambda (x y) |
(or (< (nth 3 x) (nth 3 y)) |
279 |
(or (< (nth 3 x) (nth 3 y)) |
(and (= (nth 3 x) (nth 3 y)) |
280 |
(and (= (nth 3 x) (nth 3 y)) |
(or (< (nth 4 x) (nth 4 y)) |
281 |
(or (< (nth 4 x) (nth 4 y)) |
(and (= (nth 4 x) (nth 4 y)) |
282 |
(and (= (nth 4 x) (nth 4 y)) |
(< (nth 5 x) (nth 5 y)))))))) |
|
(< (nth 5 x) (nth 5 y))))))))) |
|
283 |
(t |
(t |
284 |
(error "Invalid charset sort key: %s" sort-key)))) |
(error "Invalid charset sort key: %s" sort-key)))) |
285 |
|
|
339 |
(charset-iso-graphic-plane charset) |
(charset-iso-graphic-plane charset) |
340 |
(charset-description charset)))))) |
(charset-description charset)))))) |
341 |
|
|
|
(defvar non-iso-charset-alist |
|
|
`((mac-roman |
|
|
nil |
|
|
mac-roman-decoder |
|
|
((0 255))) |
|
|
(viscii |
|
|
(ascii vietnamese-viscii-lower vietnamese-viscii-upper) |
|
|
viet-viscii-nonascii-translation-table |
|
|
((0 255))) |
|
|
(koi8-r |
|
|
(ascii cyrillic-iso8859-5) |
|
|
cyrillic-koi8-r-nonascii-translation-table |
|
|
((32 255))) |
|
|
(alternativnyj |
|
|
(ascii cyrillic-iso8859-5) |
|
|
cyrillic-alternativnyj-nonascii-translation-table |
|
|
((32 255))) |
|
|
(big5 |
|
|
(ascii chinese-big5-1 chinese-big5-2) |
|
|
decode-big5-char |
|
|
((32 127) |
|
|
((?\xA1 ?\xFE) . (?\x40 ?\x7E ?\xA1 ?\xFE)))) |
|
|
(sjis |
|
|
(ascii katakana-jisx0201 japanese-jisx0208) |
|
|
decode-sjis-char |
|
|
((32 127 ?\xA1 ?\xDF) |
|
|
((?\x81 ?\x9F ?\xE0 ?\xEF) . (?\x40 ?\x7E ?\x80 ?\xFC))))) |
|
|
"Alist of charset names vs the corresponding information. |
|
|
This is mis-named for historical reasons. The charsets are actually |
|
|
non-built-in ones. They correspond to Emacs coding systems, not Emacs |
|
|
charsets, i.e. what Emacs can read (or write) by mapping to (or |
|
|
from) Emacs internal charsets that typically correspond to a limited |
|
|
set of ISO charsets. |
|
|
|
|
|
Each element has the following format: |
|
|
(CHARSET CHARSET-LIST TRANSLATION-METHOD [ CODE-RANGE ]) |
|
|
|
|
|
CHARSET is the name (symbol) of the charset. |
|
|
|
|
|
CHARSET-LIST is a list of Emacs charsets into which characters of |
|
|
CHARSET are mapped. |
|
|
|
|
|
TRANSLATION-METHOD is a translation table (symbol) to translate a |
|
|
character code of CHARSET to the corresponding Emacs character |
|
|
code. It can also be a function to call with one argument, a |
|
|
character code in CHARSET. |
|
|
|
|
|
CODE-RANGE specifies the valid code ranges of CHARSET. |
|
|
It is a list of RANGEs, where each RANGE is of the form: |
|
|
(FROM1 TO1 FROM2 TO2 ...) |
|
|
or |
|
|
((FROM1-1 TO1-1 FROM1-2 TO1-2 ...) . (FROM2-1 TO2-1 FROM2-2 TO2-2 ...)) |
|
|
In the first form, valid codes are between FROM1 and TO1, or FROM2 and |
|
|
TO2, or... |
|
|
The second form is used for 2-byte codes. The car part is the ranges |
|
|
of the first byte, and the cdr part is the ranges of the second byte.") |
|
|
|
|
|
|
|
342 |
(defun decode-codepage-char (codepage code) |
(defun decode-codepage-char (codepage code) |
343 |
"Decode a character that has code CODE in CODEPAGE. |
"Decode a character that has code CODE in CODEPAGE. |
344 |
Return a decoded character string. Each CODEPAGE corresponds to a |
Return a decoded character string. Each CODEPAGE corresponds to a |
386 |
INITIAL-INPUT, if non-nil, is a string inserted in the minibuffer initially. |
INITIAL-INPUT, if non-nil, is a string inserted in the minibuffer initially. |
387 |
See the documentation of the function `completing-read' for the |
See the documentation of the function `completing-read' for the |
388 |
detailed meanings of these arguments." |
detailed meanings of these arguments." |
389 |
(let* ((table (append (mapcar (function (lambda (x) (list (symbol-name x)))) |
(let* ((table (append (mapcar (lambda (x) (list (symbol-name x))) |
390 |
charset-list) |
charset-list) |
391 |
(mapcar (function (lambda (x) |
(mapcar (lambda (x) (list (symbol-name (car x)))) |
|
(list (symbol-name (car x))))) |
|
392 |
non-iso-charset-alist))) |
non-iso-charset-alist))) |
393 |
(charset (completing-read prompt table |
(charset (completing-read prompt table |
394 |
nil t initial-input 'charset-history |
nil t initial-input 'charset-history |
521 |
characters encoded by various Emacs coding systems which correspond to |
characters encoded by various Emacs coding systems which correspond to |
522 |
PC `codepages' and other coded character sets. See `non-iso-charset-alist'." |
PC `codepages' and other coded character sets. See `non-iso-charset-alist'." |
523 |
(interactive (list (read-charset "Character set: "))) |
(interactive (list (read-charset "Character set: "))) |
524 |
(with-output-to-temp-buffer "*Help*" |
(with-output-to-temp-buffer "*Character List*" |
525 |
(with-current-buffer standard-output |
(with-current-buffer standard-output |
526 |
|
(setq mode-line-format (copy-sequence mode-line-format)) |
527 |
|
(let ((slot (memq 'mode-line-buffer-identification mode-line-format))) |
528 |
|
(if slot |
529 |
|
(setcdr slot |
530 |
|
(cons (format " (%s)" charset) |
531 |
|
(cdr slot))))) |
532 |
(setq indent-tabs-mode nil) |
(setq indent-tabs-mode nil) |
533 |
(set-buffer-multibyte t) |
(set-buffer-multibyte t) |
534 |
(cond ((charsetp charset) |
(cond ((charsetp charset) |
570 |
(insert (format "Preferred coding system: %s\n" coding)) |
(insert (format "Preferred coding system: %s\n" coding)) |
571 |
(search-backward (symbol-name coding)) |
(search-backward (symbol-name coding)) |
572 |
(help-xref-button 0 'help-coding-system coding))))))) |
(help-xref-button 0 'help-coding-system coding))))))) |
|
|
|
|
;;;###autoload |
|
|
(defun describe-char-after (&optional pos) |
|
|
"Display information about the character at POS in the current buffer. |
|
|
POS defaults to point. |
|
|
The information includes character code, charset and code points in it, |
|
|
syntax, category, how the character is encoded in a file, |
|
|
which font is being used for displaying the character." |
|
|
(interactive) |
|
|
(or pos |
|
|
(setq pos (point))) |
|
|
(if (>= pos (point-max)) |
|
|
(error "No character at point")) |
|
|
(let* ((char (char-after pos)) |
|
|
(charset (char-charset char)) |
|
|
(props (text-properties-at pos)) |
|
|
(composition (find-composition (point) nil nil t)) |
|
|
(composed (if composition (buffer-substring (car composition) |
|
|
(nth 1 composition)))) |
|
|
(multibyte-p enable-multibyte-characters) |
|
|
item-list max-width) |
|
|
(if (eq charset 'unknown) |
|
|
(setq item-list |
|
|
`(("character" |
|
|
,(format "%s (0%o, %d, 0x%x) -- invalid character code" |
|
|
(if (< char 256) |
|
|
(single-key-description char) |
|
|
(char-to-string char)) |
|
|
char char char)))) |
|
|
(setq item-list |
|
|
`(("character" |
|
|
,(format "%s (0%o, %d, 0x%x)" (if (< char 256) |
|
|
(single-key-description char) |
|
|
(char-to-string char)) |
|
|
char char char)) |
|
|
("charset" |
|
|
,(symbol-name charset) |
|
|
,(format "(%s)" (charset-description charset))) |
|
|
("code point" |
|
|
,(let ((split (split-char char))) |
|
|
(if (= (charset-dimension charset) 1) |
|
|
(format "%d" (nth 1 split)) |
|
|
(format "%d %d" (nth 1 split) (nth 2 split))))) |
|
|
("syntax" |
|
|
,(let ((syntax (get-char-property (point) 'syntax-table))) |
|
|
(with-temp-buffer |
|
|
(internal-describe-syntax-value |
|
|
(if (consp syntax) syntax |
|
|
(aref (or syntax (syntax-table)) char))) |
|
|
(buffer-string)))) |
|
|
("category" |
|
|
,@(let ((category-set (char-category-set char))) |
|
|
(if (not category-set) |
|
|
'("-- none --") |
|
|
(mapcar #'(lambda (x) (format "%c:%s " |
|
|
x (category-docstring x))) |
|
|
(category-set-mnemonics category-set))))) |
|
|
,@(let ((props (aref char-code-property-table char)) |
|
|
ps) |
|
|
(when props |
|
|
(while props |
|
|
(push (format "%s:" (pop props)) ps) |
|
|
(push (format "%s;" (pop props)) ps)) |
|
|
(list (cons "Properties" (nreverse ps))))) |
|
|
("buffer code" |
|
|
,(encoded-string-description |
|
|
(string-as-unibyte (char-to-string char)) nil)) |
|
|
("file code" |
|
|
,@(let* ((coding buffer-file-coding-system) |
|
|
(encoded (encode-coding-char char coding))) |
|
|
(if encoded |
|
|
(list (encoded-string-description encoded coding) |
|
|
(format "(encoded by coding system %S)" coding)) |
|
|
(list "not encodable by coding system" |
|
|
(symbol-name coding))))) |
|
|
,@(if (or (memq 'mule-utf-8 |
|
|
(find-coding-systems-region (point) (1+ (point)))) |
|
|
(get-char-property (point) 'untranslated-utf-8)) |
|
|
(let ((uc (or (get-char-property (point) |
|
|
'untranslated-utf-8) |
|
|
(encode-char (char-after) 'ucs)))) |
|
|
(if uc |
|
|
(list (list "Unicode" |
|
|
(format "%04X" uc)))))) |
|
|
,(if (display-graphic-p (selected-frame)) |
|
|
(list "font" (or (internal-char-font (point)) |
|
|
"-- none --")) |
|
|
(list "terminal code" |
|
|
(let* ((coding (terminal-coding-system)) |
|
|
(encoded (encode-coding-char char coding))) |
|
|
(if encoded |
|
|
(encoded-string-description encoded coding) |
|
|
"not encodable"))))))) |
|
|
(setq max-width (apply #'max (mapcar #'(lambda (x) (length (car x))) |
|
|
item-list))) |
|
|
(with-output-to-temp-buffer "*Help*" |
|
|
(save-excursion |
|
|
(set-buffer standard-output) |
|
|
(set-buffer-multibyte multibyte-p) |
|
|
(let ((formatter (format "%%%ds:" max-width))) |
|
|
(dolist (elt item-list) |
|
|
(insert (format formatter (car elt))) |
|
|
(dolist (clm (cdr elt)) |
|
|
(when (>= (+ (current-column) |
|
|
(or (string-match "\n" clm) |
|
|
(string-width clm)) 1) |
|
|
(frame-width)) |
|
|
(insert "\n") |
|
|
(indent-to (1+ max-width))) |
|
|
(insert " " clm)) |
|
|
(insert "\n"))) |
|
|
(when composition |
|
|
(insert "\nComposed with the following character(s) " |
|
|
(mapconcat (lambda (x) (format "`%c'" x)) |
|
|
(substring composed 1) |
|
|
", ") |
|
|
" to form `" composed "'") |
|
|
(if (nth 3 composition) |
|
|
(insert ".\n") |
|
|
(insert "\nby the rule (" |
|
|
(mapconcat (lambda (x) |
|
|
(format (if (consp x) "%S" "?%c") x)) |
|
|
(nth 2 composition) |
|
|
" ") |
|
|
").\n" |
|
|
"See the variable `reference-point-alist' for " |
|
|
"the meaning of the rule.\n"))) |
|
|
(when props |
|
|
(insert "\nText properties\n") |
|
|
(require 'descr-text) |
|
|
(describe-text-properties props)))))) |
|
|
|
|
573 |
|
|
574 |
;;; CODING-SYSTEM |
;;; CODING-SYSTEM |
575 |
|
|
624 |
(with-output-to-temp-buffer (help-buffer) |
(with-output-to-temp-buffer (help-buffer) |
625 |
(print-coding-system-briefly coding-system 'doc-string) |
(print-coding-system-briefly coding-system 'doc-string) |
626 |
(princ "\n") |
(princ "\n") |
627 |
(let ((coding-spec (coding-system-spec coding-system))) |
(let ((vars (coding-system-get coding-system 'dependency))) |
628 |
(princ "Type: ") |
(when vars |
629 |
(let ((type (coding-system-type coding-system)) |
(princ "See also the documentation of these customizable variables |
630 |
(flags (coding-system-flags coding-system))) |
which alter the behaviour of this coding system.\n") |
631 |
(princ type) |
(dolist (v vars) |
632 |
(cond ((eq type nil) |
(princ " `") |
633 |
(princ " (do no conversion)")) |
(princ v) |
634 |
((eq type t) |
(princ "'\n")) |
635 |
(princ " (do automatic conversion)")) |
(princ "\n"))) |
636 |
((eq type 0) |
|
637 |
(princ " (Emacs internal multibyte form)")) |
(princ "Type: ") |
638 |
((eq type 1) |
(let ((type (coding-system-type coding-system)) |
639 |
(princ " (Shift-JIS, MS-KANJI)")) |
(flags (coding-system-flags coding-system))) |
640 |
((eq type 2) |
(princ type) |
641 |
(princ " (variant of ISO-2022)\n") |
(cond ((eq type nil) |
642 |
(princ "Initial designations:\n") |
(princ " (do no conversion)")) |
643 |
(print-designation flags) |
((eq type t) |
644 |
(princ "Other Form: \n ") |
(princ " (do automatic conversion)")) |
645 |
(princ (if (aref flags 4) "short-form" "long-form")) |
((eq type 0) |
646 |
(if (aref flags 5) (princ ", ASCII@EOL")) |
(princ " (Emacs internal multibyte form)")) |
647 |
(if (aref flags 6) (princ ", ASCII@CNTL")) |
((eq type 1) |
648 |
(princ (if (aref flags 7) ", 7-bit" ", 8-bit")) |
(princ " (Shift-JIS, MS-KANJI)")) |
649 |
(if (aref flags 8) (princ ", use-locking-shift")) |
((eq type 2) |
650 |
(if (aref flags 9) (princ ", use-single-shift")) |
(princ " (variant of ISO-2022)\n") |
651 |
(if (aref flags 10) (princ ", use-roman")) |
(princ "Initial designations:\n") |
652 |
(if (aref flags 11) (princ ", use-old-jis")) |
(print-designation flags) |
653 |
(if (aref flags 12) (princ ", no-ISO6429")) |
(princ "Other Form: \n ") |
654 |
(if (aref flags 13) (princ ", init-bol")) |
(princ (if (aref flags 4) "short-form" "long-form")) |
655 |
(if (aref flags 14) (princ ", designation-bol")) |
(if (aref flags 5) (princ ", ASCII@EOL")) |
656 |
(if (aref flags 15) (princ ", convert-unsafe")) |
(if (aref flags 6) (princ ", ASCII@CNTL")) |
657 |
(if (aref flags 16) (princ ", accept-latin-extra-code")) |
(princ (if (aref flags 7) ", 7-bit" ", 8-bit")) |
658 |
(princ ".")) |
(if (aref flags 8) (princ ", use-locking-shift")) |
659 |
((eq type 3) |
(if (aref flags 9) (princ ", use-single-shift")) |
660 |
(princ " (Big5)")) |
(if (aref flags 10) (princ ", use-roman")) |
661 |
((eq type 4) |
(if (aref flags 11) (princ ", use-old-jis")) |
662 |
(princ " (do conversion by CCL program)")) |
(if (aref flags 12) (princ ", no-ISO6429")) |
663 |
((eq type 5) |
(if (aref flags 13) (princ ", init-bol")) |
664 |
(princ " (text with random binary characters)")) |
(if (aref flags 14) (princ ", designation-bol")) |
665 |
(t (princ ": invalid coding-system.")))) |
(if (aref flags 15) (princ ", convert-unsafe")) |
666 |
(princ "\nEOL type: ") |
(if (aref flags 16) (princ ", accept-latin-extra-code")) |
667 |
(let ((eol-type (coding-system-eol-type coding-system))) |
(princ ".")) |
668 |
(cond ((vectorp eol-type) |
((eq type 3) |
669 |
(princ "Automatic selection from:\n\t") |
(princ " (Big5)")) |
670 |
(princ eol-type) |
((eq type 4) |
671 |
(princ "\n")) |
(princ " (do conversion by CCL program)")) |
672 |
((or (null eol-type) (eq eol-type 0)) (princ "LF\n")) |
((eq type 5) |
673 |
((eq eol-type 1) (princ "CRLF\n")) |
(princ " (text with random binary characters)")) |
674 |
((eq eol-type 2) (princ "CR\n")) |
(t (princ ": invalid coding-system.")))) |
675 |
(t (princ "invalid\n"))))) |
(princ "\nEOL type: ") |
676 |
|
(let ((eol-type (coding-system-eol-type coding-system))) |
677 |
|
(cond ((vectorp eol-type) |
678 |
|
(princ "Automatic selection from:\n\t") |
679 |
|
(princ eol-type) |
680 |
|
(princ "\n")) |
681 |
|
((or (null eol-type) (eq eol-type 0)) (princ "LF\n")) |
682 |
|
((eq eol-type 1) (princ "CRLF\n")) |
683 |
|
((eq eol-type 2) (princ "CR\n")) |
684 |
|
(t (princ "invalid\n")))) |
685 |
(let ((postread (coding-system-get coding-system 'post-read-conversion))) |
(let ((postread (coding-system-get coding-system 'post-read-conversion))) |
686 |
(when postread |
(when postread |
687 |
(princ "After decoding text normally,") |
(princ "After decoding text normally,") |
767 |
(coding-system-mnemonic coding-system) |
(coding-system-mnemonic coding-system) |
768 |
coding-system)) |
coding-system)) |
769 |
(let ((aliases (coding-system-get coding-system 'alias-coding-systems))) |
(let ((aliases (coding-system-get coding-system 'alias-coding-systems))) |
770 |
(if (eq coding-system (car aliases)) |
(cond ((eq coding-system (car aliases)) |
771 |
(if (cdr aliases) |
(if (cdr aliases) |
772 |
(princ (format " %S" (cons 'alias: (cdr aliases))))) |
(princ (format " %S" (cons 'alias: (cdr aliases)))))) |
773 |
(if (memq coding-system aliases) |
((memq coding-system aliases) |
774 |
(princ (format " (alias of %s)" (car aliases)))))) |
(princ (format " (alias of %s)" (car aliases)))) |
775 |
|
(t |
776 |
|
(let ((eol-type (coding-system-eol-type coding-system)) |
777 |
|
(base-eol-type (coding-system-eol-type (car aliases)))) |
778 |
|
(if (and (integerp eol-type) |
779 |
|
(vectorp base-eol-type) |
780 |
|
(not (eq coding-system (aref base-eol-type eol-type)))) |
781 |
|
(princ (format " (alias of %s)" |
782 |
|
(aref base-eol-type eol-type)))))))) |
783 |
(princ "\n\n") |
(princ "\n\n") |
784 |
(if (and doc-string |
(if (and doc-string |
785 |
(setq doc-string (coding-system-doc-string coding-system))) |
(setq doc-string (coding-system-doc-string coding-system))) |
847 |
(while categories |
(while categories |
848 |
(setq coding-system (symbol-value (car categories))) |
(setq coding-system (symbol-value (car categories))) |
849 |
(mapcar |
(mapcar |
850 |
(function |
(lambda (x) |
851 |
(lambda (x) |
(if (and (not (eq x coding-system)) |
852 |
(if (and (not (eq x coding-system)) |
(coding-system-get x 'no-initial-designation) |
853 |
(coding-system-get x 'no-initial-designation) |
(let ((flags (coding-system-flags x))) |
854 |
(let ((flags (coding-system-flags x))) |
(not (or (aref flags 10) (aref flags 11))))) |
855 |
(not (or (aref flags 10) (aref flags 11))))) |
(setq codings (cons x codings)))) |
|
(setq codings (cons x codings))))) |
|
856 |
(get (car categories) 'coding-systems)) |
(get (car categories) 'coding-systems)) |
857 |
(if codings |
(if codings |
858 |
(let ((max-col (frame-width)) |
(let ((max-col (frame-width)) |
1057 |
|
|
1058 |
(defun print-fontset (fontset &optional print-fonts) |
(defun print-fontset (fontset &optional print-fonts) |
1059 |
"Print information about FONTSET. |
"Print information about FONTSET. |
1060 |
|
If FONTSET is nil, print information about the default fontset. |
1061 |
If optional arg PRINT-FONTS is non-nil, also print names of all opened |
If optional arg PRINT-FONTS is non-nil, also print names of all opened |
1062 |
fonts for FONTSET. This function actually inserts the information in |
fonts for FONTSET. This function actually inserts the information in |
1063 |
the current buffer." |
the current buffer." |
1064 |
|
(or fontset |
1065 |
|
(setq fontset (query-fontset "fontset-default"))) |
1066 |
(let ((tail (aref (fontset-info fontset) 2)) |
(let ((tail (aref (fontset-info fontset) 2)) |
1067 |
elt chars font-spec opened prev-charset charset from to) |
elt chars font-spec opened prev-charset charset from to) |
1068 |
(beginning-of-line) |
(beginning-of-line) |
1134 |
(if (not (and window-system (fboundp 'fontset-list))) |
(if (not (and window-system (fboundp 'fontset-list))) |
1135 |
(error "No fontsets being used") |
(error "No fontsets being used") |
1136 |
(let ((fontset-list (nconc |
(let ((fontset-list (nconc |
1137 |
(mapcar 'list (fontset-list)) |
(fontset-list) |
1138 |
(mapcar (lambda (x) (list (cdr x))) |
(mapcar 'cdr fontset-alias-alist))) |
|
fontset-alias-alist))) |
|
1139 |
(completion-ignore-case t)) |
(completion-ignore-case t)) |
1140 |
(list (completing-read |
(list (completing-read |
1141 |
"Fontset (default, used by the current frame): " |
"Fontset (default, used by the current frame): " |
1142 |
fontset-list nil t))))) |
fontset-list nil t))))) |
1143 |
(if (= (length fontset) 0) |
(if (= (length fontset) 0) |
1144 |
(setq fontset (cdr (assq 'font (frame-parameters))))) |
(setq fontset (frame-parameter nil 'font))) |
1145 |
(if (not (setq fontset (query-fontset fontset))) |
(setq fontset (query-fontset fontset)) |
|
(error "Current frame is using font, not fontset")) |
|
1146 |
(help-setup-xref (list #'describe-fontset fontset) (interactive-p)) |
(help-setup-xref (list #'describe-fontset fontset) (interactive-p)) |
1147 |
(with-output-to-temp-buffer (help-buffer) |
(with-output-to-temp-buffer (help-buffer) |
1148 |
(with-current-buffer standard-output |
(with-current-buffer standard-output |
1163 |
;; This code is duplicated near the end of mule-diag. |
;; This code is duplicated near the end of mule-diag. |
1164 |
(let ((fontsets |
(let ((fontsets |
1165 |
(sort (fontset-list) |
(sort (fontset-list) |
1166 |
(function (lambda (x y) |
(lambda (x y) |
1167 |
(string< (fontset-plain-name x) |
(string< (fontset-plain-name x) |
1168 |
(fontset-plain-name y))))))) |
(fontset-plain-name y)))))) |
1169 |
(while fontsets |
(while fontsets |
1170 |
(if arg |
(if arg |
1171 |
(print-fontset (car fontsets) nil) |
(print-fontset (car fontsets) nil) |
1176 |
(defun list-input-methods () |
(defun list-input-methods () |
1177 |
"Display information about all input methods." |
"Display information about all input methods." |
1178 |
(interactive) |
(interactive) |
1179 |
(with-output-to-temp-buffer "*Help*" |
(help-setup-xref '(list-input-methods) (interactive-p)) |
1180 |
|
(with-output-to-temp-buffer (help-buffer) |
1181 |
(list-input-methods-1) |
(list-input-methods-1) |
1182 |
(with-current-buffer standard-output |
(with-current-buffer standard-output |
1183 |
(save-excursion |
(save-excursion |
1186 |
"^ \\([^ ]+\\) (`.*' in mode line)$" nil t) |
"^ \\([^ ]+\\) (`.*' in mode line)$" nil t) |
1187 |
(help-xref-button 1 #'help-input-method |
(help-xref-button 1 #'help-input-method |
1188 |
(match-string 1) |
(match-string 1) |
1189 |
"mouse-2: describe this method"))) |
"mouse-2: describe this method")))))) |
|
(help-setup-xref '(list-input-methods) (interactive-p))))) |
|
1190 |
|
|
1191 |
(defun list-input-methods-1 () |
(defun list-input-methods-1 () |
1192 |
(if (not input-method-alist) |
(if (not input-method-alist) |
1198 |
(princ " SHORT-DESCRIPTION\n------------------------------\n") |
(princ " SHORT-DESCRIPTION\n------------------------------\n") |
1199 |
(setq input-method-alist |
(setq input-method-alist |
1200 |
(sort input-method-alist |
(sort input-method-alist |
1201 |
(function (lambda (x y) (string< (nth 1 x) (nth 1 y)))))) |
(lambda (x y) (string< (nth 1 x) (nth 1 y))))) |
1202 |
(let ((l input-method-alist) |
(let ((l input-method-alist) |
1203 |
language elt) |
language elt) |
1204 |
(while l |
(while l |
1310 |
(setq fontsets (cdr fontsets))))) |
(setq fontsets (cdr fontsets))))) |
1311 |
(print-help-return-message)))) |
(print-help-return-message)))) |
1312 |
|
|
1313 |
|
(provide 'mule-diag) |
1314 |
|
|
1315 |
;;; mule-diag.el ends here |
;;; mule-diag.el ends here |