entered into RCS
[bpt/emacs.git] / lisp / faces.el
index b191590..dbe90c7 100644 (file)
 (defsubst face-font (face &optional frame)
   "Return the font name of face FACE, or nil if it is unspecified.
 If the optional argument FRAME is given, report on face FACE in that frame.
-Otherwise report on the defaults for face FACE (for new frames)."
+If FRAME is t, report on the defaults for face FACE (for new frames).
+  The font default for a face is either nil, or a list
+  of the form (bold), (italic) or (bold italic).
+If FRAME is omitted or nil, use the selected frame."
   (aref (internal-get-face face frame) 3))
 
 (defsubst face-foreground (face &optional frame)
   "Return the foreground color name of face FACE, or nil if unspecified.
 If the optional argument FRAME is given, report on face FACE in that frame.
-Otherwise report on the defaults for face FACE (for new frames)."
+If FRAME is t, report on the defaults for face FACE (for new frames).
+If FRAME is omitted or nil, use the selected frame."
   (aref (internal-get-face face frame) 4))
 
 (defsubst face-background (face &optional frame)
   "Return the background color name of face FACE, or nil if unspecified.
 If the optional argument FRAME is given, report on face FACE in that frame.
-Otherwise report on the defaults for face FACE (for new frames)."
+If FRAME is t, report on the defaults for face FACE (for new frames).
+If FRAME is omitted or nil, use the selected frame."
   (aref (internal-get-face face frame) 5))
 
-(defsubst face-background-pixmap (face &optional frame)
- "Return the background pixmap name of face FACE, or nil if unspecified.
-If the optional argument FRAME is given, report on face FACE in that frame.
-Otherwise report on the defaults for face FACE (for new frames)."
- (aref (internal-get-face face frame) 6))
+;;(defsubst face-background-pixmap (face &optional frame)
+;; "Return the background pixmap name of face FACE, or nil if unspecified.
+;;If the optional argument FRAME is given, report on face FACE in that frame.
+;;Otherwise report on the defaults for face FACE (for new frames)."
+;; (aref (internal-get-face face frame) 6))
 
 (defsubst face-underline-p (face &optional frame)
  "Return t if face FACE is underlined.
 If the optional argument FRAME is given, report on face FACE in that frame.
-Otherwise report on the defaults for face FACE (for new frames)."
+If FRAME is t, report on the defaults for face FACE (for new frames).
+If FRAME is omitted or nil, use the selected frame."
  (aref (internal-get-face face frame) 7))
 
 \f
