- (x-get-resource ".backgroundMode" "BackgroundMode")))
- (bg-mode (cond (frame-background-mode)
- ((null window-system)
- ;; No way to determine this automatically (?).
- 'dark)
- (bg-resource
- (intern (downcase bg-resource)))
- ((< (apply '+ (x-color-values
- (frame-parameter frame 'background-color)
- frame))
- ;; Just looking at the screen, colors whose
- ;; values add up to .6 of the white total
- ;; still look dark to me.
- (* (apply '+ (x-color-values "white" frame)) .6))
- 'dark)
- (t 'light)))
- (display-type (cond ((null window-system)
- (if (tty-display-color-p frame) 'color 'mono))
- ((x-display-color-p frame)
- 'color)
- ((x-display-grayscale-p frame)
- 'grayscale)
- (t 'mono))))
- (modify-frame-parameters frame
- (list (cons 'background-mode bg-mode)
- (cons 'display-type display-type))))
-
- ;; For all named faces, choose face specs matching the new frame
- ;; parameters.
- (let ((face-list (face-list)))
- (while face-list
- (let* ((face (car face-list))
- (spec (get face 'face-defface-spec)))
- (when spec
- (face-spec-set face spec frame))
- (setq face-list (cdr face-list))))))
-
-
+ (x-get-resource "backgroundMode" "BackgroundMode")))
+ (bg-color (frame-parameter frame 'background-color))
+ (bg-mode
+ (cond (frame-background-mode)
+ (bg-resource
+ (intern (downcase bg-resource)))
+ ((and (null window-system) (null bg-color))
+ ;; No way to determine this automatically (?).
+ (or default-frame-background-mode 'dark))
+ ;; Unspecified frame background color can only happen
+ ;; on tty's.
+ ((member bg-color '(unspecified "unspecified-bg"))
+ (or default-frame-background-mode 'dark))
+ ((equal bg-color "unspecified-fg") ; inverted colors
+ (if (eq default-frame-background-mode 'light) 'dark 'light))
+ ((>= (apply '+ (x-color-values bg-color frame))
+ ;; Just looking at the screen, colors whose
+ ;; values add up to .6 of the white total
+ ;; still look dark to me.
+ (* (apply '+ (x-color-values "white" frame)) .6))
+ 'light)
+ (t 'dark)))
+ (display-type
+ (cond ((null window-system)
+ (if (tty-display-color-p frame) 'color 'mono))
+ ((x-display-color-p frame)
+ 'color)
+ ((x-display-grayscale-p frame)
+ 'grayscale)
+ (t 'mono)))
+ (old-bg-mode
+ (frame-parameter frame 'background-mode))
+ (old-display-type
+ (frame-parameter frame 'display-type)))
+
+ (unless (and (eq bg-mode old-bg-mode) (eq display-type old-display-type))
+ (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
+ ;; 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)))
+ ;; Now change to the new frame parameters
+ (modify-frame-parameters frame
+ (list (cons 'background-mode bg-mode)
+ (cons 'display-type display-type)))
+ ;; For all named faces, choose face specs matching the new frame
+ ;; 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)))))))