aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorRichard M. Stallman1997-05-25 21:39:38 +0000
committerRichard M. Stallman1997-05-25 21:39:38 +0000
commite8e4cda0ac9c458bcb56d3d2b8d62e16d9e93682 (patch)
tree7f6c8eba3392b0f325539aaf29f51693e149378d
parent286c247d12b5a470bc03e45730936eb09cc63d28 (diff)
downloademacs-e8e4cda0ac9c458bcb56d3d2b8d62e16d9e93682.tar.gz
emacs-e8e4cda0ac9c458bcb56d3d2b8d62e16d9e93682.zip
(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.
-rw-r--r--lisp/faces.el90
1 files changed, 46 insertions, 44 deletions
diff --git a/lisp/faces.el b/lisp/faces.el
index 30ce1405e9d..d8e12bafad7 100644
--- a/lisp/faces.el
+++ b/lisp/faces.el
@@ -44,11 +44,11 @@
44;;;; Functions for manipulating face vectors. 44;;;; Functions for manipulating face vectors.
45 45
46;;; A face vector is a vector of the form: 46;;; A face vector is a vector of the form:
47;;; [face NAME ID FONT FOREGROUND BACKGROUND STIPPLE UNDERLINE] 47;;; [face NAME ID FONT FOREGROUND BACKGROUND STIPPLE UNDERLINE INVERSE]
48 48
49;;; Type checkers. 49;;; Type checkers.
50(defsubst internal-facep (x) 50(defsubst internal-facep (x)
51 (and (vectorp x) (= (length x) 8) (eq (aref x 0) 'face))) 51 (and (vectorp x) (= (length x) 9) (eq (aref x 0) 'face)))
52 52
53(defun facep (x) 53(defun facep (x)
54 "Return t if X is a face name or an internal face vector." 54 "Return t if X is a face name or an internal face vector."
@@ -108,6 +108,13 @@ If FRAME is t, report on the defaults for face FACE (for new frames).
108If FRAME is omitted or nil, use the selected frame." 108If FRAME is omitted or nil, use the selected frame."
109 (aref (internal-get-face face frame) 7)) 109 (aref (internal-get-face face frame) 7))
110 110
111(defun face-inverse-video-p (face &optional frame)
112 "Return t if face FACE is in inverse video.
113If the optional argument FRAME is given, report on face FACE in that frame.
114If FRAME is t, report on the defaults for face FACE (for new frames).
115If FRAME is omitted or nil, use the selected frame."
116 (aref (internal-get-face face frame) 8))
117
111(defun face-bold-p (face &optional frame) 118(defun face-bold-p (face &optional frame)
112 "Return non-nil if the font of FACE is bold. 119 "Return non-nil if the font of FACE is bold.
113If the optional argument FRAME is given, report on face FACE in that frame. 120If the optional argument FRAME is given, report on face FACE in that frame.
@@ -219,6 +226,14 @@ in that frame; otherwise change each frame."
219 (interactive (internal-face-interactive "underline-p" "underlined")) 226 (interactive (internal-face-interactive "underline-p" "underlined"))
220 (internal-set-face-1 face 'underline underline-p 7 frame)) 227 (internal-set-face-1 face 'underline underline-p 7 frame))
221 228
229(defun set-face-inverse-video-p (face inverse-video-p &optional frame)
230 "Specify whether face FACE is in inverse video.
231\(Yes if INVERSE-VIDEO-P is non-nil.)
232If the optional FRAME argument is provided, change only
233in that frame; otherwise change each frame."
234 (interactive (internal-face-interactive "inverse-video-p" "inverse-video"))
235 (internal-set-face-1 face 'inverse-video inverse-video-p 8 frame))
236
222(defun set-face-bold-p (face bold-p &optional frame) 237(defun set-face-bold-p (face bold-p &optional frame)
223 "Specify whether face FACE is bold. (Yes if BOLD-P is non-nil.) 238 "Specify whether face FACE is bold. (Yes if BOLD-P is non-nil.)
224If the optional FRAME argument is provided, change only 239If the optional FRAME argument is provided, change only
@@ -323,9 +338,14 @@ If called interactively, prompts for a face name and face attributes."
323 (condition-case nil 338 (condition-case nil
324 (set-face-stipple face stipple frame) 339 (set-face-stipple face stipple frame)
325 (error nil)) 340 (error nil))
326 (cond ((eq bold-p nil) (make-face-unbold face frame t)) 341 (cond ((eq bold-p nil)
327 ((eq bold-p t) (make-face-bold face frame t))) 342 (if (face-font face frame)
328 (cond ((eq italic-p nil) (make-face-unitalic face frame t)) 343 (make-face-unbold face frame t)))
344 ((eq bold-p t)
345 (make-face-bold face frame t)))
346 (cond ((eq italic-p nil)
347 (if (face-font face frame)
348 (make-face-unitalic face frame t)))
329 ((eq italic-p t) (make-face-italic face frame t))) 349 ((eq italic-p t) (make-face-italic face frame t)))
330 (if (memq underline-p '(nil t)) 350 (if (memq underline-p '(nil t))
331 (set-face-underline-p face underline-p frame)) 351 (set-face-underline-p face underline-p frame))
@@ -378,9 +398,13 @@ If NAME is already a face, it is simply returned."
378 (aset (internal-get-face (if (symbolp face) face (face-name face)) t) 398 (aset (internal-get-face (if (symbolp face) face (face-name face)) t)
379 index value) 399 index value)
380 value) 400 value)
381 (or (eq frame t) 401 (let ((internal-face (internal-get-face face frame)))
382 (set-face-attribute-internal (face-id face) name value frame)) 402 (or (eq frame t)
383 (aset (internal-get-face face frame) index value)))) 403 (if (eq name 'inverse-video)
404 (or (eq value (aref internal-face index))
405 (invert-face face frame))
406 (set-face-attribute-internal (face-id face) name value frame)))
407 (aset internal-face index value)))))
384 408
385 409
386(defun read-face-name (prompt) 410(defun read-face-name (prompt)
@@ -444,7 +468,7 @@ and always make a face whose attributes are all nil.
444If the face already exists, it is unmodified." 468If the face already exists, it is unmodified."
445 (interactive "SMake face: ") 469 (interactive "SMake face: ")
446 (or (internal-find-face name) 470 (or (internal-find-face name)
447 (let ((face (make-vector 8 nil))) 471 (let ((face (make-vector 9 nil)))
448 (aset face 0 'face) 472 (aset face 0 'face)
449 (aset face 1 name) 473 (aset face 1 name)
450 (let* ((frames (frame-list)) 474 (let* ((frames (frame-list))
@@ -1103,35 +1127,10 @@ selected frame."
1103 (make-face 'secondary-selection) 1127 (make-face 'secondary-selection)
1104 (make-face 'underline) 1128 (make-face 'underline)
1105 1129
1106 (setq region-face (face-id 'region)) 1130 ;; We no longer set up any face attributes here.
1107 1131 ;; They are specified in cus-start.el.
1108 ;; Specify the global properties of these faces 1132
1109 ;; so they will come out right on new frames. 1133 (setq region-face (face-id 'region)))
1110
1111 (make-face-bold 'bold t)
1112 (make-face-italic 'italic t)
1113 (make-face-bold-italic 'bold-italic t)
1114
1115 (set-face-background 'highlight '("darkseagreen2" "green" t) t)
1116 (set-face-background 'region '("gray" underline) t)
1117 (set-face-background 'secondary-selection '("paleturquoise" "green" t) t)
1118 (set-face-background 'modeline '(t) t)
1119 (set-face-underline-p 'underline t t)
1120
1121 ;; Set up the faces of all existing X Window frames
1122 ;; from those global properties, unless already set in a given frame.
1123
1124 (let ((frames (frame-list)))
1125 (while frames
1126 (if (not (memq (framep (car frames)) '(t nil)))
1127 (let ((frame (car frames))
1128 (rest global-face-data))
1129 (while rest
1130 (let ((face (car (car rest))))
1131 (or (face-differs-from-default-p face)
1132 (face-fill-in face (cdr (car rest)) frame)))
1133 (setq rest (cdr rest)))))
1134 (setq frames (cdr frames)))))
1135 1134
1136;;; Setting a face based on a SPEC. 1135;;; Setting a face based on a SPEC.
1137 1136
@@ -1154,6 +1153,8 @@ See `defface' for information about SPEC."
1154 (face-spec-set-1 face frame attrs ':bold 'set-face-bold-p) 1153 (face-spec-set-1 face frame attrs ':bold 'set-face-bold-p)
1155 (face-spec-set-1 face frame attrs ':italic 'set-face-italic-p) 1154 (face-spec-set-1 face frame attrs ':italic 'set-face-italic-p)
1156 (face-spec-set-1 face frame attrs ':underline 'set-face-underline-p) 1155 (face-spec-set-1 face frame attrs ':underline 'set-face-underline-p)
1156 (face-spec-set-1 face frame attrs ':inverse-video
1157 'set-face-inverse-video-p)
1157 (setq tail nil))))) 1158 (setq tail nil)))))
1158 (if (null frame) 1159 (if (null frame)
1159 (let ((frames (frame-list)) 1160 (let ((frames (frame-list))
@@ -1239,7 +1240,7 @@ If FRAME is nil, the current FRAME is used."
1239 (vector 'face 1240 (vector 'face
1240 (face-name (cdr elt)) 1241 (face-name (cdr elt))
1241 (face-id (cdr elt)) 1242 (face-id (cdr elt))
1242 nil nil nil nil nil))) 1243 nil nil nil nil nil nil)))
1243 global-face-data)) 1244 global-face-data))
1244 (set-frame-face-alist frame faces) 1245 (set-frame-face-alist frame faces)
1245 1246
@@ -1287,7 +1288,7 @@ If FRAME is nil, the current FRAME is used."
1287 ;; Set up faces from the X resources. 1288 ;; Set up faces from the X resources.
1288 (setq rest faces) 1289 (setq rest faces)
1289 (while rest 1290 (while rest
1290 (make-face-x-resource-internal (cdr (car rest)) frame t) 1291 (make-face-x-resource-internal (cdr (car rest)) frame)
1291 (setq rest (cdr rest))) 1292 (setq rest (cdr rest)))
1292 1293
1293 ;; Make the frame visible, if desired. 1294 ;; Make the frame visible, if desired.
@@ -1400,7 +1401,8 @@ examine the brightness for you."
1400 (background (face-background data)) 1401 (background (face-background data))
1401 (font (face-font data)) 1402 (font (face-font data))
1402 (stipple (face-stipple data))) 1403 (stipple (face-stipple data)))
1403 (set-face-underline-p face (face-underline-p data) frame) 1404 (if (face-underline-p data)
1405 (set-face-underline-p face (face-underline-p data) frame))
1404 (if foreground 1406 (if foreground
1405 (face-try-color-list 'set-face-foreground 1407 (face-try-color-list 'set-face-foreground
1406 face foreground frame)) 1408 face foreground frame))
@@ -1448,7 +1450,7 @@ examine the brightness for you."
1448 (eq function 'set-face-background)) 1450 (eq function 'set-face-background))
1449 (funcall function face colors frame)) 1451 (funcall function face colors frame))
1450 (if (eq colors t) 1452 (if (eq colors t)
1451 (invert-face face frame) 1453 (set-face-inverse-video-p face t frame)
1452 (let (done) 1454 (let (done)
1453 (while (and colors (not done)) 1455 (while (and colors (not done))
1454 (if (or (memq (car colors) '(t underline)) 1456 (if (or (memq (car colors) '(t underline))
@@ -1460,7 +1462,7 @@ examine the brightness for you."
1460 (condition-case nil 1462 (condition-case nil
1461 (progn 1463 (progn
1462 (cond ((eq (car colors) t) 1464 (cond ((eq (car colors) t)
1463 (invert-face face frame)) 1465 (set-face-inverse-video-p face t frame))
1464 ((eq (car colors) 'underline) 1466 ((eq (car colors) 'underline)
1465 (set-face-underline-p face t frame)) 1467 (set-face-underline-p face t frame))
1466 (t 1468 (t
@@ -1470,7 +1472,7 @@ examine the brightness for you."
1470 ;; If this is the last color, let the error get out if it fails. 1472 ;; If this is the last color, let the error get out if it fails.
1471 ;; If it succeeds, we will exit anyway after this iteration. 1473 ;; If it succeeds, we will exit anyway after this iteration.
1472 (cond ((eq (car colors) t) 1474 (cond ((eq (car colors) t)
1473 (invert-face face frame)) 1475 (set-face-inverse-video-p face t frame))
1474 ((eq (car colors) 'underline) 1476 ((eq (car colors) 'underline)
1475 (set-face-underline-p face t frame)) 1477 (set-face-underline-p face t frame))
1476 (t 1478 (t