changeset 55899:4592654cd2e9

Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-369 Rewrite face-differs-from-default-p
author Miles Bader <miles@gnu.org>
date Fri, 04 Jun 2004 02:50:50 +0000
parents 7f92c3f5d841
children d8a2b8a11274
files etc/NEWS lisp/ChangeLog lisp/faces.el lispref/display.texi
diffstat 4 files changed, 47 insertions(+), 23 deletions(-) [+]
line wrap: on
line diff
--- a/etc/NEWS	Fri Jun 04 02:50:11 2004 +0000
+++ b/etc/NEWS	Fri Jun 04 02:50:50 2004 +0000
@@ -3032,6 +3032,10 @@
 specification language, which can be used to do this test for faces
 defined with defface.
 
+** The function face-differs-from-default-p now truly checks whether the
+given face displays differently from the default face or not (previously
+it did only a very cursory check).
+
 +++
 ** face-attribute, face-foreground, face-background, and face-stipple now
 accept a new optional argument, INHERIT, which controls how face
--- a/lisp/ChangeLog	Fri Jun 04 02:50:11 2004 +0000
+++ b/lisp/ChangeLog	Fri Jun 04 02:50:50 2004 +0000
@@ -1,3 +1,9 @@
+2004-06-04  Miles Bader  <miles@gnu.org>
+
+	* faces.el (face-differs-from-default-p): Use a different
+	implementation, so we can really check whether FACE displays
+	differently or not.
+
 2004-06-04  Miles Bader  <miles@gnu.org>
 
 	* faces.el (display-supports-face-attributes-p): Implement a
--- a/lisp/faces.el	Fri Jun 04 02:50:11 2004 +0000
+++ b/lisp/faces.el	Fri Jun 04 02:50:50 2004 +0000
@@ -240,27 +240,43 @@
 
 
 (defun face-differs-from-default-p (face &optional frame)
-  "Non-nil if FACE displays differently from the default face.
+  "Return non-nil if FACE displays differently from the default face.
 If the optional argument FRAME is given, report on face FACE in that frame.
 If FRAME is t, report on the defaults for face FACE (for new frames).
-If FRAME is omitted or nil, use the selected frame.
-A face is considered to be ``the same'' as the default face if it is
-actually specified in the same way (equal attributes) or if it is
-fully-unspecified, and thus inherits the attributes of any face it
-is displayed on top of."
-  (cond ((eq frame t) (setq frame nil))
-	((null frame) (setq frame (selected-frame))))
-  (let* ((v1 (internal-lisp-face-p face frame))
-	 (n (if v1 (length v1) 0))
-	 (v2 (internal-lisp-face-p 'default frame))
-	 (i 1))
-    (unless v1
-      (error "Not a face: %S" face))
-    (while (and (< i n)
-		(or (eq 'unspecified (aref v1 i))
-		    (equal (aref v1 i) (aref v2 i))))
-      (setq i (1+ i)))
-    (< i n)))
+If FRAME is omitted or nil, use the selected frame."
+  (if (not (equal (face-font face frame) (face-font 'default frame)))
+      ;; The font is different from the default face's font, so clearly it
+      ;; differs.  This only really works on window-systems; on ttys, the
+      ;; "font" is a constant, with attributes layered on top of it.
+      :font
+    ;; General face attribute check.  On graphical displays
+    ;; `display-supports-face-attributes-p' just checks whether each
+    ;; attribute is different that the default face, so we just check to
+    ;; make sure each attribute of the merged face is not `unspecified';
+    ;; we already checked the font above, so font-related attributes are
+    ;; omitted for that reason.  On a tty,
+    ;; display-supports-face-attributes-p actually does do further
+    ;; checks, and correctly deals with the display's capabilities, so
+    ;; we use it to check all attributes.
+    (let ((attrs
+	   (if (memq (framep (or frame (selected-frame))) '(x w32 mac))
+	       ;; Omit font-related attributes on a window-system
+	       '(:foreground :foreground :background :underline :overline
+		 :strike-through :box :inverse-video :stipple)
+	     ;; On a tty, check all attributes
+	     '(:family :width :height :weight :slant :foreground
+	       :foreground :background :underline :overline
+	       :strike-through :box :inverse-video :stipple)))
+	  (differs nil))
+      (while (and attrs (not differs))
+	(let* ((attr (pop attrs))
+	       (attr-val (face-attribute face attr frame t)))
+	  (when (and
+		 (not (eq attr-val 'unspecified))
+		 (display-supports-face-attributes-p (list attr attr-val)
+						     frame))
+	    (setq differs attr))))
+      differs)))
 
 
 (defun face-nontrivial-p (face &optional frame)
--- a/lispref/display.texi	Fri Jun 04 02:50:11 2004 +0000
+++ b/lispref/display.texi	Fri Jun 04 02:50:50 2004 +0000
@@ -2288,10 +2288,8 @@
 @end defun
 
 @defun face-differs-from-default-p face &optional frame
-This returns @code{t} if the face @var{face} displays differently from
-the default face.  A face is considered to be ``the same'' as the
-default face if each attribute is either the same as that of the default
-face, or unspecified (meaning to inherit from the default).
+This returns non-@code{nil} if the face @var{face} displays
+differently from the default face.
 @end defun
 
 @node Auto Faces