# HG changeset patch # User Richard M. Stallman # Date 1020142764 0 # Node ID beb07a65a44588e4c85e97a2538a16a45bc65a46 # Parent 73b950c09e00bee91d4b19a8b56edebe0fbfd263 (describe-text-at and stuff): Moved to descr-text.el. diff -r 73b950c09e00 -r beb07a65a445 lisp/facemenu.el --- a/lisp/facemenu.el Tue Apr 30 04:20:25 2002 +0000 +++ b/lisp/facemenu.el Tue Apr 30 04:59:24 2002 +0000 @@ -461,164 +461,6 @@ (remove-text-properties start end '(invisible nil intangible nil read-only nil)))) -;;; Describe-Text Mode. - -(defun describe-text-done () - "Delete the current window or bury the current buffer." - (interactive) - (if (> (count-windows) 1) - (delete-window) - (bury-buffer))) - -(defvar describe-text-mode-map - (let ((map (make-sparse-keymap))) - (set-keymap-parent map widget-keymap) - map) - "Keymap for `describe-text-mode'.") - -(defcustom describe-text-mode-hook nil - "List of hook functions ran by `describe-text-mode'." - :type 'hook) - -(defun describe-text-mode () - "Major mode for buffers created by `describe-text-at'. - -\\{describe-text-mode-map} -Entry to this mode calls the value of `describe-text-mode-hook' -if that value is non-nil." - (kill-all-local-variables) - (setq major-mode 'describe-text-mode - mode-name "Describe-Text") - (use-local-map describe-text-mode-map) - (widget-setup) - (run-hooks 'describe-text-mode-hook)) - -;;; Describe-Text Utilities. - -(defun describe-text-widget (widget) - "Insert text to describe WIDGET in the current buffer." - (widget-create 'link - :notify `(lambda (&rest ignore) - (widget-browse ',widget)) - (format "%S" (if (symbolp widget) - widget - (car widget)))) - (widget-insert " ") - (widget-create 'info-link :tag "widget" "(widget)Top")) - -(defun describe-text-sexp (sexp) - "Insert a short description of SEXP in the current buffer." - (let ((pp (condition-case signal - (pp-to-string sexp) - (error (prin1-to-string signal))))) - (when (string-match "\n\\'" pp) - (setq pp (substring pp 0 (1- (length pp))))) - (if (cond ((string-match "\n" pp) - nil) - ((> (length pp) (- (window-width) (current-column))) - nil) - (t t)) - (widget-insert pp) - (widget-create 'push-button - :tag "show" - :action (lambda (widget &optional event) - (with-output-to-temp-buffer - "*Pp Eval Output*" - (princ (widget-get widget :value)))) - pp)))) - - -(defun describe-text-properties (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." - (while properties - (widget-insert (format " %-20s " (car properties))) - (let ((key (nth 0 properties)) - (value (nth 1 properties))) - (cond ((eq key 'category) - (widget-create 'link - :notify `(lambda (&rest ignore) - (describe-text-category ',value)) - (format "%S" value))) - ((widgetp value) - (describe-text-widget value)) - (t - (describe-text-sexp value)))) - (widget-insert "\n") - (setq properties (cdr (cdr properties))))) - -;;; Describe-Text Commands. - -(defun describe-text-category (category) - "Describe a text property category." - (interactive "S") - (when (get-buffer "*Text Category*") - (kill-buffer "*Text Category*")) - (save-excursion - (with-output-to-temp-buffer "*Text Category*" - (set-buffer "*Text Category*") - (widget-insert "Category " (format "%S" category) ":\n\n") - (describe-text-properties (symbol-plist category)) - (describe-text-mode) - (goto-char (point-min))))) - -;;;###autoload -(defun describe-text-at (pos) - "Describe widgets, buttons, overlays and text properties at POS." - (interactive "d") - (when (eq (current-buffer) (get-buffer "*Text Description*")) - (error "Can't do self inspection")) - (let* ((properties (text-properties-at pos)) - (overlays (overlays-at pos)) - overlay - (wid-field (get-char-property pos 'field)) - (wid-button (get-char-property pos 'button)) - (wid-doc (get-char-property pos 'widget-doc)) - ;; If button.el is not loaded, we have no buttons in the text. - (button (and (fboundp 'button-at) (button-at pos))) - (button-type (and button (button-type button))) - (button-label (and button (button-label button))) - (widget (or wid-field wid-button wid-doc))) - (if (not (or properties overlays)) - (message "This is plain text.") - (when (get-buffer "*Text Description*") - (kill-buffer "*Text Description*")) - (save-excursion - (with-output-to-temp-buffer "*Text Description*" - (set-buffer "*Text Description*") - (widget-insert "Text content at position " (format "%d" pos) ":\n\n") - ;; Widgets - (when (widgetp widget) - (widget-insert (cond (wid-field "This is an editable text area") - (wid-button "This is an active area") - (wid-doc "This is documentation text"))) - (widget-insert " of a ") - (describe-text-widget widget) - (widget-insert ".\n\n")) - ;; Buttons - (when (and button (not (widgetp wid-button))) - (widget-insert "Here is a " (format "%S" button-type) - " button labeled `" button-label "'.\n\n")) - ;; Overlays - (when overlays - (if (eq (length overlays) 1) - (widget-insert "There is an overlay here:\n") - (widget-insert "There are " (format "%d" (length overlays)) - " overlays here:\n")) - (dolist (overlay overlays) - (widget-insert " From " (format "%d" (overlay-start overlay)) - " to " (format "%d" (overlay-end overlay)) "\n") - (describe-text-properties (overlay-properties overlay))) - (widget-insert "\n")) - ;; Text properties - (when properties - (widget-insert "There are text properties here:\n") - (describe-text-properties properties)) - (describe-text-mode) - (goto-char (point-min))))))) - ;;;###autoload (defun facemenu-read-color (&optional prompt) "Read a color using the minibuffer."