;;; descr-text.el --- describe text mode
-;; Copyright (c) 1994, 95, 96, 2001, 02, 03, 04 Free Software Foundation, Inc.
+;; Copyright (c) 1994, 1995, 1996, 2001, 2002, 2003, 2004
+;; Free Software Foundation, Inc.
;; Author: Boris Goldowsky <boris@gnu.org>
;; Keywords: faces
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)
- (val nil)
- (len nil))
+ (dolist (elt (sort (let (ret)
(while properties
- (setq key (pop properties)
- val (pop properties)
- len 0)
- (unless (or (memq key '(category face font-lock-face
- syntax-table))
- (widgetp val))
- (setq val (pp-to-string val)
- len (length val)))
- (push (list key val len) ret))
+ (push (list (pop properties) (pop properties)) ret))
ret)
- (lambda (a b)
- (< (nth 2 a)
- (nth 2 b)))))
+ (lambda (a b) (string< (nth 0 a) (nth 0 b)))))
(let ((key (nth 0 elt))
(value (nth 1 elt)))
(widget-insert (propertize (format " %-20s " key)
:notify `(lambda (&rest ignore)
(describe-text-category ',value))
(format "%S" value)))
- ((memq key '(face font-lock-face))
+ ((memq key '(face font-lock-face mouse-face))
(widget-create 'link
:notify `(lambda (&rest ignore)
(describe-face ',value))
(format "%S" value)))
- ((eq key 'syntax-table)
- (widget-create 'push-button
- :tag "show"
- :action (lambda (widget &optional event)
- (with-output-to-temp-buffer
- "*Pp Eval Output*"
- (pp (widget-get widget :value))))
- value))
((widgetp value)
(describe-text-widget value))
(t
- (widget-insert value))))
+ (describe-text-sexp value))))
(widget-insert "\n")))
\f
;;; Describe-Text Commands.
(describe-text-properties-1 pos output-buffer)
(if (not (or (text-properties-at pos) (overlays-at pos)))
(message "This is plain text.")
- (let ((buffer (current-buffer)))
- (when (eq buffer (get-buffer "*Help*"))
- (error "Can't do self inspection"))
+ (let ((buffer (current-buffer))
+ (target-buffer "*Help*"))
+ (when (eq buffer (get-buffer target-buffer))
+ (setq target-buffer "*Help-2*"))
(save-excursion
- (with-output-to-temp-buffer "*Help*"
+ (with-output-to-temp-buffer target-buffer
(set-buffer standard-output)
(setq output-buffer (current-buffer))
(widget-insert "Text content at position " (format "%d" pos) ":\n\n")
(push (format "%s;" (pop props)) ps))
(list (cons "Properties" (nreverse ps)))))
("to input"
- ,@(let ((key-list (and current-input-method
+ ,@(let ((key-list (and (eq input-method-function
+ 'quail-input-method)
(quail-find-key char))))
(if (consp key-list)
(list "type"
(dotimes (i (length disp-vector))
(setq char (aref disp-vector i))
(aset disp-vector i
- (cons char (describe-char-display pos char))))
+ (cons char (describe-char-display
+ pos (logand char #x7ffff)))))
(format "by display table entry [%s] (see below)"
- (mapconcat #'(lambda (x) (format "?%c" (car x)))
- disp-vector " ")))
+ (mapconcat
+ #'(lambda (x)
+ (if (> (car x) #x7ffff)
+ (format "?%c<face-id=%s>"
+ (logand (car x) #x7ffff)
+ (lsh (car x) -19))
+ (format "?%c" (car x))))
+ disp-vector " ")))
(composition
(let ((from (car composition))
(to (nth 1 composition))
(progn
(insert "these fonts (glyph codes):\n")
(dotimes (i (length disp-vector))
- (insert (car (aref disp-vector i)) ?:
+ (insert (logand (car (aref disp-vector i)) #x7ffff) ?:
(propertize " " 'display '(space :align-to 5))
(if (cdr (aref disp-vector i))
(format "%s (0x%02X)" (cadr (aref disp-vector i))
(provide 'descr-text)
-;;; arch-tag: fc55a498-f3e9-4312-b5bd-98cc02480af1
+;; arch-tag: fc55a498-f3e9-4312-b5bd-98cc02480af1
;;; descr-text.el ends here