From mboxrd@z Thu Jan 1 00:00:00 1970 Path: quimby.gnus.org!not-for-mail From: Per Abrahamsen Newsgroups: gmane.emacs.devel Subject: List Text Properties Date: Tue, 12 Feb 2002 16:25:06 +0100 Organization: The Church of Emacs Message-ID: NNTP-Posting-Host: quimby2.netfonds.no Mime-Version: 1.0 Content-Type: text/plain; charset=us-ascii X-Trace: quimby2.netfonds.no 1013528292 11810 195.204.10.66 (12 Feb 2002 15:38:12 GMT) X-Complaints-To: usenet@quimby2.netfonds.no NNTP-Posting-Date: 12 Feb 2002 15:38:12 GMT Original-Received: from fencepost.gnu.org ([199.232.76.164]) by quimby2.netfonds.no with esmtp (Exim 3.12 #1 (Debian)) id 16af0V-00034O-00 for ; Tue, 12 Feb 2002 16:38:11 +0100 Original-Received: from localhost ([127.0.0.1] helo=fencepost.gnu.org) by fencepost.gnu.org with esmtp (Exim 3.33 #1 (Debian)) id 16aeq8-0005WM-00; Tue, 12 Feb 2002 10:27:28 -0500 Original-Received: from sheridan.dina.kvl.dk ([130.225.40.227]) by fencepost.gnu.org with esmtp (Exim 3.33 #1 (Debian)) id 16aenu-0005Mt-00 for ; Tue, 12 Feb 2002 10:25:10 -0500 Original-Received: from ssv2.dina.kvl.dk (ssv2.dina.kvl.dk [130.225.40.226]) by sheridan.dina.kvl.dk (8.9.3/8.9.3/Debian 8.9.3-21) with ESMTP id QAA10859; Tue, 12 Feb 2002 16:25:06 +0100 Original-Received: from abraham by ssv2.dina.kvl.dk with local (Exim 3.12 #1 (Debian)) id 16aenq-0007ec-00; Tue, 12 Feb 2002 16:25:06 +0100 Original-To: emacs-devel@gnu.org X-Face: +kRV2]2q}lixHkE{U)mY#+6]{AH=yN~S9@IFiOa@X6?GM|8MBp/ Original-Lines: 197 User-Agent: Gnus/5.090006 (Oort Gnus v0.06) Emacs/21.1 (i686-pc-linux-gnu) Errors-To: emacs-devel-admin@gnu.org X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.0.5 Precedence: bulk List-Help: List-Post: List-Subscribe: , List-Id: Emacs development discussions. List-Unsubscribe: , List-Archive: Xref: quimby.gnus.org gmane.emacs.devel:1040 X-Report-Spam: http://spam.gmane.org/gmane.emacs.devel:1040 A long time ago, I complained that Edit -> Text Properties -> List Properties did not list overlays, which made it hard to use it as a "here is some weird text, what is going on?" tool, and got an OK to include overlays in the list. Here is an implementation that list widgets, buttons, overlays and text properties. I called it `describe-text-at'. I'd like to replace the call to `list-text-properties-at' in the menu with this function. Is it ok to install? Eval the code, and type `M-x describe-text-at ' while point is somewhere interesting to test. ;;;; Move to wid-edit.el: ;;;###autoload (defun widgetp (widget) "Return non-nil iff WIDGET is a widget." (if (symbolp widget) (get widget 'widget-type) (and (consp widget) (get (widget-type widget) 'widget-type)))) ;;;; Move to facemenu.el: ;;; 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 nil "Keymap for `describe-text-mode'.") (unless describe-text-mode-map (setq describe-text-mode-map (make-sparse-keymap)) (set-keymap-parent describe-text-mode-map widget-keymap) (define-key describe-text-mode-map "q" 'describe-text-done)) (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. (define-widget 'describe-text-close 'push-button "Add a `close' button." :tag "Close" :action (lambda (&rest ignore) (describe-text-done))) (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 value) (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)) (widget-insert "\n") (widget-create 'describe-text-close) (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 "Self inspection not supported")) (when (get-buffer "*Text Description*") (kill-buffer "*Text Description*")) (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)) (button (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))) (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 `" (format "%S" 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)) (widget-insert "\n") (widget-create 'describe-text-close) (describe-text-mode) (goto-char (point-min)))))) ;;; Code to facemenu.el ends here. _______________________________________________ Emacs-devel mailing list Emacs-devel@gnu.org http://mail.gnu.org/mailman/listinfo/emacs-devel