(describe-property-list): Sync to HEAD.
This commit is contained in:
Kenichi Handa
parent
186a08a87d
commit
7fb0741b2f
1 changed files with 127 additions and 41 deletions
|
|
@ -1,6 +1,6 @@
|
|||
;;; descr-text.el --- describe text mode
|
||||
|
||||
;; Copyright (c) 1994, 1995, 1996, 2001, 02, 03 Free Software Foundation, Inc.
|
||||
;; Copyright (c) 1994, 95, 96, 2001, 02, 03, 04 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Boris Goldowsky <boris@gnu.org>
|
||||
;; Keywords: faces
|
||||
|
|
@ -99,8 +99,9 @@ if that value is non-nil."
|
|||
(defun describe-property-list (properties)
|
||||
"Insert a description of PROPERTIES in the current buffer.
|
||||
PROPERTIES should be a list of overlay or text properties.
|
||||
The `category' property is made into a widget button that call
|
||||
`describe-text-category' when pushed."
|
||||
The `category', `face' and `font-lock-face' properties are made
|
||||
into widget buttons that call `describe-text-category' or
|
||||
`describe-face' when pushed."
|
||||
;; Sort the properties by the size of their value.
|
||||
(dolist (elt (sort (let ((ret nil)
|
||||
(key nil)
|
||||
|
|
@ -110,7 +111,7 @@ The `category' property is made into a widget button that call
|
|||
(setq key (pop properties)
|
||||
val (pop properties)
|
||||
len 0)
|
||||
(unless (or (eq key 'category)
|
||||
(unless (or (memq key '(category face font-lock-face))
|
||||
(widgetp val))
|
||||
(setq val (pp-to-string val)
|
||||
len (length val)))
|
||||
|
|
@ -128,6 +129,11 @@ The `category' property is made into a widget button that call
|
|||
:notify `(lambda (&rest ignore)
|
||||
(describe-text-category ',value))
|
||||
(format "%S" value)))
|
||||
((memq key '(face font-lock-face))
|
||||
(widget-create 'link
|
||||
:notify `(lambda (&rest ignore)
|
||||
(describe-face ',value))
|
||||
(format "%S" value)))
|
||||
((widgetp value)
|
||||
(describe-text-widget value))
|
||||
(t
|
||||
|
|
@ -338,7 +344,7 @@ otherwise."
|
|||
;;; (string-to-number (nth 2 fields))
|
||||
;;; '((0 . "Spacing")
|
||||
;;; (1 . "Overlays and interior")
|
||||
;;; (7 . "Nuktas")
|
||||
;;; (7 . "Nuktas")
|
||||
;;; (8 . "Hiragana/Katakana voicing marks")
|
||||
;;; (9 . "Viramas")
|
||||
;;; (10 . "Start of fixed position classes")
|
||||
|
|
@ -434,6 +440,19 @@ otherwise."
|
|||
;;; (string-to-number
|
||||
;;; (nth 13 fields) 16))
|
||||
;;; ??)))))))))))
|
||||
|
||||
;; Return information about how CHAR is displayed at the buffer
|
||||
;; position POS. If the selected frame is on a graphic display,
|
||||
;; return a cons (FONTNAME . GLYPH-CODE). Otherwise, return a string
|
||||
;; describing the terminal codes for the character.
|
||||
(defun describe-char-display (pos char)
|
||||
(if (display-graphic-p (selected-frame))
|
||||
(internal-char-font pos char)
|
||||
(let* ((coding (terminal-coding-system))
|
||||
(encoded (encode-coding-char char coding)))
|
||||
(if encoded
|
||||
(encoded-string-description encoded coding)))))
|
||||
|
||||
|
||||
;;;###autoload
|
||||
(defun describe-char (pos)
|
||||
|
|
@ -449,8 +468,11 @@ as well as widgets, buttons, overlays, and text properties."
|
|||
(charset (get-char-property pos 'charset))
|
||||
(buffer (current-buffer))
|
||||
(composition (find-composition pos nil nil t))
|
||||
(composed (if composition (buffer-substring (car composition)
|
||||
(nth 1 composition))))
|
||||
(component-chars nil)
|
||||
(display-table (or (window-display-table)
|
||||
buffer-display-table
|
||||
standard-display-table))
|
||||
(disp-vector (and display-table (aref display-table char)))
|
||||
(multibyte-p enable-multibyte-characters)
|
||||
code item-list max-width)
|
||||
(or (and (charsetp charset) (encode-char char charset))
|
||||
|
|
@ -504,15 +526,46 @@ as well as widgets, buttons, overlays, and text properties."
|
|||
(format "(encoded by coding system %S)" coding))
|
||||
(list "not encodable by coding system"
|
||||
(symbol-name coding)))))
|
||||
,(if (display-graphic-p (selected-frame))
|
||||
(list "font" (or (internal-char-font pos)
|
||||
"-- none --"))
|
||||
(list "terminal code"
|
||||
(let* ((coding (terminal-coding-system))
|
||||
(encoded (encode-coding-char char coding)))
|
||||
(if encoded
|
||||
(encoded-string-description encoded coding)
|
||||
"not encodable"))))
|
||||
("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 display
|
||||
(format "terminal code %s" display)
|
||||
"not encodable for terminal"))))))
|
||||
,@(let ((unicodedata (unicode-data char)))
|
||||
(if unicodedata
|
||||
(cons (list "Unicode data" " ") unicodedata))))))
|
||||
|
|
@ -534,36 +587,68 @@ as well as widgets, buttons, overlays, and text properties."
|
|||
(when (>= (+ (current-column)
|
||||
(or (string-match "\n" clm)
|
||||
(string-width clm)) 1)
|
||||
(frame-width))
|
||||
(window-width))
|
||||
(insert "\n")
|
||||
(indent-to (1+ max-width)))
|
||||
(insert " " clm))
|
||||
(insert "\n"))))
|
||||
(when composition
|
||||
(insert "\nComposed with the "
|
||||
(cond
|
||||
((eq pos (car composition)) "following ")
|
||||
((eq (1+ pos) (cadr composition)) "preceding ")
|
||||
(t ""))
|
||||
"character(s) `"
|
||||
(cond
|
||||
((eq pos (car composition)) (substring composed 1))
|
||||
((eq (1+ pos) (cadr composition)) (substring composed 0 -1))
|
||||
(t (concat (substring composed 0 (- pos (car composition)))
|
||||
"' and `"
|
||||
(substring composed (- (1+ pos) (car composition))))))
|
||||
|
||||
"' 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 disp-vector
|
||||
(insert
|
||||
"\nThe display table entry is displayed by ")
|
||||
(if (display-graphic-p (selected-frame))
|
||||
(progn
|
||||
(insert "these fonts (glyph codes):\n")
|
||||
(dotimes (i (length disp-vector))
|
||||
(insert (car (aref disp-vector i)) ?:
|
||||
(propertize " " 'display '(space :align-to 5))
|
||||
(if (cdr (aref disp-vector i))
|
||||
(format "%s (0x%02X)" (cadr (aref disp-vector i))
|
||||
(cddr (aref disp-vector i)))
|
||||
"-- no font --")
|
||||
"\n ")))
|
||||
(insert "these terminal codes:\n")
|
||||
(dotimes (i (length disp-vector))
|
||||
(insert (car (aref disp-vector i))
|
||||
(propertize " " 'display '(space :align-to 5))
|
||||
(or (cdr (aref disp-vector i)) "-- not encodable --")
|
||||
"\n"))))
|
||||
|
||||
(when composition
|
||||
(insert "\nComposed")
|
||||
(if (car composition)
|
||||
(if (cadr composition)
|
||||
(insert " with the surrounding characters \""
|
||||
(car composition) "\" and \""
|
||||
(cadr composition) "\"")
|
||||
(insert " with the preceding character(s) \""
|
||||
(car composition) "\""))
|
||||
(if (cadr composition)
|
||||
(insert " with the following character(s) \""
|
||||
(cadr composition) "\"")))
|
||||
(insert " by the rule:\n\t("
|
||||
(mapconcat (lambda (x)
|
||||
(format (if (consp x) "%S" "?%c") x))
|
||||
(nth 2 composition)
|
||||
" ")
|
||||
")")
|
||||
(insert "\nThe component character(s) are displayed by ")
|
||||
(if (display-graphic-p (selected-frame))
|
||||
(progn
|
||||
(insert "these fonts (glyph codes):")
|
||||
(dolist (elt component-chars)
|
||||
(insert "\n " (car elt) ?:
|
||||
(propertize " " 'display '(space :align-to 5))
|
||||
(if (cdr elt)
|
||||
(format "%s (0x%02X)" (cadr elt) (cddr elt))
|
||||
"-- no font --"))))
|
||||
(insert "these terminal codes:")
|
||||
(dolist (elt component-chars)
|
||||
(insert "\n " (car elt) ":"
|
||||
(propertize " " 'display '(space :align-to 5))
|
||||
(or (cdr elt) "-- not encodable --"))))
|
||||
(insert "\nSee the variable `reference-point-alist' for "
|
||||
"the meaning of the rule.\n"))
|
||||
|
||||
(let ((output (current-buffer)))
|
||||
(with-current-buffer buffer
|
||||
|
|
@ -575,4 +660,5 @@ as well as widgets, buttons, overlays, and text properties."
|
|||
|
||||
(provide 'descr-text)
|
||||
|
||||
;;; arch-tag: fc55a498-f3e9-4312-b5bd-98cc02480af1
|
||||
;;; descr-text.el ends here
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue