From: Miles Bader <miles@gnu.org>
Date: Fri, 4 Jun 2004 02:50:11 +0000 (+0000)
Subject: Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-368
X-Git-Tag: ttn-vms-21-2-B4~5950
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=421c91e527cb39fc60480394f3c069914feb3d34;p=emacs.git

Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-368

Improve display-supports-face-attributes-p on non-ttys
---

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index a25bda7392f..c4f861626fd 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -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.
diff --git a/lisp/faces.el b/lisp/faces.el
index 05a4fd7e82c..03e2ee699e7 100644
--- a/lisp/faces.el
+++ b/lisp/faces.el
@@ -1510,11 +1510,25 @@ face for italic."
 	 (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)))))
 
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;