(insert (format "Preferred coding system: %s\n" coding))
(search-backward (symbol-name 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,
-and text properties."
- (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))))))
\f
;;; CODING-SYSTEM