;;; frame.el --- multi-frame management independent of window systems.
-;;;; Copyright (C) 1993 Free Software Foundation, Inc.
+;;;; Copyright (C) 1993, 1994 Free Software Foundation, Inc.
;; Maintainer: FSF
;; Keywords: internal
Pop-up frames are used for completions, help, and the like.
This variable can be set in your init file, like this:
(setq pop-up-frame-alist '((width . 80) (height . 20)))
-These supercede the values given in `default-frame-alist'.")
+These supersede the values given in `default-frame-alist'.")
(setq pop-up-frame-function
(function (lambda ()
- (new-frame pop-up-frame-alist))))
-
+ (make-frame pop-up-frame-alist))))
+
+(defvar special-display-frame-alist
+ '((height . 14) (width . 80) (unsplittable . t))
+ "*Alist of frame parameters used when creating special frames.
+Special frames are used for buffers whose names are in
+`special-display-buffer-names' and for buffers whose names match
+one of the regular expressions in `special-display-regexps'.
+This variable can be set in your init file, like this:
+ (setq special-display-frame-alist '((width . 80) (height . 20)))
+These supersede the values given in `default-frame-alist'.")
+
+;; Display BUFFER in its own frame, reusing an existing window if any.
+;; Return the window chosen.
+;; Currently we do not insist on selecting the window within its frame.
+(defun special-display-popup-frame (buffer)
+ (let ((window (get-buffer-window buffer t)))
+ (if window
+ ;; If we have a window already, make it visible.
+ (let ((frame (window-frame window)))
+ (make-frame-visible frame)
+ (raise-frame frame)
+ window)
+ ;; If no window yet, make one in a new frame.
+ (let ((frame (make-frame special-display-frame-alist)))
+ (set-window-buffer (frame-selected-window frame) buffer)
+ (set-window-dedicated-p (frame-selected-window frame) t)
+ (frame-selected-window frame)))))
+
+(setq special-display-function 'special-display-popup-frame)
\f
;;;; Arrangement of frames at startup
;;; If we create the initial frame, this is it.
(defvar frame-initial-frame nil)
+;; Record the parameters used in frame-initialize to make the initial frame.
+(defvar frame-initial-frame-alist)
+
+(defvar frame-initial-geometry-arguments nil)
+
;;; startup.el calls this function before loading the user's init
;;; file - if there is no frame with a minibuffer open now, create
;;; one to display messages while loading the init file.
;; minibuffer spec.
(or (delq terminal-frame (minibuffer-frame-list))
(progn
+ (setq frame-initial-frame-alist
+ (append initial-frame-alist default-frame-alist))
(setq default-minibuffer-frame
(setq frame-initial-frame
- (new-frame initial-frame-alist)))
- ;; Handle `reverse' as a parameter.
- (if (cdr (or (assq 'reverse initial-frame-alist)
- (assq 'reverse default-frame-alist)))
- (let ((params (frame-parameters frame-initial-frame)))
- (modify-frame-parameters
- frame-initial-frame
- (list (cons 'foreground-color (cdr (assq 'background-color params)))
- (cons 'background-color (cdr (assq 'foreground-color params)))
- (cons 'mouse-color (cdr (assq 'background-color params)))
- (cons 'cursor-color (cdr (assq 'background-color params)))
- (cons 'border-color (cdr (assq 'background-color params)))))))))
-
+ (make-frame initial-frame-alist)))
+ ;; Delete any specifications for window geometry parameters
+ ;; so that we won't reapply them in frame-notice-user-settings.
+ ;; It would be wrong to reapply them then,
+ ;; because that would override explicit user resizing.
+ (setq initial-frame-alist
+ (frame-remove-geometry-params initial-frame-alist))))
;; At this point, we know that we have a frame open, so we
;; can delete the terminal frame.
(delete-frame terminal-frame)
'(minibuffer . t)))
t))
;; Create the new frame.
- (let ((new
- (new-frame
- (append initial-frame-alist
- default-frame-alist
- (frame-parameters frame-initial-frame)))))
-
+ (let* ((parms (append initial-frame-alist
+ default-frame-alist
+ (frame-parameters frame-initial-frame)
+ nil))
+ ;; Get rid of `reverse', because that was handled
+ ;; when we first made the frame.
+ (new (make-frame
+ ;; Use the geometry args that created the existing
+ ;; frame, rather than the parms we get for it.q
+ (append frame-initial-geometry-arguments
+ (let (frame-initial-geometry-arguments)
+ (frame-remove-geometry-params
+ (cons '(reverse . nil)
+ (delq (assq 'reverse parms)
+ 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))
- (new-frame (append minibuffer-frame-alist
+ (make-frame (append minibuffer-frame-alist
'((minibuffer . only)))))
;; If the initial frame is serving as a surrogate
(redirect-frame-focus frame-initial-frame new)
;; Finally, get rid of the old frame.
- (delete-frame frame-initial-frame))
+ (delete-frame frame-initial-frame t))
;; Otherwise, we don't need all that rigamarole; just apply
;; the new parameters.
- (modify-frame-parameters frame-initial-frame
- (append initial-frame-alist
- default-frame-alist))))
+ (let (newparms allparms tail)
+ (setq allparms (append initial-frame-alist
+ default-frame-alist))
+ (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.
+ (while tail
+ (let (newval oldval)
+ (setq oldval (cdr (assq (car (car tail))
+ frame-initial-frame-alist)))
+ (setq newval (cdr (assq (car (car tail)) allparms)))
+ (or (eq oldval newval)
+ (setq newparms
+ (cons (cons (car (car tail)) newval) newparms))))
+ (setq tail (cdr tail)))
+ (modify-frame-parameters frame-initial-frame
+ (nreverse newparms)))))
;; Restore the original buffer.
(set-buffer old-buffer)
;;;; Creation of additional frames, and other frame miscellanea
;;; Return some frame other than the current frame, creating one if
-;;; neccessary. Note that the minibuffer frame, if separate, is not
+;;; necessary. Note that the minibuffer frame, if separate, is not
;;; considered (see next-frame).
(defun get-other-frame ()
(let ((s (if (equal (next-frame (selected-frame)) (selected-frame))
- (new-frame)
+ (make-frame)
(next-frame (selected-frame)))))
s))
The documentation for the function `x-create-frame' describes
additional frame parameters that Emacs recognizes for X window frames."
(interactive)
- (funcall frame-creation-function parameters))
+ (let ((nframe))
+ (run-hooks 'before-make-frame-hook)
+ (setq nframe (funcall frame-creation-function parameters))
+ (run-hooks 'after-make-frame-hook)
+ nframe))
(defun filtered-frame-list (predicate)
"Return a list of all live frames which satisfy PREDICATE."
(function (lambda (frame)
(eq frame (window-frame (minibuffer-window frame)))))))
+(defun frame-remove-geometry-params (param-list)
+ "Return the parameter list PARAM-LIST, but with geometry specs removed.
+This deletes all bindings in PARAM-LIST for `top', `left', `width',
+`height', `user-size' and `user-position' parameters.
+Emacs uses this to avoid overriding explicit moves and resizings from
+the user during startup."
+ (setq param-list (cons nil param-list))
+ (let ((tail param-list))
+ (while (consp (cdr tail))
+ (if (and (consp (car (cdr tail)))
+ (memq (car (car (cdr tail)))
+ '(height width top left user-position user-size)))
+ (progn
+ (setq frame-initial-geometry-arguments
+ (cons (car (cdr tail)) frame-initial-geometry-arguments))
+ (setcdr tail (cdr (cdr tail))))
+ (setq tail (cdr tail)))))
+ (cdr param-list))
+
+
+(defun other-frame (arg)
+ "Select the ARG'th different visible frame, and raise it.
+All frames are arranged in a cyclic order.
+This command selects the frame ARG steps away in that order.
+A negative ARG moves in the opposite order."
+ (interactive "p")
+ (let ((frame (selected-frame)))
+ (while (> arg 0)
+ (setq frame (next-frame frame))
+ (while (not (eq (frame-visible-p frame) t))
+ (setq frame (next-frame frame)))
+ (setq arg (1- arg)))
+ (while (< arg 0)
+ (setq frame (previous-frame frame))
+ (while (not (eq (frame-visible-p frame) t))
+ (setq frame (previous-frame frame)))
+ (setq arg (1+ arg)))
+ (raise-frame frame)
+ (select-frame frame)
+ (set-mouse-position (selected-frame) (1- (frame-width)) 0)
+ (unfocus-frame)))
\f
;;;; Frame configurations
(current-window-configuration frame))))
(frame-list))))
-(defun set-frame-configuration (configuration)
+(defun set-frame-configuration (configuration &optional nodelete)
"Restore the frames to the state described by CONFIGURATION.
Each frame listed in CONFIGURATION has its position, size, window
-configuration, and other parameters set as specified in CONFIGURATION."
+configuration, and other parameters set as specified in CONFIGURATION.
+Ordinarily, this function deletes all existing frames not
+listed in CONFIGURATION. But if optional second argument NODELETE
+is given and non-nil, the unwanted frames are iconified instead."
(or (frame-configuration-p configuration)
(signal 'wrong-type-argument
(list 'frame-configuration-p configuration)))
(let ((parameters (assq frame config-alist)))
(if parameters
(progn
- (modify-frame-parameters frame (nth 1 parameters))
+ (modify-frame-parameters
+ frame
+ ;; Since we can't set a frame's minibuffer status,
+ ;; we might as well omit the parameter altogether.
+ (let* ((parms (nth 1 parameters))
+ (mini (assq 'minibuffer parms)))
+ (if mini (setq parms (delq mini parms)))
+ parms))
(set-window-configuration (nth 2 parameters)))
(setq frames-to-delete (cons frame frames-to-delete))))))
(frame-list))
- (mapcar 'delete-frame frames-to-delete)))
+ (if nodelete
+ ;; Note: making frames invisible here was tried
+ ;; but led to some strange behavior--each time the frame
+ ;; was made visible again, the window manager asked afresh
+ ;; for where to put it.
+ (mapcar 'iconify-frame frames-to-delete)
+ (mapcar 'delete-frame frames-to-delete))))
(defun frame-configuration-p (object)
"Return non-nil if OBJECT seems to be a frame configuration.
When called interactively, prompt for the name of the font to use."
(interactive "sFont name: ")
(modify-frame-parameters (selected-frame)
- (list (cons 'font font-name))))
+ (list (cons 'font font-name)))
+ ;; Update faces that want a bold or italic version of the default font.
+ (frame-update-faces (selected-frame)))
(defun set-background-color (color-name)
"Set the background color of the selected frame to COLOR.
(defalias 'ctl-x-5-prefix ctl-x-5-map)
(define-key ctl-x-map "5" 'ctl-x-5-prefix)
-(define-key ctl-x-5-map "2" 'new-frame)
+(define-key ctl-x-5-map "2" 'make-frame)
(define-key ctl-x-5-map "0" 'delete-frame)
+(define-key ctl-x-5-map "o" 'other-frame)
(provide 'frame)
HCoop / bpt / emacs.git / blobdiff