Mercurial > emacs

--- a/etc/NEWS	Thu Jun 03 16:45:20 2004 +0000
+++ b/etc/NEWS	Sat Jun 05 17:21:43 2004 +0000
@@ -107,7 +107,8 @@

 ** Help commands `describe-funcion' and `describe-key' now show function
 arguments in lowercase italics on displays that support it.  To change the
-default, redefine the function `help-default-arg-highlight'.
+default, customize face `help-argument-name' or redefine the function
+`help-default-arg-highlight'.

 ---
 ** The comint prompt can now be made read-only, using the new user
@@ -3032,6 +3033,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	Thu Jun 03 16:45:20 2004 +0000
+++ b/lisp/ChangeLog	Sat Jun 05 17:21:43 2004 +0000
@@ -1,3 +1,59 @@
+2004-06-05  Juanma Barranquero  <lektu@terra.es>
+
+	* help-fns.el (help-argument-name): Reintroduce face.
+	(help-default-arg-highlight): Use it, now that
+	`face-differs-from-default-p' can be trusted.
+
+2004-06-05  Matt Hodges  <matt@stchem.bham.ac.uk>  (tiny change)
+
+	* textmodes/table.el: Sentence commands added to Point Motion
+	group; kill and backward-kill commands added to Extraction group.
+
+2004-06-04  Mario Lang  <mlang@delysid.org>
+
+	* battery.el (battery-linux-proc-acpi): mA was hardcored, but some
+	systems appear to use mW, make the code handle this.  Fix a
+	division-by-zero bug while at it, and handle kernels with
+	a slightly different layout in /proc/acpi.
+
+2004-06-04  Karl Fogel  <kfogel@red-bean.com>
+
+	* vc-svn.el (vc-svn-checkin): Use 'nconc' instead of 'list*',
+	because the latter is a CL-ism.  This fixes the bug reported by
+	Shawn Boyette <mdxi@collapsar.net> in
+        http://lists.gnu.org/archive/html/emacs-devel/2004-05/msg00442.html.
+
+2004-06-04  Miles Bader  <miles@gnu.org>
+
+	* faces.el (display-supports-face-attributes-p): Function moved to
+	C code.  Previously only the tty-related portion of this function
+	was done in C; however the previous attempt to do a halfway-proper
+	job for non-tty displays in lisp didn't work properly because of
+	funny conditions during Emacs startup.
+	(face-differs-from-default-p): Simplify, now that
+	display-supports-face-attributes-p works properly on all display
+	types.  Remove :stipple from comparison; it doesn't really work
+	in emacs anyway.
+
+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
+	`different from default' check for non-tty displays.
+
+2004-06-03  David Kastrup  <dak@gnu.org>
+
+	* woman.el (woman-mapcan): More concise code.
+	(woman-topic-all-completions, woman-topic-all-completions-1)
+	(woman-topic-all-completions-merge): Replace by a simpler and
+	much faster implementation based on O(n log n) sort/merge instead
+	of the old O(n^2) behavior.
+
 2004-06-03  Miles Bader  <miles@gnu.org>

 	* subr.el (read-number): Use canonical format for default in prompt.
@@ -193,7 +249,7 @@
 	* thumbs.el (thumbs-show-name): Do nothing if no image at point.
 	(thumbs-mouse-find-image): New command.
 	(thumbs-mode-map): Bind it to mouse-2.
-	(thumbs-mode):  Make mode-class special.
+	(thumbs-mode): Make mode-class special.
 	(thumbs-view-image-mode): Likewise.

 2004-05-29  Pavel Kobiakov  <pk_at_work@yahoo.com>
@@ -1382,7 +1438,7 @@
 	(sql-connect-postgres): Add username prompt.
 	(sql-imenu-generic-expression, sql-mode-font-lock-object-name):
 	Make patterns less product specific.
-	(sql-xemacs-p, sql-emacs19-p): Add flags for emacs variants.
+	(sql-xemacs-p, sql-emacs19-p): Add flags for Emacs variants.
 	(sql-mode-abbrev-table): Modify initialization.
 	(sql-builtin-face): Add variable.
 	(sql-keywords-re): Add macro.
@@ -6381,7 +6437,7 @@
 	(ffap-file-at-point): Use the new regexp to strip the prompts from
 	the file names.  This is an issue mostly for user prompts that
 	don't have a trailing space and find-file-at-point is invoked from
-	within a shell inside emacs.
+	within a shell inside Emacs.

 2003-09-24  Andre Spiegel  <spiegel@gnu.org>
--- a/lisp/battery.el	Thu Jun 03 16:45:20 2004 +0000
+++ b/lisp/battery.el	Sat Jun 05 17:21:43 2004 +0000
@@ -61,7 +61,7 @@
   (cond ((eq battery-status-function 'battery-linux-proc-apm)
 	 "Power %L, battery %B (%p%% load, remaining time %t)")
 	((eq battery-status-function 'battery-linux-proc-acpi)
-	 "Power %L, battery %B at %r mA (%p%% load, remaining time %t)"))
+	 "Power %L, battery %B at %r (%p%% load, remaining time %t)"))
   "*Control string formatting the string to display in the echo area.
 Ordinary characters in the control string are printed as-is, while
 conversion specifications introduced by a `%' character in the control
