Mercurial > emacs
changeset 101128:311f898c790b
(describe-face): Ignore anonymous faces.
author | Chong Yidong <cyd@stupidchicken.com> |
---|---|
date | Sun, 11 Jan 2009 17:27:37 +0000 |
parents | 1f33f73056ae |
children | 25d50d869d34 |
files | lisp/faces.el |
diffstat | 1 files changed, 44 insertions(+), 40 deletions(-) [+] |
line wrap: on
line diff
--- a/lisp/faces.el Sun Jan 11 17:27:24 2009 +0000 +++ b/lisp/faces.el Sun Jan 11 17:27:37 2009 +0000 @@ -1357,46 +1357,50 @@ (set-buffer standard-output) (dolist (f face) (if (stringp f) (setq f (intern f))) - (insert "Face: " (symbol-name f)) - (if (not (facep f)) - (insert " undefined face.\n") - (let ((customize-label "customize this face") - file-name) - (insert (concat " (" (propertize "sample" 'font-lock-face f) ")")) - (princ (concat " (" customize-label ")\n")) - (insert "Documentation: " - (or (face-documentation f) - "Not documented as a face.") - "\n") - (with-current-buffer standard-output - (save-excursion - (re-search-backward - (concat "\\(" customize-label "\\)") nil t) - (help-xref-button 1 'help-customize-face f))) - (setq file-name (find-lisp-object-file-name f 'defface)) - (when file-name - (princ "Defined in `") - (princ (file-name-nondirectory file-name)) - (princ "'") - ;; Make a hyperlink to the library. - (save-excursion - (re-search-backward "`\\([^`']+\\)'" nil t) - (help-xref-button 1 'help-face-def f file-name)) - (princ ".") - (terpri) - (terpri)) - (dolist (a attrs) - (let ((attr (face-attribute f (car a) frame))) - (insert (make-string (- max-width (length (cdr a))) ?\s) - (cdr a) ": " (format "%s" attr)) - (if (and (eq (car a) :inherit) - (not (eq attr 'unspecified))) - ;; Make a hyperlink to the parent face. - (save-excursion - (re-search-backward ": \\([^:]+\\)" nil t) - (help-xref-button 1 'help-face attr))) - (insert "\n"))))) - (terpri)))))) + ;; We may get called for anonymous faces (i.e., faces + ;; expressed using prop-value plists). Those can't be + ;; usefully customized, so ignore them. + (when (symbolp f) + (insert "Face: " (symbol-name f)) + (if (not (facep f)) + (insert " undefined face.\n") + (let ((customize-label "customize this face") + file-name) + (insert (concat " (" (propertize "sample" 'font-lock-face f) ")")) + (princ (concat " (" customize-label ")\n")) + (insert "Documentation: " + (or (face-documentation f) + "Not documented as a face.") + "\n") + (with-current-buffer standard-output + (save-excursion + (re-search-backward + (concat "\\(" customize-label "\\)") nil t) + (help-xref-button 1 'help-customize-face f))) + (setq file-name (find-lisp-object-file-name f 'defface)) + (when file-name + (princ "Defined in `") + (princ (file-name-nondirectory file-name)) + (princ "'") + ;; Make a hyperlink to the library. + (save-excursion + (re-search-backward "`\\([^`']+\\)'" nil t) + (help-xref-button 1 'help-face-def f file-name)) + (princ ".") + (terpri) + (terpri)) + (dolist (a attrs) + (let ((attr (face-attribute f (car a) frame))) + (insert (make-string (- max-width (length (cdr a))) ?\s) + (cdr a) ": " (format "%s" attr)) + (if (and (eq (car a) :inherit) + (not (eq attr 'unspecified))) + ;; Make a hyperlink to the parent face. + (save-excursion + (re-search-backward ": \\([^:]+\\)" nil t) + (help-xref-button 1 'help-face attr))) + (insert "\n"))))) + (terpri))))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;