@@ -102,19 +108,19 @@ in that frame; otherwise change each frame."
   (interactive (internal-face-interactive "background"))
   (internal-set-face-1 face 'background color 5 frame))
 
-(defsubst set-face-background-pixmap (face name &optional frame)
-  "Change the background pixmap of face FACE to PIXMAP.
-PIXMAP should be a string, the name of a file of pixmap data.
-The directories listed in the `x-bitmap-file-path' variable are searched.
+;;(defsubst set-face-background-pixmap (face name &optional frame)
+;;  "Change the background pixmap of face FACE to PIXMAP.
+;;PIXMAP should be a string, the name of a file of pixmap data.
+;;The directories listed in the `x-bitmap-file-path' variable are searched.
 
-Alternatively, PIXMAP may be a list of the form (WIDTH HEIGHT DATA)
-where WIDTH and HEIGHT are the size in pixels,
-and DATA is a string, containing the raw bits of the bitmap.  
+;;Alternatively, PIXMAP may be a list of the form (WIDTH HEIGHT DATA)
+;;where WIDTH and HEIGHT are the size in pixels,
+;;and DATA is a string, containing the raw bits of the bitmap.  
 
-If the optional FRAME argument is provided, change only
-in that frame; otherwise change each frame."
-  (interactive (internal-face-interactive "background-pixmap"))
-  (internal-set-face-1 face 'background-pixmap name 6 frame))
+;;If the optional FRAME argument is provided, change only
+;;in that frame; otherwise change each frame."
+;;  (interactive (internal-face-interactive "background-pixmap"))
+;;  (internal-set-face-1 face 'background-pixmap name 6 frame))
 
 (defsubst set-face-underline-p (face underline-p &optional frame)
   "Specify whether face FACE is underlined.  (Yes if UNDERLINE-P is non-nil.)
@@ -126,7 +132,10 @@ in that frame; otherwise change each frame."
 \f
 ;;;; Associating face names (symbols) with their face vectors.
 
-(defvar global-face-data nil "do not use this")
+(defvar global-face-data nil
+  "Internal data for face support functions.  Not for external use.
+This is an alist associating face names with the default values for
+their parameters.  Newly created frames get their data from here.")
 
 (defun face-list ()
   "Returns a list of all defined face names."
@@ -284,14 +293,18 @@ If the face already exists, it is unmodified."
           )))
   face)
 
-(defun copy-face (old-face new-name &optional frame)
+(defun copy-face (old-face new-name &optional frame new-frame)
   "Define a face just like OLD-FACE, with name NEW-NAME.
 If NEW-NAME already exists as a face, it is modified to be like OLD-FACE.
 If the optional argument FRAME is given, this applies only to that frame.
-Otherwise it applies to each frame separately."
+Otherwise it applies to each frame separately.
+If the optional fourth argument NEW-FRAME is given, 
+copy the information from face OLD-FACE on frame FRAME
+to face NEW-NAME on frame NEW-FRAME."
+  (or new-frame (setq new-frame frame))
   (setq old-face (internal-get-face old-face frame))
   (let* ((inhibit-quit t)
-        (new-face (or (internal-find-face new-name frame)
+        (new-face (or (internal-find-face new-name new-frame)
                       (make-face new-name))))
     (if (null frame)
        (let ((frames (frame-list)))
@@ -299,13 +312,13 @@ Otherwise it applies to each frame separately."
            (copy-face old-face new-name (car frames))
            (setq frames (cdr frames)))
          (copy-face old-face new-name t))
-      (set-face-font new-face (face-font old-face frame) frame)
-      (set-face-foreground new-face (face-foreground old-face frame) frame)
-      (set-face-background new-face (face-background old-face frame) frame)
+      (set-face-font new-face (face-font old-face frame) new-frame)
+      (set-face-foreground new-face (face-foreground old-face frame) new-frame)
+      (set-face-background new-face (face-background old-face frame) new-frame)
 ;;;      (set-face-background-pixmap
-;;;       new-face (face-background-pixmap old-face frame) frame)
+;;;       new-face (face-background-pixmap old-face frame) new-frame)
       (set-face-underline-p new-face (face-underline-p old-face frame)
-                           frame))
+                           new-frame))
     new-face))
 
 (defun face-equal (face1 face2 &optional frame)
@@ -315,8 +328,9 @@ Otherwise it applies to each frame separately."
   (and (equal (face-foreground face1 frame) (face-foreground face2 frame))
        (equal (face-background face1 frame) (face-background face2 frame))
        (equal (face-font face1 frame) (face-font face2 frame))
-       (equal (face-background-pixmap face1 frame)
-             (face-background-pixmap face2 frame))))
+;;       (equal (face-background-pixmap face1 frame)
+;;           (face-background-pixmap face2 frame))
+       ))
 
 (defun face-differs-from-default-p (face &optional frame)
   "True if face FACE displays differently from the default face, on FRAME.
@@ -425,6 +439,7 @@ also the same size as FACE on FRAME."
   (and (eq frame t)
        (setq frame nil))
   (if pattern
+      ;; Note that x-list-fonts has code to handle a face with nil as its font.
       (let ((fonts (x-list-fonts pattern face frame)))
        (or fonts
            (if face
@@ -454,35 +469,34 @@ also the same size as FACE on FRAME."
 
 
 (defun x-make-font-bold (font)
-  "Given an X font specification, this attempts to make a `bold' version
-of it.  If it fails, it returns nil."
+  "Given an X font specification, make a bold version of it.
+If that can't be done, return nil."
   (x-frob-font-weight font "bold"))
 
 (defun x-make-font-demibold (font)
-  "Given an X font specification, this attempts to make a `demibold' version
-of it.  If it fails, it returns nil."
+  "Given an X font specification, make a demibold version of it.
+If that can't be done, return nil."
   (x-frob-font-weight font "demibold"))
 
 (defun x-make-font-unbold (font)
-  "Given an X font specification, this attempts to make a non-bold version
-of it.  If it fails, it returns nil."
+  "Given an X font specification, make a non-bold version of it.
+If that can't be done, return nil."
   (x-frob-font-weight font "medium"))
 
 (defun x-make-font-italic (font)
-  "Given an X font specification, this attempts to make an `italic' version
-of it.  If it fails, it returns nil."
+  "Given an X font specification, make an italic version of it.
+If that can't be done, return nil."
   (x-frob-font-slant font "i"))
 
 (defun x-make-font-oblique (font) ; you say tomayto...
-  "Given an X font specification, this attempts to make an `italic' version
-of it.  If it fails, it returns nil."
+  "Given an X font specification, make an oblique version of it.
+If that can't be done, return nil."
   (x-frob-font-slant font "o"))
 
 (defun x-make-font-unitalic (font)
-  "Given an X font specification, this attempts to make a non-italic version
-of it.  If it fails, it returns nil."
+  "Given an X font specification, make a non-italic version of it.
+If that can't be done, return nil."
   (x-frob-font-slant font "r"))
-
 \f
 ;;; non-X-specific interface
 
@@ -490,137 +504,239 @@ of it.  If it fails, it returns nil."
   "Make the font of the given face be bold, if possible.  
 If NOERROR is non-nil, return nil on failure."
   (interactive (list (read-face-name "Make which face bold: ")))
-  (let ((ofont (face-font face frame))
-       font f2)
-    (if (null frame)
-       (let ((frames (frame-list)))
-         (while frames
-           (make-face-bold face (car frames))
-           (setq frames (cdr frames))))
-      (setq face (internal-get-face face frame))
-      (setq font (or (face-font face frame)
-                    (face-font face t)
-                    (face-font 'default frame)
-                    (cdr (assq 'font (frame-parameters frame)))))
-      (or (and (setq f2 (x-make-font-bold font))
-              (internal-try-face-font face f2))
-         (and (setq f2 (x-make-font-demibold font))
-              (internal-try-face-font face f2))))
-    (or (not (equal ofont (face-font face)))
-       (and (not noerror)
-            (error "No %s version of %S" face ofont)))))
+  (if (and (eq frame t) (listp (face-font face t)))
+      (set-face-font face (if (memq 'italic (face-font face t))
+                             '(bold italic) '(bold))
+                    t)
+    (let ((ofont (face-font face frame))
+         font f2)
+      (if (null frame)
+         (let ((frames (frame-list)))
+           ;; Make this face bold in global-face-data.
+           (make-face-bold face t noerror)
+           ;; Make this face bold in each frame.
+           (while frames
+             (make-face-bold face (car frames) noerror)
+             (setq frames (cdr frames))))
+       (setq face (internal-get-face face frame))
+       (setq font (or (face-font face frame)
+                      (face-font face t)))
+       (if (listp font)
+           (setq font nil))
+       (setq font (or font
+                      (face-font 'default frame)
+                      (cdr (assq 'font (frame-parameters frame)))))
+       (make-face-bold-internal face frame))
+      (or (not (equal ofont (face-font face)))
+         (and (not noerror)
+              (error "No bold version of %S" font))))))
+
+(defun make-face-bold-internal (face frame)
+  (or (and (setq f2 (x-make-font-bold font))
+          (internal-try-face-font face f2 frame))
+      (and (setq f2 (x-make-font-demibold font))
+          (internal-try-face-font face f2 frame))))
 
 (defun make-face-italic (face &optional frame noerror)
   "Make the font of the given face be italic, if possible.  
 If NOERROR is non-nil, return nil on failure."
   (interactive (list (read-face-name "Make which face italic: ")))
-  (let ((ofont (face-font face frame))
-       font f2)
-    (if (null frame)
-       (let ((frames (frame-list)))
-         (while frames
-           (make-face-italic face (car frames))
-           (setq frames (cdr frames))))
-      (setq face (internal-get-face face frame))
-      (setq font (or (face-font face frame)
-                    (face-font face t)
-                    (face-font 'default frame)
-                    (cdr (assq 'font (frame-parameters frame)))))
-      (or (and (setq f2 (x-make-font-italic font))
-              (internal-try-face-font face f2))
-         (and (setq f2 (x-make-font-oblique font))
-              (internal-try-face-font face f2))))
-    (or (not (equal ofont (face-font face)))
-       (and (not noerror)
-            (error "No %s version of %S" face ofont)))))
+  (if (and (eq frame t) (listp (face-font face t)))
+      (set-face-font face (if (memq 'bold (face-font face t))
+                             '(bold italic) '(italic))
+                    t)
+    (let ((ofont (face-font face frame))
+         font f2)
+      (if (null frame)
+         (let ((frames (frame-list)))
+           ;; Make this face italic in global-face-data.
+           (make-face-italic face t noerror)
+           ;; Make this face italic in each frame.
+           (while frames
+             (make-face-italic face (car frames) noerror)
+             (setq frames (cdr frames))))
+       (setq face (internal-get-face face frame))
+       (setq font (or (face-font face frame)
+                      (face-font face t)))
+       (if (listp font)
+           (setq font nil))
+       (setq font (or font
+                      (face-font 'default frame)
+                      (cdr (assq 'font (frame-parameters frame)))))
+       (make-face-italic-internal face frame))
+      (or (not (equal ofont (face-font face)))
+         (and (not noerror)
+              (error "No italic version of %S" font))))))
+
+(defun make-face-italic-internal (face frame)
+  (or (and (setq f2 (x-make-font-italic font))
+          (internal-try-face-font face f2 frame))
+      (and (setq f2 (x-make-font-oblique font))
+          (internal-try-face-font face f2 frame))))
 
 (defun make-face-bold-italic (face &optional frame noerror)
   "Make the font of the given face be bold and italic, if possible.  
 If NOERROR is non-nil, return nil on failure."
   (interactive (list (read-face-name "Make which face bold-italic: ")))
-  (let ((ofont (face-font face frame))
-       font f2 f3)
-    (if (null frame)
-       (let ((frames (frame-list)))
-         (while frames
-           (make-face-bold-italic face (car frames))
-           (setq frames (cdr frames))))
-      (setq face (internal-get-face face frame))
-      (setq font (or (face-font face frame)
-                     (face-font face t)
-                     (face-font 'default frame)
-                     (cdr (assq 'font (frame-parameters frame)))))
-      (or (and (setq f2 (x-make-font-italic font))
-              (not (equal font f2))
-              (setq f3 (x-make-font-bold f2))
-              (not (equal f2 f3))
-              (internal-try-face-font face f3))
-         (and (setq f2 (x-make-font-oblique font))
-              (not (equal font f2))
-              (setq f3 (x-make-font-bold f2))
-              (not (equal f2 f3))
-              (internal-try-face-font face f3))
-         (and (setq f2 (x-make-font-italic font))
-              (not (equal font f2))
-              (setq f3 (x-make-font-demibold f2))
-              (not (equal f2 f3))
-              (internal-try-face-font face f3))
-         (and (setq f2 (x-make-font-oblique font))
-              (not (equal font f2))
-              (setq f3 (x-make-font-demibold f2))
-              (not (equal f2 f3))
-              (internal-try-face-font face f3))))
-    (or (not (equal ofont (face-font face)))
-       (and (not noerror)
-            (error "No %s version of %S" face ofont)))))
+  (if (and (eq frame t) (listp (face-font face t)))
+      (set-face-font face '(bold italic) t)
+    (let ((ofont (face-font face frame))
+         font)
+      (if (null frame)
+         (let ((frames (frame-list)))
+           ;; Make this face bold-italic in global-face-data.
+           (make-face-bold-italic face t noerror)
+           ;; Make this face bold in each frame.
+           (while frames
+             (make-face-bold-italic face (car frames) noerror)
+             (setq frames (cdr frames))))
+       (setq face (internal-get-face face frame))
+       (setq font (or (face-font face frame)
+                      (face-font face t)))
+       (if (listp font)
+           (setq font nil))
+       (setq font (or font
+                      (face-font 'default frame)
+                      (cdr (assq 'font (frame-parameters frame)))))
+       (make-face-bold-italic-internal face frame))
+      (or (not (equal ofont (face-font face)))
+         (and (not noerror)
+              (error "No bold italic version of %S" font))))))
+
+(defun make-face-bold-italic-internal (face frame)
+  (let (f2 f3)
+    (or (and (setq f2 (x-make-font-italic font))
+            (not (equal font f2))
+            (setq f3 (x-make-font-bold f2))
+            (not (equal f2 f3))
+            (internal-try-face-font face f3 frame))
+       (and (setq f2 (x-make-font-oblique font))
+            (not (equal font f2))
+            (setq f3 (x-make-font-bold f2))
+            (not (equal f2 f3))
+            (internal-try-face-font face f3 frame))
+       (and (setq f2 (x-make-font-italic font))
+            (not (equal font f2))
+            (setq f3 (x-make-font-demibold f2))
+            (not (equal f2 f3))
+            (internal-try-face-font face f3 frame))
+       (and (setq f2 (x-make-font-oblique font))
+            (not (equal font f2))
+            (setq f3 (x-make-font-demibold f2))
+            (not (equal f2 f3))
+            (internal-try-face-font face f3 frame)))))
 
 (defun make-face-unbold (face &optional frame noerror)
   "Make the font of the given face be non-bold, if possible.  
 If NOERROR is non-nil, return nil on failure."
   (interactive (list (read-face-name "Make which face non-bold: ")))
-  (let ((ofont (face-font face frame))
-       font font1)
-    (if (null frame)
-       (let ((frames (frame-list)))
-         (while frames
-           (make-face-unbold face (car frames))
-           (setq frames (cdr frames))))
-      (setq face (internal-get-face face frame))
-      (setq font1 (or (face-font face frame)
-                     (face-font face t)
-                     (face-font 'default frame)
-                     (cdr (assq 'font (frame-parameters frame)))))
-      (setq font (x-make-font-unbold font1))
-      (if font (internal-try-face-font face font)))
-    (or (not (equal ofont (face-font face)))
-       (and (not noerror)
-            (error "No %s version of %S" face ofont)))))
+  (if (and (eq frame t) (listp (face-font face t)))
+      (set-face-font face (if (memq 'italic (face-font face t))
+                             '(italic) nil)
+                    t)
+    (let ((ofont (face-font face frame))
+         font font1)
+      (if (null frame)
+         (let ((frames (frame-list)))
+           ;; Make this face unbold in global-face-data.
+           (make-face-unbold face t noerror)
+           ;; Make this face unbold in each frame.
+           (while frames
+             (make-face-unbold face (car frames) noerror)
+             (setq frames (cdr frames))))
+       (setq face (internal-get-face face frame))
+       (setq font1 (or (face-font face frame)
+                       (face-font face t)))
+       (if (listp font1)
+           (setq font1 nil))
+       (setq font1 (or font1
+                       (face-font 'default frame)
+                       (cdr (assq 'font (frame-parameters frame)))))
+       (setq font (x-make-font-unbold font1))
+       (if font (internal-try-face-font face font frame)))
+      (or (not (equal ofont (face-font face)))
+         (and (not noerror)
+              (error "No unbold version of %S" font1))))))
 
 (defun make-face-unitalic (face &optional frame noerror)
   "Make the font of the given face be non-italic, if possible.  
 If NOERROR is non-nil, return nil on failure."
   (interactive (list (read-face-name "Make which face non-italic: ")))
-  (let ((ofont (face-font face frame))
-       font font1)
-    (if (null frame)
-       (let ((frames (frame-list)))
-         (while frames
-           (make-face-unitalic face (car frames))
-           (setq frames (cdr frames))))
-      (setq face (internal-get-face face frame))
-      (setq font1 (or (face-font face frame)
-                     (face-font face t)
-                     (face-font 'default frame)
-                     (cdr (assq 'font (frame-parameters frame)))))
-      (setq font (x-make-font-unitalic font1))
-      (if font (internal-try-face-font face font)))
-    (or (not (equal ofont (face-font face)))
-       (and (not noerror)
-            (error "No %s version of %S" face ofont)))))
+  (if (and (eq frame t) (listp (face-font face t)))
+      (set-face-font face (if (memq 'bold (face-font face t))
+                             '(bold) nil)
+                    t)
+    (let ((ofont (face-font face frame))
+         font font1)
+      (if (null frame)
+         (let ((frames (frame-list)))
+           ;; Make this face unitalic in global-face-data.
+           (make-face-unitalic face t noerror)
+           ;; Make this face unitalic in each frame.
+           (while frames
+             (make-face-unitalic face (car frames) noerror)
+             (setq frames (cdr frames))))
+       (setq face (internal-get-face face frame))
+       (setq font1 (or (face-font face frame)
+                       (face-font face t)))
+       (if (listp font1)
+           (setq font1 nil))
+       (setq font1 (or font1
+                       (face-font 'default frame)
+                       (cdr (assq 'font (frame-parameters frame)))))
+       (setq font (x-make-font-unitalic font1))
+       (if font (internal-try-face-font face font frame)))
+      (or (not (equal ofont (face-font face)))
+         (and (not noerror)
+              (error "No unitalic version of %S" font1))))))
 \f
-;;; Make the builtin faces; the C code knows these as faces 0, 1, and 2,
-;;; respectively, so they must be the first three faces made.
-
+(defvar list-faces-sample-text
+  "abcdefghijklmnopqrstuvwxyz ABCDEFGHIJKLMNOPQRSTUVWXYZ"
+  "*Text string to display as the sample text for `list-faces-display'.")
+
+;; The name list-faces would be more consistent, but let's avoid a conflict
+;; with Lucid, which uses that name differently.
+(defun list-faces-display ()
+  "List all faces, using the same sample text in each.
+The sample text is a string that comes from the variable
+`list-faces-sample-text'.
+
+It is possible to give a particular face name different appearances in
+different frames.  This command shows the appearance in the
+selected frame."
+  (interactive)
+  (let ((faces (sort (face-list) (function string-lessp)))
+       (face nil)
+       (frame (selected-frame))
+       disp-frame window)
+    (with-output-to-temp-buffer "*Faces*"
+      (save-excursion
+       (set-buffer standard-output)
+       (setq truncate-lines t)
+       (while faces
+         (setq face (car faces))
+         (setq faces (cdr faces))
+         (insert (format "%25s " (symbol-name face)))
+         (let ((beg (point)))
+           (insert list-faces-sample-text)
+           (insert "\n")
+           (put-text-property beg (1- (point)) 'face face)))
+       (goto-char (point-min))))
+    ;; If the *Faces* buffer appears in a different frame,
+    ;; copy all the face definitions from FRAME,
+    ;; so that the display will reflect the frame that was selected.
+    (setq window (get-buffer-window (get-buffer "*Faces*") t))
+    (setq disp-frame (if window (window-frame window)
+                      (car (frame-list))))
+    (or (eq frame disp-frame)
+       (let ((faces (face-list)))
+         (while faces
+           (copy-face (car faces) (car faces) frame disp-frame)
+           (setq faces (cdr faces)))))))
+\f
+;;; Make the default and modeline faces; the C code knows these as
+;;; faces 0 and 1, respectively, so they must be the first two faces
+;;; made.
 (defun face-initialize ()
   (make-face 'default)
   (make-face 'modeline)
@@ -634,6 +750,7 @@ If NOERROR is non-nil, return nil on failure."
   (make-face 'bold-italic)
   (make-face 'region)
   (make-face 'secondary-selection)
+  (make-face 'underline)
 
   (setq region-face (face-id 'region))
 
@@ -697,31 +814,42 @@ If NOERROR is non-nil, return nil on failure."
       )
 
   (or (face-differs-from-default-p 'highlight frame)
-      (condition-case ()
-         (condition-case ()
-             (set-face-background 'highlight "darkseagreen2" frame)
-           (error (set-face-background 'highlight "green" frame)))
+      (if (or (not (x-display-color-p))
+             (= (x-display-planes) 1))
+         (invert-face 'highlight frame)
+       (condition-case ()
+           (condition-case ()
+               (set-face-background 'highlight "darkseagreen2" frame)
+             (error (set-face-background 'highlight "green" frame)))
 ;;;        (set-face-background-pixmap 'highlight "gray1" frame)
-       (error (invert-face 'highlight frame))))
+         (error (invert-face 'highlight frame)))))
 
   (or (face-differs-from-default-p 'region frame)
-      (condition-case ()
-         (set-face-background 'region "gray" frame)
-       (error (invert-face 'region frame))))
+      (if (= (x-display-planes) 1)
+         (invert-face 'region frame)
+       (condition-case ()
+           (set-face-background 'region "gray" frame)
+         (error (invert-face 'region frame)))))
 
   (or (face-differs-from-default-p 'modeline frame)
       (invert-face 'modeline frame))
 
+  (or (face-differs-from-default-p 'underline frame)
+      (set-face-underline-p 'underline t frame))
+
   (or (face-differs-from-default-p 'secondary-selection frame)
-      (condition-case ()
-         (condition-case ()
-             ;; some older X servers don't have this one.
-             (set-face-background 'secondary-selection "paleturquoise"
-                                  frame)
-           (error
-            (set-face-background 'secondary-selection "green" frame)))
+      (if (or (not (x-display-color-p))
+             (= (x-display-planes) 1))
+         (invert-face 'secondary-selection frame)
+       (condition-case ()
+           (condition-case ()
+               ;; some older X servers don't have this one.
+               (set-face-background 'secondary-selection "paleturquoise"
+                                    frame)
+             (error
+              (set-face-background 'secondary-selection "green" frame)))
 ;;;        (set-face-background-pixmap 'secondary-selection "gray1" frame)
-       (error (invert-face 'secondary-selection frame))))
+         (error (invert-face 'secondary-selection frame)))))
   )
 
 (defun internal-x-complain-about-font (face frame)
@@ -749,7 +877,8 @@ If NOERROR is non-nil, return nil on failure."
       (if (cdr (or (assq 'reverse parameters)
                   (assq 'reverse default-frame-alist)
                   (cons nil
-                        (x-get-resource "reverseVideo" "Reversevideo"))))
+                        (member (x-get-resource "reverseVideo" "ReverseVideo")
+                                '("on" "true")))))
          (let ((params (frame-parameters frame)))
            (modify-frame-parameters
             frame
@@ -763,6 +892,17 @@ If NOERROR is non-nil, return nil on failure."
       ;; Also fill them in from X resources.
       (while rest
        (setcdr (car rest) (copy-sequence (cdr (car rest))))
+       (condition-case nil
+           (if (listp (face-font (cdr (car rest))))
+               (let ((bold (memq 'bold (face-font (cdr (car rest)))))
+                     (italic (memq 'italic (face-font (cdr (car rest))))))
+                 (if (and bold italic)
+                     (make-face-bold-italic (car (car rest)) frame)
+                   (if bold
+                       (make-face-bold (car (car rest)) frame)
+                     (if italic
+                         (make-face-italic (car (car rest)) frame))))))
+         (error nil))
        (make-face-x-resource-internal (cdr (car rest)) frame t)
        (setq rest (cdr rest)))