@@ -243,7 +243,8 @@
 %m Remaining time in minutes
 %h Remaining time in hours
 %t Remaining time in the form `h:min'"
-  (let (capacity design-capacity rate charging-state warn low minutes hours)
+  (let (capacity design-capacity rate rate-type charging-state warn low
+		 minutes hours)
     (when (file-directory-p "/proc/acpi/battery/")
       ;; ACPI provides information about each battery present in the system in
       ;; a separate subdirectory.  We are going to merge the available
@@ -261,32 +262,41 @@
 		  ;; battery is "charging"/"discharging", the others are
 		  ;; "unknown".
 		  (setq charging-state (match-string 1)))
-	     (when (re-search-forward "present rate: +\\([0-9]+\\) mA$" nil t)
-	       (setq rate (+ (or rate 0) (string-to-int (match-string 1)))))
-	     (when (re-search-forward "remaining capacity: +\\([0-9]+\\) mAh$"
+	     (when (re-search-forward "present rate: +\\([0-9]+\\) \\(m[AW]\\)$"
+				      nil t)
+	       (setq rate (+ (or rate 0) (string-to-int (match-string 1)))
+		     rate-type (or (and rate-type
+					(if (string= rate-type (match-string 2))
+					    rate-type
+					  (error
+					   "Inconsistent rate types (%s vs. %s)"
+					   rate-type (match-string 2))))
+				   (match-string 2))))
+	     (when (re-search-forward "remaining capacity: +\\([0-9]+\\) m[AW]h$"
 				      nil t)
 	       (setq capacity
 		     (+ (or capacity 0) (string-to-int (match-string 1))))))
 	   (goto-char (point-max))
 	   (insert-file-contents (expand-file-name "info" dir))
 	   (when (re-search-forward "present: +yes$" nil t)
-	     (when (re-search-forward "design capacity: +\\([0-9]+\\) mAh$"
+	     (when (re-search-forward "design capacity: +\\([0-9]+\\) m[AW]h$"
 				      nil t)
 	       (setq design-capacity (+ (or design-capacity 0)
 					(string-to-int (match-string 1)))))
-	     (when (re-search-forward "design capacity warning: +\\([0-9]+\\) mAh$"
+	     (when (re-search-forward "design capacity warning: +\\([0-9]+\\) m[AW]h$"
 				      nil t)
 	       (setq warn (+ (or warn 0) (string-to-int (match-string 1)))))
-	     (when (re-search-forward "design capacity low: +\\([0-9]+\\) mAh$"
+	     (when (re-search-forward "design capacity low: +\\([0-9]+\\) m[AW]h$"
 				      nil t)
 	       (setq low (+ (or low 0)
 			    (string-to-int (match-string 1))))))))
        (directory-files "/proc/acpi/battery/" t "BAT")))
     (and capacity rate
-	 (setq minutes (floor (* (/ (float (if (string= charging-state
-							"charging")
-					       (- design-capacity capacity)
-					     capacity)) rate) 60))
+	 (setq minutes (if (zerop rate) 0
+			 (floor (* (/ (float (if (string= charging-state
+							  "charging")
+						 (- design-capacity capacity)
+					       capacity)) rate) 60)))
 	       hours (/ minutes 60)))
     (list (cons ?c (or (and capacity (number-to-string capacity)) "N/A"))
 	  (cons ?L (or (when (file-exists-p "/proc/acpi/ac_adapter/AC/state")
@@ -304,8 +314,17 @@
 			   (when (re-search-forward
 				  "temperature: +\\([0-9]+\\) C$" nil t)
 			     (match-string 1))))
+		       (when (file-exists-p
+			      "/proc/acpi/thermal_zone/THM/temperature")
+			 (with-temp-buffer
+			   (insert-file-contents
+			    "/proc/acpi/thermal_zone/THM/temperature")
+			   (when (re-search-forward
+				  "temperature: +\\([0-9]+\\) C$" nil t)
+			     (match-string 1))))
 		       "N/A"))
-	  (cons ?r (or (and rate (number-to-string rate)) "N/A"))
+	  (cons ?r (or (and rate (concat (number-to-string rate) " "
+					 rate-type)) "N/A"))
 	  (cons ?B (or charging-state "N/A"))
 	  (cons ?b (or (and (string= charging-state "charging") "+")
 		       (and low (< capacity low) "!")
--- a/lisp/faces.el	Thu Jun 03 16:45:20 2004 +0000
+++ b/lisp/faces.el	Sat Jun 05 17:21:43 2004 +0000
@@ -240,27 +240,24 @@


 (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."
+  (let ((attrs
+	 '(:family :width :height :weight :slant :foreground
+	   :foreground :background :underline :overline
+	   :strike-through :box :inverse-video))
+	(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)
@@ -1489,33 +1486,6 @@
      (t
       (> (tty-color-gray-shades display) 2)))))

-(defun display-supports-face-attributes-p (attributes &optional display)
-  "Return non-nil if all the face attributes in ATTRIBUTES are supported.
-The optional argument DISPLAY can be a display name, a frame, or
-nil (meaning the selected frame's display)
-
-The definition of `supported' is somewhat heuristic, but basically means
-that a face containing all the attributes in ATTRIBUTES, when merged
-with the default face for display, can be represented in a way that's
-
- (1) different in appearance than the default face, and
- (2) `close in spirit' to what the attributes specify, if not exact.
-
-Point (2) implies that a `:weight black' attribute will be satisfied by
-any display that can display bold, and a `:foreground \"yellow\"' as long
-as it can display a yellowish color, but `:slant italic' will _not_ be
-satisfied by the tty display code's automatic substitution of a `dim'
-face for italic."
-  (let ((frame
-	 (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))))
-

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; Background mode.
--- a/lisp/help-fns.el	Thu Jun 03 16:45:20 2004 +0000
+++ b/lisp/help-fns.el	Sat Jun 05 17:21:43 2004 +0000
@@ -237,14 +237,19 @@
 	    (concat "src/" file)
 	  file)))))

+;;;###autoload
+(defface help-argument-name '((((supports :slant italic)) :inherit italic))
+  "Face to highlight argument names in *Help* buffers.")
+
 (defun help-default-arg-highlight (arg)
   "Default function to highlight arguments in *Help* buffers.
-It returns ARG in lowercase italics, if the display supports it;
-else ARG is returned in uppercase normal."
-  (let ((attrs '(:slant italic)))
-    (if (display-supports-face-attributes-p attrs)
-        (propertize (downcase arg) 'face attrs)
-      arg)))
+It returns ARG in face `help-argument-name'; ARG is also
+downcased if it displays differently than the default
+face (according to `face-differs-from-default-p')."
+  (propertize (if (face-differs-from-default-p 'help-argument-name)
+                  (downcase arg)
+                arg)
+              'face 'help-argument-name))

 (defun help-do-arg-highlight (doc args)
   (with-syntax-table (make-syntax-table emacs-lisp-mode-syntax-table)
--- a/lisp/textmodes/table.el	Thu Jun 03 16:45:20 2004 +0000
+++ b/lisp/textmodes/table.el	Sat Jun 05 17:21:43 2004 +0000
@@ -1,11 +1,11 @@
 ;;; table.el --- create and edit WYSIWYG text based embedded tables

-;; Copyright (C) 2000, 2001, 2002 Free Software Foundation, Inc.
+;; Copyright (C) 2000, 01, 02, 03, 04 Free Software Foundation, Inc.

 ;; Keywords: wp, convenience
 ;; Author: Takaaki Ota <Takaaki.Ota@am.sony.com>
 ;; Created: Sat Jul 08 2000 13:28:45 (PST)
-;; Revised: Tue Dec 09 2003 14:36:50 (PST)
+;; Revised: Tue Jun 01 2004 11:36:39 (PDT)

 ;; This file is part of GNU Emacs.

@@ -1410,6 +1410,8 @@
    end-of-buffer
    forward-word
    backward-word
+   forward-sentence
+   backward-sentence
    forward-paragraph
    backward-paragraph))

@@ -1434,9 +1436,18 @@
 	   (cons (cons command func-symbol)
 		 table-command-remap-alist))))
  '(kill-region
