# HG changeset patch # User Kenichi Handa # Date 1084190832 0 # Node ID 79abf8a72f5abeff8f5372cb02f6d1bdb1d5b043 # Parent 22eeb2c849a0c45472438447808efbe572032190 (describe-char): Fix previous change. Don't make a unibyte character to multibyte in the *Help* buffer. diff -r 22eeb2c849a0 -r 79abf8a72f5a lisp/descr-text.el --- a/lisp/descr-text.el Mon May 10 12:00:20 2004 +0000 +++ b/lisp/descr-text.el Mon May 10 12:07:12 2004 +0000 @@ -465,7 +465,6 @@ (if (>= pos (point-max)) (error "No character follows specified position")) (let* ((char (char-after pos)) - (char-string (buffer-substring pos (1+ pos))) (charset (char-charset char)) (buffer (current-buffer)) (composition (find-composition pos nil nil t)) @@ -478,125 +477,114 @@ (overlays (mapcar #'(lambda (o) (overlay-properties o)) (overlays-at pos))) 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))) - (get-char-property pos 'untranslated-utf-8)) - (setq unicode (or (get-char-property pos 'untranslated-utf-8) - (encode-char char 'ucs)))) - (setq item-list - `(("character") - ("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 (syntax-after pos))) - (with-temp-buffer - (internal-describe-syntax-value syntax) - (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))))) - ("display" - ,(cond - (disp-vector - (setq disp-vector (copy-sequence disp-vector)) - (dotimes (i (length disp-vector)) - (setq char (aref disp-vector i)) - (aset disp-vector i - (cons char (describe-char-display pos char)))) - (format "by display table entry [%s] (see below)" - (mapconcat #'(lambda (x) (format "?%c" (car x))) - disp-vector " "))) - (composition - (let ((from (car composition)) - (to (nth 1 composition)) - (next (1+ pos)) - (components (nth 2 composition)) - ch) - (setcar composition - (and (< from pos) (buffer-substring from pos))) - (setcar (cdr composition) - (and (< next to) (buffer-substring next to))) - (dotimes (i (length components)) - (if (integerp (setq ch (aref components i))) - (push (cons ch (describe-char-display pos ch)) - component-chars))) - (setq component-chars (nreverse component-chars)) - (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 - (concat - "by this font (glyph code)\n" - (format " %s (0x%02X)" - (car display) (cdr display))) - "no font available") + (if (or (< char 256) + (memq 'mule-utf-8 (find-coding-systems-region pos (1+ pos))) + (get-char-property pos 'untranslated-utf-8)) + (setq unicode (or (get-char-property pos 'untranslated-utf-8) + (encode-char char 'ucs)))) + (setq item-list + `(("character" + ,(format "%s (0%o, %d, 0x%x%s)" + (apply 'propertize (if (not multibyte-p) + (single-key-description char) + (if (< char 128) + (single-key-description char) + (string-to-multibyte + (char-to-string char)))) + (text-properties-at pos)) + char char char + (if unicode + (format ", U+%04X" unicode) + ""))) + ("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 (syntax-after pos))) + (with-temp-buffer + (internal-describe-syntax-value syntax) + (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))))) + ("display" + ,(cond + (disp-vector + (setq disp-vector (copy-sequence disp-vector)) + (dotimes (i (length disp-vector)) + (setq char (aref disp-vector i)) + (aset disp-vector i + (cons char (describe-char-display pos char)))) + (format "by display table entry [%s] (see below)" + (mapconcat #'(lambda (x) (format "?%c" (car x))) + disp-vector " "))) + (composition + (let ((from (car composition)) + (to (nth 1 composition)) + (next (1+ pos)) + (components (nth 2 composition)) + ch) + (setcar composition + (and (< from pos) (buffer-substring from pos))) + (setcar (cdr composition) + (and (< next to) (buffer-substring next to))) + (dotimes (i (length components)) + (if (integerp (setq ch (aref components i))) + (push (cons ch (describe-char-display pos ch)) + component-chars))) + (setq component-chars (nreverse component-chars)) + (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 - (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)))))) + (concat + "by this font (glyph code)\n" + (format " %s (0x%02X)" + (car display) (cdr display))) + "no font available") + (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))) item-list))) - (pop item-list) - (with-output-to-temp-buffer "*Help*" (with-current-buffer standard-output (set-buffer-multibyte multibyte-p) (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) (when (cadr elt) (insert (format formatter (car elt))) @@ -610,6 +598,18 @@ (insert " " clm)) (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 (insert "\nThe display table entry is displayed by ")