# HG changeset patch # User Richard M. Stallman # Date 1198985554 0 # Node ID bdb41961250324fd8390ff86c810c1a30c6e8244 # Parent 66dec6867b407165a15bf0a99c7844d279de3786 (face-spec-set): Third arg is now FOR-DEFFACE. Use of frame as third arg is deprecated. Handle `face-override-spec' property. (face-spec-recalc): New function. (face-spec-set-2): New function. (frame-set-background-mode): Handle `face-override-spec' property. Use `face-spec-recalc'. (face-set-after-frame-default): Use `face-spec-recalc'. diff -r 66dec6867b40 -r bdb419612503 lisp/faces.el --- a/lisp/faces.el Sat Dec 29 23:39:51 2007 +0000 +++ b/lisp/faces.el Sun Dec 30 03:32:34 2007 +0000 @@ -1445,46 +1445,79 @@ (setq attrs (cdr attrs))))) -(defun face-spec-set (face spec &optional frame) - "Set FACE's attributes according to the first matching entry in SPEC. -FRAME is the frame whose frame-local face is set. FRAME nil means -do it on all frames (and change the default for new frames). -See `defface' for information about SPEC. If SPEC is nil, do nothing." - (let ((attrs (face-spec-choose spec frame))) - (when spec - (face-spec-reset-face face (or frame t))) +(defun face-spec-set (face spec &optional for-defface) + "Set FACE's face spec, which controls its appearance, to SPEC> +If FOR-DEFFACE is t, set the base spec, the one that `defface' + and Custom set. (In that case, the caller must put it in the + appropriate property, because that depends on the caller.) +If FOR-DEFFACE is nil, set the overriding spec (and store it + in the `face-override-spec' property of FACE). + +The appearance of FACE is controlled by the base spec, +by any custom theme specs on top of that, and by the +the overriding spec on top of all the rest. + +FOR-DEFFACE can also be a frame, in which case we set the +frame-specific attributes of FACE for that frame based on SPEC. +That usage is deprecated. + +See `defface' for information about the format and meaning of SPEC." + (if (framep for-defface) + ;; Handle the deprecated case where third arg is a frame. + (face-spec-set-2 face for-defface spec) + (if for-defface + ;; When we reset the face based on its custom spec, then it is + ;; unmodified as far as Custom is concerned. + (put (or (get face 'face-alias) face) 'face-modified nil) + ;; When we change a face based on a spec from outside custom, + ;; record it for future frames. + (put (or (get face 'face-alias) face) 'face-override-spec spec)) +;;; RMS 29 dec 2007: Perhaps this code should be reinstated. +;;; That depends on whether the overriding spec +;;; or the default face attributes +;;; should take priority. +;;; ;; Clear all the new-frame default attributes for this face. +;;; ;; face-spec-reset-face won't do it right. +;;; (let ((facevec (cdr (assq face face-new-frame-defaults)))) +;;; (dotimes (i (length facevec)) +;;; (unless (= i 0) +;;; (aset facevec i 'unspecified)))) + ;; Reset each frame according to the rules implied by all its specs. + (dolist (frame (frame-list)) + (face-spec-recalc face frame)))) + +(defun face-spec-recalc (face frame) + "Reset the face attributes of FACE on FRAME according to its specs. +This applies the defface/custom spec first, then the custom theme specs, +then the override spec." + (face-spec-reset-face face frame) + (let ((face-sym (or (get face 'face-alias) face))) + (face-spec-set-2 face frame + (face-user-default-spec face)) + (let ((theme-faces (reverse (get face-sym 'theme-face)))) + (dolist (spec theme-faces) + (face-spec-set-2 face frame (cadr spec)))) + (face-spec-set-2 face frame (get face-sym 'face-override-spec)))) + +(defun face-spec-set-2 (face frame spec) + "Set the face attributes of FACE on FRAME according to SPEC." + (let* ((attrs (face-spec-choose spec frame))) (while attrs (let ((attribute (car attrs)) (value (car (cdr attrs)))) ;; Support some old-style attribute names and values. (case attribute - (:bold (setq attribute :weight value (if value 'bold 'normal))) - (:italic (setq attribute :slant value (if value 'italic 'normal))) - ((:foreground :background) - ;; Compatibility with 20.x. Some bogus face specs seem to - ;; exist containing things like `:foreground nil'. - (if (null value) (setq value 'unspecified))) - (t (unless (assq attribute face-x-resources) - (setq attribute nil)))) + (:bold (setq attribute :weight value (if value 'bold 'normal))) + (:italic (setq attribute :slant value (if value 'italic 'normal))) + ((:foreground :background) + ;; Compatibility with 20.x. Some bogus face specs seem to + ;; exist containing things like `:foreground nil'. + (if (null value) (setq value 'unspecified))) + (t (unless (assq attribute face-x-resources) + (setq attribute nil)))) (when attribute - ;; If frame is nil, set the default for new frames. - ;; Existing frames are handled below. - (set-face-attribute face (or frame t) attribute value))) - (setq attrs (cdr (cdr attrs))))) - (unless frame - ;; When we reset the face based on its spec, then it is unmodified - ;; as far as Custom is concerned. - (put (or (get face 'face-alias) face) 'face-modified nil) -;;; ;; Clear all the new-frame defaults for this face. -;;; ;; face-spec-reset-face won't do it right. -;;; (let ((facevec (cdr (assq face face-new-frame-defaults)))) -;;; (dotimes (i (length facevec)) -;;; (unless (= i 0) -;;; (aset facevec i 'unspecified)))) - ;; Set each frame according to the rules implied by SPEC. - (dolist (frame (frame-list)) - (face-spec-set face spec frame)))) - + (set-face-attribute face frame attribute value))) + (setq attrs (cdr (cdr attrs)))))) (defun face-attr-match-p (face attrs &optional frame) "Return t if attributes of FACE match values in plist ATTRS. @@ -1797,14 +1830,16 @@ (let ((locally-modified-faces nil)) ;; Before modifying the frame parameters, we collect a list of ;; faces that don't match what their face-spec says they should - ;; look like; we then avoid changing these faces below. A - ;; negative list is used on the assumption that most faces will + ;; look like; we then avoid changing these faces below. + ;; These are the faces whose attributes were modified on FRAME. + ;; We use a negative list on the assumption that most faces will ;; be unmodified, so we can avoid consing in the common case. (dolist (face (face-list)) - (when (not (face-spec-match-p face - (face-user-default-spec face) - (selected-frame))) - (push face locally-modified-faces))) + (and (not (get face 'face-override-spec)) + (not (face-spec-match-p face + (face-user-default-spec face) + (selected-frame))) + (push face locally-modified-faces))) ;; Now change to the new frame parameters (modify-frame-parameters frame (list (cons 'background-mode bg-mode) @@ -1813,7 +1848,7 @@ ;; parameters, unless they have been locally modified. (dolist (face (face-list)) (unless (memq face locally-modified-faces) - (face-spec-set face (face-user-default-spec face) frame))))))) + (face-spec-recalc face frame))))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -1947,7 +1982,7 @@ (dolist (face (delq 'default (face-list))) (condition-case () (progn - (face-spec-set face (face-user-default-spec face) frame) + (face-spec-recalc face frame) (if (memq (window-system frame) '(x w32 mac)) (make-face-x-resource-internal face frame)) (internal-merge-in-global-face face frame))