Function: frame-notice-user-settings

frame-notice-user-settings is a byte-compiled function defined in frame.el.gz.

Signature

(frame-notice-user-settings)

Documentation

Act on user's init file settings of frame parameters.

React to settings of initial-frame-alist, window-system-default-frame-alist and default-frame-alist there (in decreasing order of priority).

Source Code

;; Defined in /usr/src/emacs/lisp/frame.el.gz
;; startup.el calls this function after loading the user's init
;; file.  Now default-frame-alist and initial-frame-alist contain
;; information to which we must react; do what needs to be done.
(defun frame-notice-user-settings ()
  "Act on user's init file settings of frame parameters.
React to settings of `initial-frame-alist',
`window-system-default-frame-alist' and `default-frame-alist'
there (in decreasing order of priority)."
  ;; Creating and deleting frames may shift the selected frame around,
  ;; and thus the current buffer.  Protect against that.  We don't
  ;; want to use save-excursion here, because that may also try to set
  ;; the buffer of the selected window, which fails when the selected
  ;; window is the minibuffer.
  (let* ((old-buffer (current-buffer))
	 (window-system-frame-alist
          (cdr (assq initial-window-system
                     window-system-default-frame-alist)))
         (minibuffer
          (cdr (or (assq 'minibuffer initial-frame-alist)
		   (assq 'minibuffer window-system-frame-alist)
		   (assq 'minibuffer default-frame-alist)
		   '(minibuffer . t)))))

    (when (and frame-notice-user-settings
	       (null frame-initial-frame))
      ;; This case happens when we don't have a window system, and
      ;; also for MS-DOS frames.
      (let ((parms (frame-parameters)))
	;; Don't change the frame names.
	(setq parms (delq (assq 'name parms) parms))
	;; Can't modify the minibuffer parameter, so don't try.
	(setq parms (delq (assq 'minibuffer parms) parms))
	(modify-frame-parameters
	 nil
	 (if initial-window-system
	     parms
	   ;; initial-frame-alist and default-frame-alist were already
	   ;; applied in pc-win.el.
	   (append initial-frame-alist window-system-frame-alist
		   default-frame-alist parms nil)))
	(if (null initial-window-system) ;; MS-DOS does this differently in pc-win.el
	    (let ((newparms (frame-parameters))
		  (frame (selected-frame)))
	      (tty-handle-reverse-video frame newparms)
	      ;; tty-handle-reverse-video might change the frame's
	      ;; color parameters, and we need to use the updated
	      ;; value below.
	      (setq newparms (frame-parameters))
	      ;; If we changed the background color, we need to update
	      ;; the background-mode parameter, and maybe some faces,
	      ;; too.
	      (when (assq 'background-color newparms)
		(unless (or (assq 'background-mode initial-frame-alist)
			    (assq 'background-mode default-frame-alist))
		  (frame-set-background-mode frame))
		(face-set-after-frame-default frame newparms))))))

    ;; If the initial frame is still around, apply initial-frame-alist
    ;; and default-frame-alist to it.
    (when (frame-live-p frame-initial-frame)
      ;; When tab-bar has been switched off, correct the frame size
      ;; by the lines added in x-create-frame for the tab-bar and
      ;; switch `tab-bar-mode' off.
      (when (display-graphic-p)
        (declare-function tab-bar-height "xdisp.c" (&optional frame pixelwise))
	(let* ((init-lines
		(assq 'tab-bar-lines initial-frame-alist))
	       (other-lines
		(or (assq 'tab-bar-lines window-system-frame-alist)
		    (assq 'tab-bar-lines default-frame-alist)))
	       (lines (or init-lines other-lines))
	       (height (tab-bar-height frame-initial-frame t)))
	  ;; Adjust frame top if either zero (nil) tab bar lines have
	  ;; been requested in the most relevant of the frame's alists
	  ;; or tab bar mode has been explicitly turned off in the
	  ;; user's init file.
	  (when (and (> height 0)
		     (or (and lines
			      (or (null (cdr lines))
				  (eq 0 (cdr lines))))
			 (not tab-bar-mode)))
	    (let* ((initial-top
		    (cdr (assq 'top frame-initial-geometry-arguments)))
		   (top (frame-parameter frame-initial-frame 'top)))
	      (when (and (consp initial-top) (eq '- (car initial-top)))
		(let ((adjusted-top
		       (cond
			((and (consp top) (eq '+ (car top)))
			 (list '+ (+ (cadr top) height)))
			((and (consp top) (eq '- (car top)))
			 (list '- (- (cadr top) height)))
			(t (+ top height)))))
		  (modify-frame-parameters
		   frame-initial-frame `((top . ,adjusted-top))))))
	    ;; Reset `tab-bar-mode' when zero tab bar lines have been
	    ;; requested for the window-system or default frame alists.
	    (when (and tab-bar-mode
		       (and other-lines
			    (or (null (cdr other-lines))
				(eq 0 (cdr other-lines)))))
	      (tab-bar-mode -1)))))

      ;; When tool-bar has been switched off, correct the frame size
      ;; by the lines added in x-create-frame for the tool-bar and
      ;; switch `tool-bar-mode' off.
      (when (display-graphic-p)
	(let* ((init-lines
		(assq 'tool-bar-lines initial-frame-alist))
	       (other-lines
		(or (assq 'tool-bar-lines window-system-frame-alist)
		    (assq 'tool-bar-lines default-frame-alist)))
	       (lines (or init-lines other-lines))
	       (height (tool-bar-height frame-initial-frame t)))
	  ;; Adjust frame top if either zero (nil) tool bar lines have
	  ;; been requested in the most relevant of the frame's alists
	  ;; or tool bar mode has been explicitly turned off in the
	  ;; user's init file.
	  (when (and (> height 0)
		     (or (and lines
			      (or (null (cdr lines))
				  (eq 0 (cdr lines))))
			 (not tool-bar-mode)))
	    (let* ((initial-top
		    (cdr (assq 'top frame-initial-geometry-arguments)))
		   (top (frame-parameter frame-initial-frame 'top)))
	      (when (and (consp initial-top) (eq '- (car initial-top)))
		(let ((adjusted-top
		       (cond
			((and (consp top) (eq '+ (car top)))
			 (list '+ (+ (cadr top) height)))
			((and (consp top) (eq '- (car top)))
			 (list '- (- (cadr top) height)))
			(t (+ top height)))))
		  (modify-frame-parameters
		   frame-initial-frame `((top . ,adjusted-top))))))
	    ;; Reset `tool-bar-mode' when zero tool bar lines have been
	    ;; requested for the window-system or default frame alists.
	    (when (and tool-bar-mode
		       (and other-lines
			    (or (null (cdr other-lines))
				(eq 0 (cdr other-lines)))))
	      (tool-bar-mode -1)))))

      ;; The initial frame we create above always has a minibuffer.
      ;; If the user wants to remove it, or make it a minibuffer-only
      ;; frame, then we'll have to delete the current frame and make a
      ;; new one; you can't remove or add a root window to/from an
      ;; existing frame.
      ;;
      ;; NOTE: default-frame-alist was nil when we created the
      ;; existing frame.  We need to explicitly include
      ;; default-frame-alist in the parameters of the screen we
      ;; create here, so that its new value, gleaned from the user's
      ;; init file, will be applied to the existing screen.
      (if (not (eq minibuffer t))
	  ;; Create the new frame.
	  (let (parms new)
	    ;; MS-Windows needs this to avoid inflooping below.
	    (if (eq system-type 'windows-nt)
		(sit-for 0 t))
	    ;; If the frame isn't visible yet, wait till it is.
	    ;; If the user has to position the window,
	    ;; Emacs doesn't know its real position until
	    ;; the frame is seen to be visible.
	    (while (not (cdr (assq 'visibility
				   (frame-parameters frame-initial-frame))))
	      (sleep-for 1))
	    (setq parms (frame-parameters frame-initial-frame))

            ;; Get rid of `name' unless it was specified explicitly before.
	    (or (assq 'name frame-initial-frame-alist)
		(setq parms (delq (assq 'name parms) parms)))
	    ;; An explicit parent-id is a request to XEmbed the frame.
	    (or (assq 'parent-id frame-initial-frame-alist)
                (setq parms (delq (assq 'parent-id parms) parms)))

	    (setq parms (append initial-frame-alist
				window-system-frame-alist
				default-frame-alist
				parms
				nil))

	    (when (eq minibuffer 'child-frame)
              ;; When the minibuffer shall be shown in a child frame,
              ;; remove the 'minibuffer' parameter from PARMS.  It
              ;; will get assigned by the usual routines to the child
              ;; frame's root window below.
              (setq parms (cons '(minibuffer)
				(delq (assq 'minibuffer parms) parms))))

            ;; Get rid of `reverse', because that was handled
	    ;; when we first made the frame.
	    (setq parms (cons '(reverse) (delq (assq 'reverse parms) parms)))

	    (if (assq 'height frame-initial-geometry-arguments)
		(setq parms (assq-delete-all 'height parms)))
	    (if (assq 'width frame-initial-geometry-arguments)
		(setq parms (assq-delete-all 'width parms)))
	    (if (assq 'left frame-initial-geometry-arguments)
		(setq parms (assq-delete-all 'left parms)))
	    (if (assq 'top frame-initial-geometry-arguments)
		(setq parms (assq-delete-all 'top parms)))
	    (setq new
		  (make-frame
		   ;; Use the geometry args that created the existing
		   ;; frame, rather than the parms we get for it.
		   (append frame-initial-geometry-arguments
			   '((user-size . t) (user-position . t))
			   parms)))
	    ;; The initial frame, which we are about to delete, may be
	    ;; the only frame with a minibuffer.  If it is, create a
	    ;; new one.
	    (or (delq frame-initial-frame (minibuffer-frame-list))
                (and (eq minibuffer 'child-frame)
                     ;; Create a minibuffer child frame and parent it
                     ;; immediately.  Take any other parameters for
                     ;; the child frame from 'minibuffer-frame-list'.
                     (let* ((minibuffer-frame-alist
                             (cons `(parent-frame . ,new) minibuffer-frame-alist)))
                       (make-initial-minibuffer-frame nil)
                       ;; With a minibuffer child frame we do not want
                       ;; to select the minibuffer frame initially as
                       ;; we do for standard minibuffer-only frames.
                       (select-frame new)))
                (make-initial-minibuffer-frame nil))

	    ;; If the initial frame is serving as a surrogate
	    ;; minibuffer frame for any frames, we need to wean them
	    ;; onto a new frame.  The default-minibuffer-frame
	    ;; variable must be handled similarly.
	    (let ((users-of-initial
		   (filtered-frame-list
                    (lambda (frame)
                      (and (not (eq frame frame-initial-frame))
                           (eq (window-frame
                                (minibuffer-window frame))
                               frame-initial-frame))))))
              (if (or users-of-initial
		      (eq default-minibuffer-frame frame-initial-frame))

		  ;; Choose an appropriate frame.  Prefer frames which
		  ;; are only minibuffers.
		  (let* ((new-surrogate
			  (car
			   (or (filtered-frame-list
                                (lambda (frame)
                                  (eq (cdr (assq 'minibuffer
                                                 (frame-parameters frame)))
                                      'only)))
			       (minibuffer-frame-list))))
			 (new-minibuffer (minibuffer-window new-surrogate)))

		    (if (eq default-minibuffer-frame frame-initial-frame)
			(setq default-minibuffer-frame new-surrogate))

		    ;; Wean the frames using frame-initial-frame as
		    ;; their minibuffer frame.
		    (dolist (frame users-of-initial)
                      (modify-frame-parameters
                       frame (list (cons 'minibuffer new-minibuffer)))))))

            ;; Redirect events enqueued at this frame to the new frame.
	    ;; Is this a good idea?
	    (redirect-frame-focus frame-initial-frame new)

	    ;; Finally, get rid of the old frame.
	    (delete-frame frame-initial-frame t))

	;; Otherwise, we don't need all that rigmarole; just apply
	;; the new parameters.
	(let (newparms allparms tail)
	  (setq allparms (append initial-frame-alist
				 window-system-frame-alist
				 default-frame-alist nil))
	  (if (assq 'height frame-initial-geometry-arguments)
	      (setq allparms (assq-delete-all 'height allparms)))
	  (if (assq 'width frame-initial-geometry-arguments)
	      (setq allparms (assq-delete-all 'width allparms)))
	  (if (assq 'left frame-initial-geometry-arguments)
	      (setq allparms (assq-delete-all 'left allparms)))
	  (if (assq 'top frame-initial-geometry-arguments)
	      (setq allparms (assq-delete-all 'top allparms)))
	  (setq tail allparms)
	  ;; Find just the parms that have changed since we first
	  ;; made this frame.  Those are the ones actually set by
          ;; the init file.  For those parms whose values we already knew
	  ;; (such as those spec'd by command line options)
	  ;; it is undesirable to specify the parm again
          ;; once the user has seen the frame and been able to alter it
	  ;; manually.
	  (let (newval oldval)
	    (dolist (entry tail)
	      (setq oldval (assq (car entry) frame-initial-frame-alist))
	      (setq newval (cdr (assq (car entry) allparms)))
	      (or (and oldval (eq (cdr oldval) newval))
		  (setq newparms
			(cons (cons (car entry) newval) newparms)))))
	  (setq newparms (nreverse newparms))

	  (let ((new-bg (assq 'background-color newparms)))
	    ;; If the `background-color' parameter is changed, apply
	    ;; it first, then make sure that the `background-mode'
	    ;; parameter and other faces are updated, before applying
	    ;; the other parameters.
	    (when new-bg
	      (modify-frame-parameters frame-initial-frame
				       (list new-bg))
	      (unless (assq 'background-mode newparms)
		(frame-set-background-mode frame-initial-frame))
	      (face-set-after-frame-default frame-initial-frame)
	      (setq newparms (delq new-bg newparms)))

	    (modify-frame-parameters frame-initial-frame newparms)))))

    ;; Restore the original buffer.
    (set-buffer old-buffer)

    ;; Make sure the initial frame can be GC'd if it is ever deleted.
    ;; Make sure frame-notice-user-settings does nothing if called twice.
    (setq frame-notice-user-settings nil)
    (setq frame-initial-frame nil)))