- (if (frame-live-p frame-initial-frame)
-
- ;; 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
- ;; .emacs file, will be applied to the existing screen.
- (if (not (eq (cdr (or (assq 'minibuffer initial-frame-alist)
- (assq 'minibuffer default-frame-alist)
- '(minibuffer . t)))
- t))
- ;; Create the new frame.
- (let (parms new)
- ;; 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)))
- (setq parms (append initial-frame-alist
- default-frame-alist
- parms
- nil))
- ;; 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 (assoc-delete-all 'height parms)))
- (if (assq 'width frame-initial-geometry-arguments)
- (setq parms (assoc-delete-all 'width parms)))
- (if (assq 'left frame-initial-geometry-arguments)
- (setq parms (assoc-delete-all 'left parms)))
- (if (assq 'top frame-initial-geometry-arguments)
- (setq parms (assoc-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))
- (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
- (function (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
- (function
- (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.
- (mapcar
- (function
- (lambda (frame)
- (modify-frame-parameters
- frame (list (cons 'minibuffer new-minibuffer)))))
- users-of-initial))))
-
- ;; 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 rigamarole; just apply
- ;; the new parameters.
- (let (newparms allparms tail)
- (setq allparms (append initial-frame-alist
- default-frame-alist))
+ (when (frame-live-p frame-initial-frame)
+
+ ;; 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 ((tool-bar-lines (or (assq 'tool-bar-lines initial-frame-alist)
+ (assq 'tool-bar-lines default-frame-alist))))
+ (when (and tool-bar-originally-present
+ (or (null tool-bar-lines)
+ (null (cdr tool-bar-lines))
+ (eq 0 (cdr tool-bar-lines))))
+ (let* ((char-height (frame-char-height frame-initial-frame))
+ (image-height tool-bar-images-pixel-height)
+ (margin (cond ((and (consp tool-bar-button-margin)
+ (integerp (cdr tool-bar-button-margin))
+ (> tool-bar-button-margin 0))
+ (cdr tool-bar-button-margin))
+ ((and (integerp tool-bar-button-margin)
+ (> tool-bar-button-margin 0))
+ tool-bar-button-margin)
+ (t 0)))
+ (relief (if (and (integerp tool-bar-button-relief)
+ (> tool-bar-button-relief 0))
+ tool-bar-button-relief 3))
+ (lines (/ (+ image-height
+ (* 2 margin)
+ (* 2 relief)
+ (1- char-height))
+ char-height))
+ (height (frame-parameter frame-initial-frame 'height))
+ (newparms (list (cons 'height (- height lines))))
+ (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)
+ (* lines char-height))))
+ ((and (consp top)
+ (eq '- (car top)))
+ (list '-
+ (- (cadr top)
+ (* lines char-height))))
+ (t (+ top (* lines char-height))))))
+ (setq newparms
+ (append newparms
+ `((top . ,adjusted-top))
+ nil))))
+ (modify-frame-parameters frame-initial-frame newparms)
+ (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
+ ;; .emacs file, will be applied to the existing screen.
+ (if (not (eq (cdr (or (assq 'minibuffer initial-frame-alist)
+ (assq 'minibuffer default-frame-alist)
+ '(minibuffer . t)))
+ t))
+ ;; Create the new frame.
+ (let (parms new)
+ ;; 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)))
+
+ (setq parms (append initial-frame-alist
+ default-frame-alist
+ parms
+ nil))
+
+ ;; Get rid of `reverse', because that was handled
+ ;; when we first made the frame.
+ (setq parms (cons '(reverse) (delq (assq 'reverse parms) parms)))
+