Commit ed441285 authored by Kenichi Handa's avatar Kenichi Handa

(describe-char): Fix previous change. Don't make

a unibyte character to multibyte in the *Help* buffer.
parent 9a28b921
...@@ -465,7 +465,6 @@ as well as widgets, buttons, overlays, and text properties." ...@@ -465,7 +465,6 @@ as well as widgets, buttons, overlays, and text properties."
(if (>= pos (point-max)) (if (>= pos (point-max))
(error "No character follows specified position")) (error "No character follows specified position"))
(let* ((char (char-after pos)) (let* ((char (char-after pos))
(char-string (buffer-substring pos (1+ pos)))
(charset (char-charset char)) (charset (char-charset char))
(buffer (current-buffer)) (buffer (current-buffer))
(composition (find-composition pos nil nil t)) (composition (find-composition pos nil nil t))
...@@ -478,125 +477,114 @@ as well as widgets, buttons, overlays, and text properties." ...@@ -478,125 +477,114 @@ as well as widgets, buttons, overlays, and text properties."
(overlays (mapcar #'(lambda (o) (overlay-properties o)) (overlays (mapcar #'(lambda (o) (overlay-properties o))
(overlays-at pos))) (overlays-at pos)))
item-list max-width unicode) item-list max-width unicode)
(if (eq charset 'unknown)
(setq item-list '("character")) (if (or (< char 256)
(memq 'mule-utf-8 (find-coding-systems-region pos (1+ pos)))
(if (or (< char 256) (get-char-property pos 'untranslated-utf-8))
(memq 'mule-utf-8 (find-coding-systems-region pos (1+ pos))) (setq unicode (or (get-char-property pos 'untranslated-utf-8)
(get-char-property pos 'untranslated-utf-8)) (encode-char char 'ucs))))
(setq unicode (or (get-char-property pos 'untranslated-utf-8) (setq item-list
(encode-char char 'ucs)))) `(("character"
(setq item-list ,(format "%s (0%o, %d, 0x%x%s)"
`(("character") (apply 'propertize (if (not multibyte-p)
("charset" (single-key-description char)
,(symbol-name charset) (if (< char 128)
,(format "(%s)" (charset-description charset))) (single-key-description char)
("code point" (string-to-multibyte
,(let ((split (split-char char))) (char-to-string char))))
(if (= (charset-dimension charset) 1) (text-properties-at pos))
(format "%d" (nth 1 split)) char char char
(format "%d %d" (nth 1 split) (nth 2 split))))) (if unicode
("syntax" (format ", U+%04X" unicode)
,(let ((syntax (syntax-after pos))) "")))
(with-temp-buffer ("charset"
(internal-describe-syntax-value syntax) ,(symbol-name charset)
(buffer-string)))) ,(format "(%s)" (charset-description charset)))
("category" ("code point"
,@(let ((category-set (char-category-set char))) ,(let ((split (split-char char)))
(if (not category-set) (if (= (charset-dimension charset) 1)
'("-- none --") (format "%d" (nth 1 split))
(mapcar #'(lambda (x) (format "%c:%s " (format "%d %d" (nth 1 split) (nth 2 split)))))
x (category-docstring x))) ("syntax"
(category-set-mnemonics category-set))))) ,(let ((syntax (syntax-after pos)))
,@(let ((props (aref char-code-property-table char)) (with-temp-buffer
ps) (internal-describe-syntax-value syntax)
(when props (buffer-string))))
(while props ("category"
(push (format "%s:" (pop props)) ps) ,@(let ((category-set (char-category-set char)))
(push (format "%s;" (pop props)) ps)) (if (not category-set)
(list (cons "Properties" (nreverse ps))))) '("-- none --")
("buffer code" (mapcar #'(lambda (x) (format "%c:%s "
,(encoded-string-description x (category-docstring x)))
(string-as-unibyte (char-to-string char)) nil)) (category-set-mnemonics category-set)))))
("file code" ,@(let ((props (aref char-code-property-table char))
,@(let* ((coding buffer-file-coding-system) ps)
(encoded (encode-coding-char char coding))) (when props
(if encoded (while props
(list (encoded-string-description encoded coding) (push (format "%s:" (pop props)) ps)
(format "(encoded by coding system %S)" coding)) (push (format "%s;" (pop props)) ps))
(list "not encodable by coding system" (list (cons "Properties" (nreverse ps)))))
(symbol-name coding))))) ("buffer code"
("display" ,(encoded-string-description
,(cond (string-as-unibyte (char-to-string char)) nil))
(disp-vector ("file code"
(setq disp-vector (copy-sequence disp-vector)) ,@(let* ((coding buffer-file-coding-system)
(dotimes (i (length disp-vector)) (encoded (encode-coding-char char coding)))
(setq char (aref disp-vector i)) (if encoded
(aset disp-vector i (list (encoded-string-description encoded coding)
(cons char (describe-char-display pos char)))) (format "(encoded by coding system %S)" coding))
(format "by display table entry [%s] (see below)" (list "not encodable by coding system"
(mapconcat #'(lambda (x) (format "?%c" (car x))) (symbol-name coding)))))
disp-vector " "))) ("display"
(composition ,(cond
(let ((from (car composition)) (disp-vector
(to (nth 1 composition)) (setq disp-vector (copy-sequence disp-vector))
(next (1+ pos)) (dotimes (i (length disp-vector))
(components (nth 2 composition)) (setq char (aref disp-vector i))
ch) (aset disp-vector i
(setcar composition (cons char (describe-char-display pos char))))
(and (< from pos) (buffer-substring from pos))) (format "by display table entry [%s] (see below)"
(setcar (cdr composition) (mapconcat #'(lambda (x) (format "?%c" (car x)))
(and (< next to) (buffer-substring next to))) disp-vector " ")))
(dotimes (i (length components)) (composition
(if (integerp (setq ch (aref components i))) (let ((from (car composition))
(push (cons ch (describe-char-display pos ch)) (to (nth 1 composition))
component-chars))) (next (1+ pos))
(setq component-chars (nreverse component-chars)) (components (nth 2 composition))
(format "composed to form \"%s\" (see below)" ch)
(buffer-substring from to)))) (setcar composition
(t (and (< from pos) (buffer-substring from pos)))
(let ((display (describe-char-display pos char))) (setcar (cdr composition)
(if (display-graphic-p (selected-frame)) (and (< next to) (buffer-substring next to)))
(if display (dotimes (i (length components))
(concat (if (integerp (setq ch (aref components i)))
"by this font (glyph code)\n" (push (cons ch (describe-char-display pos ch))
(format " %s (0x%02X)" component-chars)))
(car display) (cdr display))) (setq component-chars (nreverse component-chars))
"no font available") (format "composed to form \"%s\" (see below)"
(buffer-substring from to))))
(t
(let ((display (describe-char-display pos char)))
(if (display-graphic-p (selected-frame))
(if display (if display
(format "terminal code %s" display) (concat
"not encodable for terminal")))))) "by this font (glyph code)\n"
,@(let ((unicodedata (and unicode (format " %s (0x%02X)"
(describe-char-unicode-data unicode)))) (car display) (cdr display)))
(if unicodedata "no font available")
(cons (list "Unicode data" " ") unicodedata)))))) (if display
(format "terminal code %s" display)
"not encodable for terminal"))))))
,@(let ((unicodedata (and unicode
(describe-char-unicode-data unicode))))
(if unicodedata
(cons (list "Unicode data" " ") unicodedata)))))
(setq max-width (apply #'max (mapcar #'(lambda (x) (length (car x))) (setq max-width (apply #'max (mapcar #'(lambda (x) (length (car x)))
item-list))) item-list)))
(pop item-list)
(with-output-to-temp-buffer "*Help*" (with-output-to-temp-buffer "*Help*"
(with-current-buffer standard-output (with-current-buffer standard-output
(set-buffer-multibyte multibyte-p) (set-buffer-multibyte multibyte-p)
(let ((formatter (format "%%%ds:" max-width))) (let ((formatter (format "%%%ds:" max-width)))
(insert (format formatter "character") " ")
(setq pos (point))
(insert char-string
(format " (`%s', 0%o, %d, 0x%x"
(if (< char 256)
(single-key-description char)
(char-to-string char))
char char char)
(if (eq charset 'unknown)
") -- invalid character code\n"
(if unicode
(format ", U+%04X)\n" unicode)
")\n")))
(mapc #'(lambda (props)
(let ((o (make-overlay pos (1+ pos))))
(while props
(overlay-put o (car props) (nth 1 props))
(setq props (cddr props)))))
overlays)
(dolist (elt item-list) (dolist (elt item-list)
(when (cadr elt) (when (cadr elt)
(insert (format formatter (car elt))) (insert (format formatter (car elt)))
...@@ -610,6 +598,18 @@ as well as widgets, buttons, overlays, and text properties." ...@@ -610,6 +598,18 @@ as well as widgets, buttons, overlays, and text properties."
(insert " " clm)) (insert " " clm))
(insert "\n")))) (insert "\n"))))
(save-excursion
(goto-char (point-min))
(search-forward "character: ")
(setq pos (point)))
(if overlays
(mapc #'(lambda (props)
(let ((o (make-overlay pos (1+ pos))))
(while props
(overlay-put o (car props) (nth 1 props))
(setq props (cddr props)))))
overlays))
(when disp-vector (when disp-vector
(insert (insert
"\nThe display table entry is displayed by ") "\nThe display table entry is displayed by ")
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment