diff options
| author | Richard M. Stallman | 1997-05-25 21:39:38 +0000 |
|---|---|---|
| committer | Richard M. Stallman | 1997-05-25 21:39:38 +0000 |
| commit | e8e4cda0ac9c458bcb56d3d2b8d62e16d9e93682 (patch) | |
| tree | 7f6c8eba3392b0f325539aaf29f51693e149378d | |
| parent | 286c247d12b5a470bc03e45730936eb09cc63d28 (diff) | |
| download | emacs-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.el | 90 |
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). | |||
| 108 | If FRAME is omitted or nil, use the selected frame." | 108 | If 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. | ||
| 113 | If the optional argument FRAME is given, report on face FACE in that frame. | ||
| 114 | If FRAME is t, report on the defaults for face FACE (for new frames). | ||
| 115 | If 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. |
| 113 | If the optional argument FRAME is given, report on face FACE in that frame. | 120 | If 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.) | ||
| 232 | If the optional FRAME argument is provided, change only | ||
| 233 | in 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.) |
| 224 | If the optional FRAME argument is provided, change only | 239 | If 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. | |||
| 444 | If the face already exists, it is unmodified." | 468 | If 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 |