+   kill-ring-save
    delete-region
    copy-region-as-kill
-   kill-line))
+   kill-line
+   kill-word
+   backward-kill-word
+   kill-sentence
+   backward-kill-sentence
+   kill-paragraph
+   backward-kill-paragraph
+   kill-sexp
+   backward-kill-sexp))

 ;; Pasting Group
 (mapcar
--- a/lisp/vc-svn.el	Thu Jun 03 16:45:20 2004 +0000
+++ b/lisp/vc-svn.el	Sat Jun 05 17:21:43 2004 +0000
@@ -195,8 +195,9 @@

 (defun vc-svn-checkin (file rev comment)
   "SVN-specific version of `vc-backend-checkin'."
-  (let ((status (apply 'vc-svn-command nil 1 file
-		       "ci" (list* "-m" comment (vc-switches 'SVN 'checkin)))))
+  (let ((status (apply
+                 'vc-svn-command nil 1 file "ci"
+                 (nconc (list "-m" comment) (vc-switches 'SVN 'checkin)))))
     (set-buffer "*vc*")
     (goto-char (point-min))
     (unless (equal status 0)
--- a/lisp/woman.el	Thu Jun 03 16:45:20 2004 +0000
+++ b/lisp/woman.el	Sat Jun 05 17:21:43 2004 +0000
@@ -1,6 +1,6 @@
 ;;; woman.el --- browse UN*X manual pages `wo (without) man'

-;; Copyright (C) 2000, 2002 Free Software Foundation, Inc.
+;; Copyright (C) 2000, 2002, 2004 Free Software Foundation, Inc.

 ;; Author: Francis J. Wright <F.J.Wright@qmul.ac.uk>
 ;; Maintainer: Francis J. Wright <F.J.Wright@qmul.ac.uk>
@@ -402,6 +402,7 @@
 ;;   Alexander Hinds <ahinds@thegrid.net>
 ;;   Stefan Hornburg <sth@hacon.de>
 ;;   Theodore Jump <tjump@cais.com>
+;;   David Kastrup <dak@gnu.org>
 ;;   Paul Kinnucan <paulk@mathworks.com>
 ;;   Jonas Linde <jonas@init.se>
 ;;   Andrew McRae <andrewm@optimation.co.nz>
@@ -438,7 +439,8 @@
   "Return concatenated list of FN applied to successive `car' elements of X.
 FN must return a list, cons or nil.  Useful for splicing into a list."
   ;; Based on the Standard Lisp function MAPCAN but with args swapped!
-  (and x (nconc (funcall fn (car x)) (woman-mapcan fn (cdr x)))))
+  ;; More concise implementation than the recursive one.  -- dak
+  (apply #'nconc (mapcar fn x)))

 (defun woman-parse-colon-path (paths)
   "Explode search path string PATHS into a list of directory names.
@@ -1367,15 +1369,16 @@
   ;; is re-processed by `woman-topic-all-completions-merge'.
   (let (dir files (path-index 0))	; indexing starts at zero
     (while path
-      (setq dir (car path)
-	    path (cdr path))
+      (setq dir (pop path))
       (if (woman-not-member dir path)	; use each directory only once!
-	  (setq files
-		(nconc files
-		       (woman-topic-all-completions-1 dir path-index))))
+	  (push (woman-topic-all-completions-1 dir path-index)
+		files))
       (setq path-index (1+ path-index)))
     ;; Uniquefy topics:
-    (woman-topic-all-completions-merge files)))
+    ;; Concate all lists with a single nconc call to
+    ;; avoid retraversing the first lists repeatedly  -- dak
+    (woman-topic-all-completions-merge
+     (apply #'nconc files))))

 (defun woman-topic-all-completions-1 (dir path-index)
   "Return an alist of the man topics in directory DIR with index PATH-INDEX.
@@ -1388,55 +1391,54 @@
   ;; unnecessary.  So let us assume that `woman-file-regexp' will
   ;; filter out any directories, which probably should not be there
   ;; anyway, i.e. it is a user error!
-  (mapcar
-   (lambda (file)
-     (cons
-      (file-name-sans-extension
-       (if (string-match woman-file-compression-regexp file)
-	   (file-name-sans-extension file)
-	 file))
-      (if (> woman-cache-level 1)
-	  (cons
-	   path-index
-	   (if (> woman-cache-level 2)
-	       (cons file nil))))))
-   (directory-files dir nil woman-file-regexp)))
+  ;;
+  ;; Don't sort files: we do that when merging, anyway.  -- dak
+  (let (newlst (lst (directory-files dir nil woman-file-regexp t))
+	       ;; Make an explicit regexp for stripping extension and
+	       ;; compression extension: file-name-sans-extension is a
+	       ;; far too costly function.  -- dak
+	       (ext (format "\\(\\.[^.\\/]*\\)?\\(%s\\)?\\'"
+			    woman-file-compression-regexp)))
+    ;; Use a loop instead of mapcar in order to avoid the speed
+    ;; penalty of binding function arguments.  -- dak
+      (dolist (file lst newlst)
+	(push
+	 (cons
+	  (if (string-match ext file)
+	      (substring file 0 (match-beginning 0))
+	    file)
+	  (and (> woman-cache-level 1)
+	       (cons
+		path-index
+		(and (> woman-cache-level 2)
+		     (list file)))))
+	 newlst))))

 (defun woman-topic-all-completions-merge (alist)
   "Merge the alist ALIST so that the keys are unique.
 Also make each path-info component into a list.
 \(Note that this function changes the value of ALIST.)"
-  ;; Intended to be fast by avoiding recursion and list copying.
-  (if (> woman-cache-level 1)
-      (let ((newalist alist))
-	(while newalist
-	  (let ((tail newalist) (topic (car (car newalist))))
-	    ;; Make the path-info into a list:
-	    (setcdr (car newalist) (list (cdr (car newalist))))
-	    (while tail
-	      (while (and tail (not (string= topic (car (car (cdr tail))))))
-		(setq tail (cdr tail)))
-	      (if tail			; merge path-info into (car newalist)
-		  (let ((path-info (cdr (car (cdr tail)))))
-		    (if (member path-info (cdr (car newalist)))
-			()
-		      ;; Make the path-info into a list:
-		      (nconc (car newalist) (list path-info)))
-		    (setcdr tail (cdr (cdr tail))))
-		))
-	    (setq newalist (cdr newalist))))
-	alist)
+  ;; Replaces unreadably "optimized" O(n^2) implementation.
+  ;; Instead we use sorting to merge stuff efficiently.  -- dak
+  (let (elt newalist)
+    ;; Sort list into reverse order
+    (setq alist (sort alist (lambda(x y) (string< (car y) (car x)))))
+    ;; merge duplicate keys.
+    (if (> woman-cache-level 1)
+	(while alist
+	  (setq elt (pop alist))
+	  (if (equal (car elt) (caar newalist))
+	      (unless (member (cdr elt) (cdar newalist))
+		(setcdr (car newalist) (cons (cdr elt)
+					     (cdar newalist))))
+	    (setcdr elt (list (cdr elt)))
+	    (push elt newalist)))
     ;; woman-cache-level = 1 => elements are single-element lists ...
-    (while (and alist (member (car alist) (cdr alist)))
-      (setq alist (cdr alist)))
-    (if alist
-	(let ((newalist alist) cdr_alist)
-	  (while (setq cdr_alist (cdr alist))
-	    (if (not (member (car cdr_alist) (cdr cdr_alist)))
-		(setq alist cdr_alist)
-	      (setcdr alist (cdr cdr_alist)))
-	    )
-	  newalist))))
+      (while alist
+	(setq elt (pop alist))
+	(unless (equal (car elt) (caar newalist))
+	  (push elt newalist))))
+    newalist))

 (defun woman-file-name-all-completions (topic)
   "Return an alist of the files in all man directories that match TOPIC."
--- a/lispref/display.texi	Thu Jun 03 16:45:20 2004 +0000
+++ b/lispref/display.texi	Sat Jun 05 17:21:43 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
--- a/nt/ChangeLog	Thu Jun 03 16:45:20 2004 +0000
+++ b/nt/ChangeLog	Sat Jun 05 17:21:43 2004 +0000
@@ -1,3 +1,9 @@
+2004-06-04  Juanma Barranquero  <lektu@terra.es>
+
+	* INSTALL: Reword the section on image support.  Add reference to
+	GnuWin32.  Mention problems when mixing binaries from different
+	compilers.
+
 2004-05-06  Jason Rumney  <jasonr@gnu.org>

 	* configure.bat: Use -mno-cygwin to check for image libraries
--- a/nt/INSTALL	Thu Jun 03 16:45:20 2004 +0000
+++ b/nt/INSTALL	Sat Jun 05 17:21:43 2004 +0000
@@ -1,7 +1,7 @@
 		      Building and Installing Emacs
-		on Windows NT/2000 and Windows 95/98/ME
+		on Windows NT/2K/XP and Windows 95/98/ME

-  Copyright (c) 2001 Free Software Foundation, Inc.
+  Copyright (c) 2001,2004 Free Software Foundation, Inc.
   See the end of the file for copying permissions.

   If you used WinZip to unpack the distribution, we suggest to
@@ -31,7 +31,7 @@
   like this, we recommend the use of the supported compilers mentioned
   in the previous paragraph.

-  If you build Emacs on Windows 9X or ME, not on Windows 2000 or
+  If you build Emacs on Windows 9X or ME, not on Windows 2K/XP or
   Windows NT, we suggest to install the Cygwin port of Bash.

   Please see http://www.mingw.org for pointers to GCC/Mingw binaries.
@@ -90,22 +90,35 @@

 * Optional image library support

-  To build Emacs with support for PNG images, the libpng and zlib
-  headers must be in the include path when the configure script is
-  run.  This can be setup using environment variables, or by
-  specifying --cflags -I...  options on the command-line to
-  configure.bat.  Similarly, the jpeg-6b, libXpm, tiff and libungif
-  headers need to be in the include path for support for those image
-  formats to work. The configure script will report whether it was
+  In addition to its "native" image formats (pbm and xbm), Emacs can
+  handle other image types: xpm, tiff, gif, png and jpeg (postscript is
+  currently unsupported on Windows).  To build Emacs with support for
+  them, the corresponding headers must be in the include path when the
+  configure script is run.  This can be setup using environment
+  variables, or by specifying --cflags -I... options on the command-line
+  to configure.bat.  The configure script will report whether it was
   able to detect the headers.

-  To use the PNG support, zlib.dll (or zlibd.dll) and libpng.dll (or
-  libpng13.dll, or libpng13d.dll) must be on the PATH or in the same
-  directory as emacs.exe when Emacs is started. Similar instructions
-  apply for other image libraries. Note that tiff support depends on
-  the jpeg library. If you did not compile the libraries yourself, you
-  must make sure that the jpeg library you install is the same one
-  that the tiff library was compiled against.
+  To use the external image support, the DLLs implementing the
+  functionality must be found when Emacs is started, either on the PATH,
+  or in the same directory as emacs.exe.  Failure to find a library is
+  not an error; the associated image format will simply be unavailable.
+
+  Some image libraries have dependencies on one another, or on zlib.
+  For example, tiff support depends on the jpeg library.  If you did not
+  compile the libraries yourself, you must make sure that any dependency
+  is in the PATH or otherwise accesible and that the binaries are
+  compatible (for example, that they were built with the same compiler).
+
+  Binaries for the image libraries (among many others) can be found at
+  GnuWin32 (http://gnuwin32.sourceforge.net).  These are built with
+  MinGW and work better with GCC/MinGW builds of Emacs, like the
+  official binary tarballs for Windows.  Compatibility with MSVC is
+  still weak and should not be trusted in production environments; if
+  you really need an MSVC-compiled Emacs with image support, you should
+  try to build the required libraries with the same compiler (though it
+  can be extremely non-trivial, and we'll be interested on hearing of
+  any such effort).

 * Building
--- a/src/ChangeLog	Thu Jun 03 16:45:20 2004 +0000
+++ b/src/ChangeLog	Sat Jun 05 17:21:43 2004 +0000
@@ -1,3 +1,26 @@
+2004-06-05  Miles Bader  <miles@gnu.org>
+
+	* xfaces.c (tty_supports_face_attributes_p): Make sure the specified
+	attributes have different values than the default face.
+
+2004-06-04  Eli Zaretskii  <eliz@gnu.org>
+
+	* xfaces.c (x_supports_face_attributes_p): Make this function
+	conditional on HAVE_WINDOW_SYSTEM.
+	(Fdisplay_supports_face_attributes_p) [HAVE_WINDOW_SYSTEM]: Don't
+	call x_supports_face_attributes_p if it was not compiled in.
+
+2004-06-04  Miles Bader  <miles@gnu.org>
+
+	* xfaces.c (tty_supports_face_attributes_p): New function, mostly
+	from Ftty_supports_face_attributes_p.
+	(x_supports_face_attributes_p): New function.
+	(Ftty_supports_face_attributes_p): Function deleted.
+	(Fdisplay_supports_face_attributes_p): New function.
+	(syms_of_xfaces): Initialize Sdisplay_supports_face_attributes_p.
+	(face_attr_equal_p): New function
+	(lface_equal_p): Use it.
+
 2004-06-03  Juanma Barranquero  <lektu@terra.es>

 	* w32fns.c (Fx_display_grayscale_p, Fw32_send_sys_command)
--- a/src/xfaces.c	Thu Jun 03 16:45:20 2004 +0000
+++ b/src/xfaces.c	Sat Jun 05 17:21:43 2004 +0000
@@ -4870,6 +4870,39 @@
 }


+/* Compare face-attribute values v1 and v2 for equality.  Value is non-zero if
+   all attributes are `equal'.  Tries to be fast because this function
+   is called quite often.  */
+
+static INLINE int
+face_attr_equal_p (v1, v2)
+{
+  /* Type can differ, e.g. when one attribute is unspecified, i.e. nil,
+     and the other is specified.  */
+  if (XTYPE (v1) != XTYPE (v2))
+    return 0;
+
+  if (EQ (v1, v2))
+    return 1;
+
+  switch (XTYPE (v1))
+    {
+    case Lisp_String:
+      if (SBYTES (v1) != SBYTES (v2))
+	return 0;
+
+      return bcmp (SDATA (v1), SDATA (v2), SBYTES (v1)) == 0;
+
+    case Lisp_Int:
+    case Lisp_Symbol:
+      return 0;
+
+    default:
+      return !NILP (Fequal (v1, v2));
+    }
+}
+
+
 /* Compare face vectors V1 and V2 for equality.  Value is non-zero if
    all attributes are `equal'.  Tries to be fast because this function
    is called quite often.  */
@@ -4881,38 +4914,7 @@
   int i, equal_p = 1;

   for (i = 1; i < LFACE_VECTOR_SIZE && equal_p; ++i)
-    {
-      Lisp_Object a = v1[i];
-      Lisp_Object b = v2[i];
-
-      /* Type can differ, e.g. when one attribute is unspecified, i.e. nil,
-	 and the other is specified.  */
-      equal_p = XTYPE (a) == XTYPE (b);
-      if (!equal_p)
-	break;
-
-      if (!EQ (a, b))
-	{
-	  switch (XTYPE (a))
-	    {
-	    case Lisp_String:
-	      equal_p = ((SBYTES (a)
-			  == SBYTES (b))
-			 && bcmp (SDATA (a), SDATA (b),
-				  SBYTES (a)) == 0);
-	      break;
-
-	    case Lisp_Int:
-	    case Lisp_Symbol:
-	      equal_p = 0;
-	      break;
-
-	    default:
-	      equal_p = !NILP (Fequal (a, b));
-	      break;
-	    }
-	}
-    }
+    equal_p = face_attr_equal_p (v1[i], v2[i]);

   return equal_p;
 }
@@ -5212,192 +5214,6 @@


 /***********************************************************************
-		    Face capability testing for ttys
- ***********************************************************************/
-
-
-/* If the distance (as returned by color_distance) between two colors is
-   less than this, then they are considered the same, for determining
-   whether a color is supported or not.  The range of values is 0-65535.  */
-
-#define TTY_SAME_COLOR_THRESHOLD  10000
-
-
-DEFUN ("tty-supports-face-attributes-p",
-       Ftty_supports_face_attributes_p, Stty_supports_face_attributes_p,
-       1, 2, 0,
-       doc: /* Return non-nil if all the face attributes in ATTRIBUTES are supported.
-The optional argument FRAME is the frame on which to test; if it is nil
-or unspecified, then the current frame is used.  If FRAME is not a tty
-frame, then nil is returned.
-
-The definition of `supported' is somewhat heuristic, but basically means
-that a face containing all the attributes in ATTRIBUTES, when merged
-with the default face for display, can be represented in a way that's
-
- \(1) different in appearance than the default face, and
- \(2) `close in spirit' to what the attributes specify, if not exact.
-
-Point (2) implies that a `:weight black' attribute will be satisfied
-by any terminal that can display bold, and a `:foreground "yellow"' as
-long as the terminal can display a yellowish color, but `:slant italic'
-will _not_ be satisfied by the tty display code's automatic
-substitution of a `dim' face for italic.  */)
-     (attributes, frame)
-     Lisp_Object attributes, frame;
-{
-  int weight, i;
-  struct frame *f;
-  Lisp_Object val, fg, bg;
-  XColor fg_tty_color, fg_std_color;
-  XColor bg_tty_color, bg_std_color;
-  Lisp_Object attrs[LFACE_VECTOR_SIZE];
-  unsigned test_caps = 0;
-
-  if (NILP (frame))
-    frame = selected_frame;
-  CHECK_LIVE_FRAME (frame);
-  f = XFRAME (frame);
-
-  for (i = 0; i < LFACE_VECTOR_SIZE; i++)
-    attrs[i] = Qunspecified;
-  merge_face_vector_with_property (f, attrs, attributes);
-
-  /* This function only works on ttys.  */
-  if (!FRAME_TERMCAP_P (f) && !FRAME_MSDOS_P (f))
-    return Qnil;
-
-  /* First check some easy-to-check stuff; ttys support none of the
-     following attributes, so we can just return nil if any are requested.  */
-
-  /* stipple */
-  val = attrs[LFACE_STIPPLE_INDEX];
-  if (!UNSPECIFIEDP (val) && !NILP (val))
-    return Qnil;
-
-  /* font height */
-  val = attrs[LFACE_HEIGHT_INDEX];
-  if (!UNSPECIFIEDP (val) && !NILP (val))
-    return Qnil;
-
-  /* font width */
-  val = attrs[LFACE_SWIDTH_INDEX];
-  if (!UNSPECIFIEDP (val) && !NILP (val)
-      && face_numeric_swidth (val) != XLFD_SWIDTH_MEDIUM)
-    return Qnil;
-
-  /* overline */
-  val = attrs[LFACE_OVERLINE_INDEX];
-  if (!UNSPECIFIEDP (val) && !NILP (val))
-    return Qnil;
-
-  /* strike-through */
-  val = attrs[LFACE_STRIKE_THROUGH_INDEX];
-  if (!UNSPECIFIEDP (val) && !NILP (val))
-    return Qnil;
-
-  /* boxes */
-  val = attrs[LFACE_BOX_INDEX];
-  if (!UNSPECIFIEDP (val) && !NILP (val))
-    return Qnil;
-
-  /* slant (italics/oblique); We consider any non-default value
-     unsupportable on ttys, even though the face code actually `fakes'
-     them using a dim attribute if possible.  This is because the faked
-     result is too different from what the face specifies.  */
-  val = attrs[LFACE_SLANT_INDEX];
-  if (!UNSPECIFIEDP (val) && !NILP (val)
-      && face_numeric_slant (val) != XLFD_SLANT_ROMAN)
-    return Qnil;
-
-
-  /* Test for terminal `capabilities' (non-color character attributes).  */
-
-  /* font weight (bold/dim) */
-  weight = face_numeric_weight (attrs[LFACE_WEIGHT_INDEX]);
-  if (weight >= 0)
-    {
-      if (weight > XLFD_WEIGHT_MEDIUM)
-	test_caps = TTY_CAP_BOLD;
-      else if (weight < XLFD_WEIGHT_MEDIUM)
-	test_caps = TTY_CAP_DIM;
-    }
-
-  /* underlining */
-  val = attrs[LFACE_UNDERLINE_INDEX];
-  if (!UNSPECIFIEDP (val) && !NILP (val))
-    {
-      if (STRINGP (val))
-	return Qnil;		/* ttys don't support colored underlines */
-      else
-	test_caps |= TTY_CAP_UNDERLINE;
-    }
-
-  /* inverse video */
-  val = attrs[LFACE_INVERSE_INDEX];
-  if (!UNSPECIFIEDP (val) && !NILP (val))
-    test_caps |= TTY_CAP_INVERSE;
-
-
-  /* Color testing.  */
-
-  /* Default the color indices in FG_TTY_COLOR and BG_TTY_COLOR, since
-     we use them when calling `tty_capable_p' below, even if the face
-     specifies no colors.  */
-  fg_tty_color.pixel = FACE_TTY_DEFAULT_FG_COLOR;
-  bg_tty_color.pixel = FACE_TTY_DEFAULT_BG_COLOR;
-
-  /* Check if foreground color is close enough.  */
-  fg = attrs[LFACE_FOREGROUND_INDEX];
-  if (STRINGP (fg))
-    {
-      if (! tty_lookup_color (f, fg, &fg_tty_color, &fg_std_color))
-	return Qnil;
-      else if (color_distance (&fg_tty_color, &fg_std_color)
-	       > TTY_SAME_COLOR_THRESHOLD)
-	return Qnil;
-    }
-
-  /* Check if background color is close enough.  */
-  bg = attrs[LFACE_BACKGROUND_INDEX];
-  if (STRINGP (bg))
-    {
-      if (! tty_lookup_color (f, bg, &bg_tty_color, &bg_std_color))
-	return Qnil;
-      else if (color_distance (&bg_tty_color, &bg_std_color)
-	       > TTY_SAME_COLOR_THRESHOLD)
-	return Qnil;
-    }
-
-  /* If both foreground and background are requested, see if the
-     distance between them is OK.  We just check to see if the distance
-     between the tty's foreground and background is close enough to the
-     distance between the standard foreground and background.  */
-  if (STRINGP (fg) && STRINGP (bg))
-    {
-      int delta_delta
-	= (color_distance (&fg_std_color, &bg_std_color)
-	   - color_distance (&fg_tty_color, &bg_tty_color));
-      if (delta_delta > TTY_SAME_COLOR_THRESHOLD
-	  || delta_delta < -TTY_SAME_COLOR_THRESHOLD)
-	return Qnil;
-    }
-
-
-  /* See if the capabilities we selected above are supported, with the
-     given colors.  */
-  if (test_caps != 0 &&
-      ! tty_capable_p (FRAME_TTY (f), test_caps, fg_tty_color.pixel, bg_tty_color.pixel))
-    return Qnil;
-
-
-  /* Hmmm, everything checks out, this terminal must support this face.  */
-  return Qt;
-}
-
-
-
-/***********************************************************************
 			      Face Cache
  ***********************************************************************/

@@ -5917,6 +5733,351 @@


 /***********************************************************************
+			Face capability testing
+ ***********************************************************************/
+
+
+/* If the distance (as returned by color_distance) between two colors is
+   less than this, then they are considered the same, for determining
+   whether a color is supported or not.  The range of values is 0-65535.  */
+
+#define TTY_SAME_COLOR_THRESHOLD  10000
+
+#ifdef HAVE_WINDOW_SYSTEM
+
+/* Return non-zero if all the face attributes in ATTRS are supported
+   on the window-system frame F.
+
+   The definition of `supported' is somewhat heuristic, but basically means
+   that a face containing all the attributes in ATTRS, when merged with the
+   default face for display, can be represented in a way that's
+
+    \(1) different in appearance than the default face, and
+    \(2) `close in spirit' to what the attributes specify, if not exact.  */
+
+static int
+x_supports_face_attributes_p (f, attrs, def_face)
+     struct frame *f;
+     Lisp_Object *attrs;
+     struct face *def_face;
+{
+  Lisp_Object *def_attrs = def_face->lface;
+
+  /* Check that other specified attributes are different that the default
+     face.  */
+  if ((!UNSPECIFIEDP (attrs[LFACE_UNDERLINE_INDEX])
+       && face_attr_equal_p (attrs[LFACE_UNDERLINE_INDEX],
+			     def_attrs[LFACE_UNDERLINE_INDEX]))
+      || (!UNSPECIFIEDP (attrs[LFACE_INVERSE_INDEX])
+	  && face_attr_equal_p (attrs[LFACE_INVERSE_INDEX],
+				def_attrs[LFACE_INVERSE_INDEX]))
+      || (!UNSPECIFIEDP (attrs[LFACE_FOREGROUND_INDEX])
+	  && face_attr_equal_p (attrs[LFACE_FOREGROUND_INDEX],
+				def_attrs[LFACE_FOREGROUND_INDEX]))
+      || (!UNSPECIFIEDP (attrs[LFACE_BACKGROUND_INDEX])
+	  && face_attr_equal_p (attrs[LFACE_BACKGROUND_INDEX],
+				def_attrs[LFACE_BACKGROUND_INDEX]))
+      || (!UNSPECIFIEDP (attrs[LFACE_STIPPLE_INDEX])
+	  && face_attr_equal_p (attrs[LFACE_STIPPLE_INDEX],
+				def_attrs[LFACE_STIPPLE_INDEX]))
+      || (!UNSPECIFIEDP (attrs[LFACE_OVERLINE_INDEX])
+	  && face_attr_equal_p (attrs[LFACE_OVERLINE_INDEX],
+				def_attrs[LFACE_OVERLINE_INDEX]))
+      || (!UNSPECIFIEDP (attrs[LFACE_STRIKE_THROUGH_INDEX])
+	  && face_attr_equal_p (attrs[LFACE_STRIKE_THROUGH_INDEX],
+				def_attrs[LFACE_STRIKE_THROUGH_INDEX]))
+      || (!UNSPECIFIEDP (attrs[LFACE_BOX_INDEX])
+	  && face_attr_equal_p (attrs[LFACE_BOX_INDEX],
+				def_attrs[LFACE_BOX_INDEX])))
+    return 0;
+
+  /* Check font-related attributes, as those are the most commonly
+     "unsupported" on a window-system (because of missing fonts).  */
+  if (!UNSPECIFIEDP (attrs[LFACE_FAMILY_INDEX])
+      || !UNSPECIFIEDP (attrs[LFACE_HEIGHT_INDEX])
+      || !UNSPECIFIEDP (attrs[LFACE_WEIGHT_INDEX])
+      || !UNSPECIFIEDP (attrs[LFACE_SLANT_INDEX])
+      || !UNSPECIFIEDP (attrs[LFACE_SWIDTH_INDEX])
+      || !UNSPECIFIEDP (attrs[LFACE_AVGWIDTH_INDEX]))
+    {
+      struct face *face;
+      Lisp_Object merged_attrs[LFACE_VECTOR_SIZE];
+
+      bcopy (def_attrs, merged_attrs, sizeof merged_attrs);
+
+      merge_face_vectors (f, attrs, merged_attrs, Qnil);
+
+      face = FACE_FROM_ID (f, lookup_face (f, merged_attrs, 0, 0));
+
+      if (! face)
+	signal_error ("cannot make face", 0);
+
+      /* If the font is the same, then not supported.  */
+      if (face->font == def_face->font)
+	return 0;
+    }
+
+  /* Everything checks out, this face is supported.  */
+  return 1;
+}
+
+#endif	/* HAVE_WINDOW_SYSTEM */
+
+/* Return non-zero if all the face attributes in ATTRS are supported
+   on the tty frame F.
+
+   The definition of `supported' is somewhat heuristic, but basically means
+   that a face containing all the attributes in ATTRS, when merged
+   with the default face for display, can be represented in a way that's
+
+    \(1) different in appearance than the default face, and
+    \(2) `close in spirit' to what the attributes specify, if not exact.
+
+   Point (2) implies that a `:weight black' attribute will be satisfied
+   by any terminal that can display bold, and a `:foreground "yellow"' as
+   long as the terminal can display a yellowish color, but `:slant italic'
+   will _not_ be satisfied by the tty display code's automatic
+   substitution of a `dim' face for italic.  */
+
+static int
+tty_supports_face_attributes_p (f, attrs, def_face)
+     struct frame *f;
+     Lisp_Object *attrs;
+     struct face *def_face;
+{
+  int weight, i;
+  Lisp_Object val, fg, bg;
+  XColor fg_tty_color, fg_std_color;
+  XColor bg_tty_color, bg_std_color;
+  unsigned test_caps = 0;
+  Lisp_Object *def_attrs = def_face->lface;
+
+
+  /* First check some easy-to-check stuff; ttys support none of the
+     following attributes, so we can just return false if any are requested
+     (even if `nominal' values are specified, we should still return false,
+     as that will be the same value that the default face uses).  We
+     consider :slant unsupportable on ttys, even though the face code
+     actually `fakes' them using a dim attribute if possible.  This is
+     because the faked result is too different from what the face
+     specifies.  */
+  if (!UNSPECIFIEDP (attrs[LFACE_FAMILY_INDEX])
+      || !UNSPECIFIEDP (attrs[LFACE_STIPPLE_INDEX])
+      || !UNSPECIFIEDP (attrs[LFACE_HEIGHT_INDEX])
+      || !UNSPECIFIEDP (attrs[LFACE_SWIDTH_INDEX])
+      || !UNSPECIFIEDP (attrs[LFACE_OVERLINE_INDEX])
+      || !UNSPECIFIEDP (attrs[LFACE_STRIKE_THROUGH_INDEX])
+      || !UNSPECIFIEDP (attrs[LFACE_BOX_INDEX])
+      || !UNSPECIFIEDP (attrs[LFACE_SLANT_INDEX]))
+    return 0;
+
+
+  /* Test for terminal `capabilities' (non-color character attributes).  */
+
+  /* font weight (bold/dim) */
+  weight = face_numeric_weight (attrs[LFACE_WEIGHT_INDEX]);
+  if (weight >= 0)
+    {
+      int def_weight = face_numeric_weight (def_attrs[LFACE_WEIGHT_INDEX]);
+
+      if (weight > XLFD_WEIGHT_MEDIUM)
+	{
+	  if (def_weight > XLFD_WEIGHT_MEDIUM)
+	    return 0;		/* same as default */
+	  test_caps = TTY_CAP_BOLD;
+	}
+      else if (weight < XLFD_WEIGHT_MEDIUM)
+	{
+	  if (def_weight < XLFD_WEIGHT_MEDIUM)
+	    return 0;		/* same as default */
+	  test_caps = TTY_CAP_DIM;
+	}
+      else if (def_weight == XLFD_WEIGHT_MEDIUM)
+	return 0;		/* same as default */
+    }
+
+  /* underlining */
+  val = attrs[LFACE_UNDERLINE_INDEX];
+  if (!UNSPECIFIEDP (val))
+    {
+      if (STRINGP (val))
+	return 0;		/* ttys can't use colored underlines */
+      else if (face_attr_equal_p (val, def_attrs[LFACE_UNDERLINE_INDEX]))
+	return 0;		/* same as default */
+      else
+	test_caps |= TTY_CAP_UNDERLINE;
+    }
+
+  /* inverse video */
+  val = attrs[LFACE_INVERSE_INDEX];
+  if (!UNSPECIFIEDP (val))
+    {
+      if (face_attr_equal_p (val, def_attrs[LFACE_UNDERLINE_INDEX]))
+	return 0;		/* same as default */
+      else
+	test_caps |= TTY_CAP_INVERSE;
+    }
+
+
+  /* Color testing.  */
+
+  /* Default the color indices in FG_TTY_COLOR and BG_TTY_COLOR, since
+     we use them when calling `tty_capable_p' below, even if the face
+     specifies no colors.  */
+  fg_tty_color.pixel = FACE_TTY_DEFAULT_FG_COLOR;
+  bg_tty_color.pixel = FACE_TTY_DEFAULT_BG_COLOR;
+
+  /* Check if foreground color is close enough.  */
+  fg = attrs[LFACE_FOREGROUND_INDEX];
+  if (STRINGP (fg))
+    {
+      Lisp_Object def_fg = def_attrs[LFACE_FOREGROUND_INDEX];
+
+      if (face_attr_equal_p (fg, def_fg))
+	return 0;		/* same as default */
+      else if (! tty_lookup_color (f, fg, &fg_tty_color, &fg_std_color))
+	return 0;		/* not a valid color */
+      else if (color_distance (&fg_tty_color, &fg_std_color)
+	       > TTY_SAME_COLOR_THRESHOLD)
+	return 0;		/* displayed color is too different */
+      else
+	/* Make sure the color is really different than the default.  */
+	{
+	  XColor def_fg_color;
+	  if (tty_lookup_color (f, def_fg, &def_fg_color, 0)
+	      && (color_distance (&fg_tty_color, &def_fg_color)
+		  <= TTY_SAME_COLOR_THRESHOLD))
+	    return 0;
+	}
+    }
+
+  /* Check if background color is close enough.  */
+  bg = attrs[LFACE_BACKGROUND_INDEX];
+  if (STRINGP (bg))
+    {
+      Lisp_Object def_bg = def_attrs[LFACE_FOREGROUND_INDEX];
+
+      if (face_attr_equal_p (bg, def_bg))
+	return 0;		/* same as default */
+      else if (! tty_lookup_color (f, bg, &bg_tty_color, &bg_std_color))
+	return 0;		/* not a valid color */
+      else if (color_distance (&bg_tty_color, &bg_std_color)
+	       > TTY_SAME_COLOR_THRESHOLD)
+	return 0;		/* displayed color is too different */
+      else
+	/* Make sure the color is really different than the default.  */
+	{
+	  XColor def_bg_color;
+	  if (tty_lookup_color (f, def_bg, &def_bg_color, 0)
+	      && (color_distance (&bg_tty_color, &def_bg_color)
+		  <= TTY_SAME_COLOR_THRESHOLD))
+	    return 0;
+	}
+    }
+
+  /* If both foreground and background are requested, see if the
+     distance between them is OK.  We just check to see if the distance
+     between the tty's foreground and background is close enough to the
+     distance between the standard foreground and background.  */
+  if (STRINGP (fg) && STRINGP (bg))
+    {
+      int delta_delta
+	= (color_distance (&fg_std_color, &bg_std_color)
+	   - color_distance (&fg_tty_color, &bg_tty_color));
+      if (delta_delta > TTY_SAME_COLOR_THRESHOLD
+	  || delta_delta < -TTY_SAME_COLOR_THRESHOLD)
+	return 0;
+    }
+
+
+  /* See if the capabilities we selected above are supported, with the
+     given colors.  */
+  if (test_caps != 0 &&
+      ! tty_capable_p (FRAME_TTY (f), test_caps, fg_tty_color.pixel, bg_tty_color.pixel))
+    return 0;
+
+
+  /* Hmmm, everything checks out, this terminal must support this face.  */
+  return 1;
+}
+
+
+DEFUN ("display-supports-face-attributes-p",
+       Fdisplay_supports_face_attributes_p, Sdisplay_supports_face_attributes_p,
+       1, 2, 0,
+       doc: /* Return non-nil if all the face attributes in ATTRIBUTES are supported.
+The optional argument DISPLAY can be a display name, a frame, or
+nil (meaning the selected frame's display)
+
+The definition of `supported' is somewhat heuristic, but basically means
+that a face containing all the attributes in ATTRIBUTES, when merged
+with the default face for display, can be represented in a way that's
+
+ \(1) different in appearance than the default face, and
+ \(2) `close in spirit' to what the attributes specify, if not exact.
+
+Point (2) implies that a `:weight black' attribute will be satisfied by
+any display that can display bold, and a `:foreground \"yellow\"' as long
+as it can display a yellowish color, but `:slant italic' will _not_ be
+satisfied by the tty display code's automatic substitution of a `dim'
+face for italic. */)
+  (attributes, display)
+     Lisp_Object attributes, display;
+{
+  int supports, i;
+  Lisp_Object frame;
+  struct frame *f;
+  struct face *def_face;
+  Lisp_Object attrs[LFACE_VECTOR_SIZE];
+
+  if (NILP (display))
+    frame = selected_frame;
+  else if (FRAMEP (display))
+    frame = display;
+  else
+    {
+      /* Find any frame on DISPLAY.  */
+      Lisp_Object fl_tail;
+
+      frame = Qnil;
+      for (fl_tail = Vframe_list; CONSP (fl_tail); fl_tail = XCDR (fl_tail))
+	{
+	  frame = XCAR (fl_tail);
+	  if (!NILP (Fequal (Fcdr (Fassq (Qdisplay,
+					  XFRAME (frame)->param_alist)),
+			     display)))
+	    break;
+	}
+    }
+
+  CHECK_LIVE_FRAME (frame);
+  f = XFRAME (frame);
+
+  for (i = 0; i < LFACE_VECTOR_SIZE; i++)
+    attrs[i] = Qunspecified;
+  merge_face_vector_with_property (f, attrs, attributes);
+
+  def_face = FACE_FROM_ID (f, DEFAULT_FACE_ID);
+  if (def_face == NULL)
+    {
+      if (! realize_basic_faces (f))
+	signal_error ("Cannot realize default face", 0);
+      def_face = FACE_FROM_ID (f, DEFAULT_FACE_ID);
+    }
+
+  /* Dispatch to the appropriate handler.  */
+  if (FRAME_TERMCAP_P (f) || FRAME_MSDOS_P (f))
+    supports = tty_supports_face_attributes_p (f, attrs, def_face);
+#ifdef HAVE_WINDOW_SYSTEM
+  else
+    supports = x_supports_face_attributes_p (f, attrs, def_face);
+#endif
+
+  return supports ? Qt : Qnil;
+}
+
+
+/***********************************************************************
 			    Font selection
  ***********************************************************************/

@@ -7722,7 +7883,7 @@
   defsubr (&Sinternal_merge_in_global_face);
   defsubr (&Sface_font);
   defsubr (&Sframe_face_alist);
-  defsubr (&Stty_supports_face_attributes_p);
+  defsubr (&Sdisplay_supports_face_attributes_p);
   defsubr (&Scolor_distance);
   defsubr (&Sinternal_set_font_selection_order);
   defsubr (&Sinternal_set_alternative_font_family_alist);