(describe-char-after): Moved to descr-text.el.
This commit is contained in:
Richard M. Stallman
parent
0b69eec589
commit
5e11fd0184
1 changed files with 0 additions and 132 deletions
|
|
@ -532,138 +532,6 @@ PC `codepages' and other coded character sets. See `non-iso-charset-alist'."
|
|||
(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))))))
|
||||
|
||||
;;; CODING-SYSTEM
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue