(list-text-properties-at): Display category's properties.

diff --git a/lisp/facemenu.el b/lisp/facemenu.el
index f1d92932cb53304bd0e81052d52fe9c606dfd452..220b0f1fd921a66ed175e1138108ff4d49e75e11 100644 (file)
--- a/lisp/facemenu.el
+++ b/lisp/facemenu.el
@@ -408,10 +408,12 @@ These special properties include `invisible', `intangible' and `read-only'."
   "Pop up a buffer listing text-properties at LOCATION."
   (interactive "d")
   (let ((props (text-properties-at p))
+       category
        str)
     (if (null props)
        (message "None")
       (if (and (not (cdr (cdr props)))
+              (not (eq (car props) 'category))
               (< (length (setq str (format "Text property at %d:  %s  %S"
                                            p (car props) (car (cdr props)))))
                  (frame-width)))
@@ -419,9 +421,21 @@ These special properties include `invisible', `intangible' and `read-only'."
        (with-output-to-temp-buffer "*Text Properties*"
          (princ (format "Text properties at %d:\n\n" p))
          (while props
+           (if (eq (car props) 'category)
+               (setq category (car (cdr props))))
            (princ (format "%-20s %S\n"
                           (car props) (car (cdr props))))
-           (setq props (cdr (cdr props)))))))))
+           (setq props (cdr (cdr props))))
+         (if category
+             (progn
+               (setq props (symbol-plist category))
+               (princ (format "\nCategory %s:\n\n" category))
+               (while props
+                 (princ (format "%-20s %S\n"
+                                (car props) (car (cdr props))))
+                 (if (eq (car props) 'category)
+                     (setq category (car (cdr props))))
+                 (setq props (cdr (cdr props)))))))))))
 
 ;;;###autoload
 (defun facemenu-read-color (&optional prompt)