changeset 17945:874de6432f05

(modify-face): Don't call make-face-unbold if face has no font; likewise for make-face-unitalic. (x-create-frame-with-faces): Use nil for SET-ANYWAY when calling make-face-x-resource-internal. (face-initialize): Don't initialize any face attributes here. (face-fill-in): Don't call set-face-underline-p if underlining off. (face-inverse-video-p): New function. (set-face-inverse-video-p): New function. (internal-set-face-1): Handle the inverse-video attribute. (face-spec-set): Handle :inverse-video. (make-face, x-create-frame-with-faces): Make vectors length 9. (internal-facep): Expect length 9. (face-try-color-list): Use set-face-inverse-video-p.
author Richard M. Stallman <rms@gnu.org>
date Sun, 25 May 1997 21:39:38 +0000
parents 0714535d0e28
children 2b225f00d308
files lisp/faces.el
diffstat 1 files changed, 45 insertions(+), 43 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/faces.el	Sun May 25 18:08:23 1997 +0000
+++ b/lisp/faces.el	Sun May 25 21:39:38 1997 +0000
@@ -44,11 +44,11 @@
 ;;;; Functions for manipulating face vectors.
 
 ;;; A face vector is a vector of the form:
-;;;    [face NAME ID FONT FOREGROUND BACKGROUND STIPPLE UNDERLINE]
+;;;    [face NAME ID FONT FOREGROUND BACKGROUND STIPPLE UNDERLINE INVERSE]
 
 ;;; Type checkers.
 (defsubst internal-facep (x)
-  (and (vectorp x) (= (length x) 8) (eq (aref x 0) 'face)))
+  (and (vectorp x) (= (length x) 9) (eq (aref x 0) 'face)))
 
 (defun facep (x)
   "Return t if X is a face name or an internal face vector."
@@ -108,6 +108,13 @@
 If FRAME is omitted or nil, use the selected frame."
  (aref (internal-get-face face frame) 7))
 
+(defun face-inverse-video-p (face &optional frame)
+ "Return t if face FACE is in inverse video.
+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."
+ (aref (internal-get-face face frame) 8))
+
 (defun face-bold-p (face &optional frame)
   "Return non-nil if the font of FACE is bold.
 If the optional argument FRAME is given, report on face FACE in that frame.
@@ -219,6 +226,14 @@
   (interactive (internal-face-interactive "underline-p" "underlined"))
   (internal-set-face-1 face 'underline underline-p 7 frame))
 
+(defun set-face-inverse-video-p (face inverse-video-p &optional frame)
+  "Specify whether face FACE is in inverse video.
+\(Yes if INVERSE-VIDEO-P is non-nil.)
+If the optional FRAME argument is provided, change only
+in that frame; otherwise change each frame."
+  (interactive (internal-face-interactive "inverse-video-p" "inverse-video"))
+  (internal-set-face-1 face 'inverse-video inverse-video-p 8 frame))
+
 (defun set-face-bold-p (face bold-p &optional frame)
   "Specify whether face FACE is bold.  (Yes if BOLD-P is non-nil.)
 If the optional FRAME argument is provided, change only
@@ -323,9 +338,14 @@
   (condition-case nil
       (set-face-stipple face stipple frame)
     (error nil))
-  (cond ((eq bold-p nil) (make-face-unbold face frame t))
-	((eq bold-p t) (make-face-bold face frame t)))
-  (cond ((eq italic-p nil) (make-face-unitalic face frame t))
+  (cond ((eq bold-p nil)
+	 (if (face-font face frame)
+	     (make-face-unbold face frame t)))
+	((eq bold-p t)
+	 (make-face-bold face frame t)))
+  (cond ((eq italic-p nil)
+	 (if (face-font face frame)
+	     (make-face-unitalic face frame t)))
 	((eq italic-p t) (make-face-italic face frame t)))
   (if (memq underline-p '(nil t))
       (set-face-underline-p face underline-p frame))
@@ -378,9 +398,13 @@
 	  (aset (internal-get-face (if (symbolp face) face (face-name face)) t)
 		index value)
 	  value)
-      (or (eq frame t)
-	  (set-face-attribute-internal (face-id face) name value frame))
-      (aset (internal-get-face face frame) index value))))
+      (let ((internal-face (internal-get-face face frame)))
+	(or (eq frame t)
+	    (if (eq name 'inverse-video)
+		(or (eq value (aref internal-face index))
+		    (invert-face face frame))
+	      (set-face-attribute-internal (face-id face) name value frame)))
+	(aset internal-face index value)))))
 
 
 (defun read-face-name (prompt)
@@ -444,7 +468,7 @@
 If the face already exists, it is unmodified."
   (interactive "SMake face: ")
   (or (internal-find-face name)
-      (let ((face (make-vector 8 nil)))
+      (let ((face (make-vector 9 nil)))
 	(aset face 0 'face)
 	(aset face 1 name)
 	(let* ((frames (frame-list))
@@ -1103,35 +1127,10 @@
   (make-face 'secondary-selection)
   (make-face 'underline)
 
-  (setq region-face (face-id 'region))
-
-  ;; Specify the global properties of these faces
-  ;; so they will come out right on new frames.
-
-  (make-face-bold 'bold t)
-  (make-face-italic 'italic t)
-  (make-face-bold-italic 'bold-italic t)
-
-  (set-face-background 'highlight '("darkseagreen2" "green" t) t)
-  (set-face-background 'region '("gray" underline) t)
-  (set-face-background 'secondary-selection '("paleturquoise" "green" t) t)
-  (set-face-background 'modeline '(t) t)
-  (set-face-underline-p 'underline t t)
+  ;; We no longer set up any face attributes here.
+  ;; They are specified in cus-start.el.
 
-  ;; Set up the faces of all existing X Window frames
-  ;; from those global properties, unless already set in a given frame.
-
-  (let ((frames (frame-list)))
-    (while frames
-      (if (not (memq (framep (car frames)) '(t nil)))
-	  (let ((frame (car frames))
-		(rest global-face-data))
-	    (while rest
-	      (let ((face (car (car rest))))
-		(or (face-differs-from-default-p face)
-		    (face-fill-in face (cdr (car rest)) frame)))
-	      (setq rest (cdr rest)))))
-      (setq frames (cdr frames)))))
+  (setq region-face (face-id 'region)))
 
 ;;; Setting a face based on a SPEC.
 
@@ -1154,6 +1153,8 @@
 	  (face-spec-set-1 face frame attrs ':bold 'set-face-bold-p)
 	  (face-spec-set-1 face frame attrs ':italic 'set-face-italic-p)
 	  (face-spec-set-1 face frame attrs ':underline 'set-face-underline-p)
+	  (face-spec-set-1 face frame attrs ':inverse-video
+			   'set-face-inverse-video-p)
 	  (setq tail nil)))))
   (if (null frame)
       (let ((frames (frame-list))
@@ -1239,7 +1240,7 @@
 				     (vector 'face
 					     (face-name (cdr elt))
 					     (face-id (cdr elt))
-					     nil nil nil nil nil)))
+					     nil nil nil nil nil nil)))
 			    global-face-data))
 	      (set-frame-face-alist frame faces)
 
@@ -1287,7 +1288,7 @@
 	      ;; Set up faces from the X resources.
 	      (setq rest faces)
 	      (while rest
-		(make-face-x-resource-internal (cdr (car rest)) frame t)
+		(make-face-x-resource-internal (cdr (car rest)) frame)
 		(setq rest (cdr rest)))
 
 	      ;; Make the frame visible, if desired.
@@ -1400,7 +1401,8 @@
 	    (background (face-background data))
 	    (font (face-font data))
 	    (stipple (face-stipple data)))
-	(set-face-underline-p face (face-underline-p data) frame)
+	(if (face-underline-p data)
+	    (set-face-underline-p face (face-underline-p data) frame))
 	(if foreground
 	    (face-try-color-list 'set-face-foreground
 				 face foreground frame))
@@ -1448,7 +1450,7 @@
 				  (eq function 'set-face-background))
 	  (funcall function face colors frame))
     (if (eq colors t)
-	(invert-face face frame)
+	(set-face-inverse-video-p face t frame)
       (let (done)
 	(while (and colors (not done))
 	  (if (or (memq (car colors) '(t underline))
@@ -1460,7 +1462,7 @@
 		  (condition-case nil
 		      (progn
 			(cond ((eq (car colors) t)
-			       (invert-face face frame))
+			       (set-face-inverse-video-p face t frame))
 			      ((eq (car colors) 'underline)
 			       (set-face-underline-p face t frame))
 			      (t
@@ -1470,7 +1472,7 @@
 		;; If this is the last color, let the error get out if it fails.
 		;; If it succeeds, we will exit anyway after this iteration.
 		(cond ((eq (car colors) t)
-		       (invert-face face frame))
+		       (set-face-inverse-video-p face t frame))
 		      ((eq (car colors) 'underline)
 		       (set-face-underline-p face t frame))
 		      (t