mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2024-12-29 11:02:01 +00:00
(set-face-attribute, face-spec-reset-face)
(face-spec-set): Avoid consing by removing calls to `apply'.
This commit is contained in:
parent
a2e2aa2c29
commit
bfe27647ad
@ -550,9 +550,16 @@ like an underlying face would be, with higher priority than underlying faces."
|
|||||||
(cond ((null frame)
|
(cond ((null frame)
|
||||||
;; Change face on all frames.
|
;; Change face on all frames.
|
||||||
(dolist (frame (frame-list))
|
(dolist (frame (frame-list))
|
||||||
(apply #'set-face-attribute face frame args))
|
(let ((list args))
|
||||||
|
(while list
|
||||||
|
(internal-set-lisp-face-attribute face (car list)
|
||||||
|
(cadr list) frame)
|
||||||
|
(setq list (cdr (cdr list))))))
|
||||||
;; Record that as a default for new frames.
|
;; Record that as a default for new frames.
|
||||||
(apply #'set-face-attribute face t args))
|
(while args
|
||||||
|
(internal-set-lisp-face-attribute face (car args)
|
||||||
|
(cadr args) t)
|
||||||
|
(setq args (cdr (cdr args)))))
|
||||||
(t
|
(t
|
||||||
(while args
|
(while args
|
||||||
(internal-set-lisp-face-attribute face (car args)
|
(internal-set-lisp-face-attribute face (car args)
|
||||||
@ -1168,21 +1175,19 @@ If FRAME is nil, the current FRAME is used."
|
|||||||
|
|
||||||
(defun face-spec-reset-face (face &optional frame)
|
(defun face-spec-reset-face (face &optional frame)
|
||||||
"Reset all attributes of FACE on FRAME to unspecified."
|
"Reset all attributes of FACE on FRAME to unspecified."
|
||||||
(let ((attrs face-attribute-name-alist)
|
(let ((attrs face-attribute-name-alist))
|
||||||
params)
|
|
||||||
(while attrs
|
(while attrs
|
||||||
(let ((attr-and-name (car attrs)))
|
(let ((attr-and-name (car attrs)))
|
||||||
(setq params (cons (car attr-and-name) (cons 'unspecified params))))
|
(set-face-attribute face frame (car attr-and-name) 'unspecified))
|
||||||
(setq attrs (cdr attrs)))
|
(setq attrs (cdr attrs)))))
|
||||||
(apply #'set-face-attribute face frame params)))
|
|
||||||
|
|
||||||
|
|
||||||
(defun face-spec-set (face spec &optional frame)
|
(defun face-spec-set (face spec &optional frame)
|
||||||
"Set FACE's attributes according to the first matching entry in SPEC.
|
"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
|
FRAME is the frame whose frame-local face is set. FRAME nil means
|
||||||
do it on all frames. See `defface' for information about SPEC."
|
do it on all frames. See `defface' for information about SPEC."
|
||||||
(let ((attrs (face-spec-choose spec frame))
|
(let ((attrs (face-spec-choose spec frame)))
|
||||||
params)
|
(face-spec-reset-face face frame)
|
||||||
(while attrs
|
(while attrs
|
||||||
(let ((attribute (car attrs))
|
(let ((attribute (car attrs))
|
||||||
(value (car (cdr attrs))))
|
(value (car (cdr attrs))))
|
||||||
@ -1193,10 +1198,8 @@ do it on all frames. See `defface' for information about SPEC."
|
|||||||
(t (unless (assq attribute face-x-resources)
|
(t (unless (assq attribute face-x-resources)
|
||||||
(setq attribute nil))))
|
(setq attribute nil))))
|
||||||
(when attribute
|
(when attribute
|
||||||
(setq params (cons attribute (cons value params)))))
|
(set-face-attribute face frame attribute value)))
|
||||||
(setq attrs (cdr (cdr attrs))))
|
(setq attrs (cdr (cdr attrs))))))
|
||||||
(face-spec-reset-face face frame)
|
|
||||||
(apply #'set-face-attribute face frame params)))
|
|
||||||
|
|
||||||
|
|
||||||
(defun face-attr-match-p (face attrs &optional frame)
|
(defun face-attr-match-p (face attrs &optional frame)
|
||||||
|
Loading…
Reference in New Issue
Block a user