Mercurial > emacs
changeset 55898:7f92c3f5d841
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-368
Improve display-supports-face-attributes-p on non-ttys
| author | Miles Bader <miles@gnu.org> |
|---|---|
| date | Fri, 04 Jun 2004 02:50:11 +0000 |
| parents | 305e52f43c69 |
| children | 4592654cd2e9 |
| files | lisp/ChangeLog lisp/faces.el |
| diffstat | 2 files changed, 24 insertions(+), 5 deletions(-) [+] |
line wrap: on
line diff
--- a/lisp/ChangeLog Fri Jun 04 00:12:24 2004 +0000 +++ b/lisp/ChangeLog Fri Jun 04 02:50:11 2004 +0000 @@ -1,3 +1,8 @@ +2004-06-04 Miles Bader <miles@gnu.org> + + * faces.el (display-supports-face-attributes-p): Implement a + `different from default' check for non-tty displays. + 2004-06-03 David Kastrup <dak@gnu.org> * woman.el (woman-mapcan): More concise code.
--- a/lisp/faces.el Fri Jun 04 00:12:24 2004 +0000 +++ b/lisp/faces.el Fri Jun 04 02:50:11 2004 +0000 @@ -1510,11 +1510,25 @@ (if (framep display) display (car (frames-on-display-list display))))) - ;; For now, we assume that non-tty displays can support everything. - ;; Later, we should add the ability to query about specific fonts, - ;; colors, etc. - (or (memq (framep frame) '(x w32 mac)) - (tty-supports-face-attributes-p attributes frame)))) + (if (not (memq (framep frame) '(x w32 mac))) + ;; On ttys, `tty-supports-face-attributes-p' does all the work we need. + (tty-supports-face-attributes-p attributes frame) + ;; For now, we assume that non-tty displays can support everything, + ;; and so we just check to see if any of the specified attributes is + ;; different from the default -- though this probably isn't always + ;; accurate for font-related attributes. Later, we should add the + ;; ability to query about specific fonts, colors, etc. + (while (and attributes + (let* ((attr (car attributes)) + (val (cadr attributes)) + (default-val (face-attribute 'default attr frame))) + (if (and (stringp val) (stringp default-val)) + ;; compare string attributes case-insensitively + (eq (compare-strings val nil nil default-val nil nil t) + t) + (equal val default-val)))) + (setq attributes (cddr attributes))) + (not (null attributes))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;