-;;; frame.el --- multi-frame management independent of window systems.
+;;; frame.el --- multi-frame management independent of window systems
-;; Copyright (C) 1993, 1994, 1996, 1997, 2000 Free Software Foundation, Inc.
+;; Copyright (C) 1993, 1994, 1996, 1997, 2000, 2001, 2002, 2003,
+;; 2004, 2005, 2006 Free Software Foundation, Inc.
;; Maintainer: FSF
;; Keywords: internal
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
+
+;;; Commentary:
;;; Code:
The window system startup file should set this to its frame creation
function, which should take an alist of parameters as its argument.")
-;;; The initial value given here for used to ask for a minibuffer.
-;;; But that's not necessary, because the default is to have one.
-;;; By not specifying it here, we let an X resource specify it.
+;; The initial value given here used to ask for a minibuffer.
+;; But that's not necessary, because the default is to have one.
+;; By not specifying it here, we let an X resource specify it.
(defcustom initial-frame-alist nil
"*Alist of frame parameters for creating the initial X window frame.
You can set this in your `.emacs' file; for example,
:group 'frames)
(setq pop-up-frame-function
- (function (lambda ()
- (make-frame pop-up-frame-alist))))
+ ;; Using `function' here caused some sort of problem.
+ '(lambda ()
+ (make-frame pop-up-frame-alist)))
(defcustom special-display-frame-alist
'((height . 14) (width . 80) (unsplittable . t))
Pass it BUFFER as first arg, and (cdr ARGS) gives the rest of the args."
(if (and args (symbolp (car args)))
(apply (car args) buffer (cdr args))
- (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 (append args 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))))))
+ (let ((window (get-buffer-window buffer 0)))
+ (or
+ ;; If we have a window already, make it visible.
+ (when window
+ (let ((frame (window-frame window)))
+ (make-frame-visible frame)
+ (raise-frame frame)
+ window))
+ ;; Reuse the current window if the user requested it.
+ (when (cdr (assq 'same-window args))
+ (condition-case nil
+ (progn (switch-to-buffer buffer) (selected-window))
+ (error nil)))
+ ;; Stay on the same frame if requested.
+ (when (or (cdr (assq 'same-frame args)) (cdr (assq 'same-window args)))
+ (let* ((pop-up-frames nil) (pop-up-windows t)
+ special-display-regexps special-display-buffer-names
+ (window (display-buffer buffer)))
+ ;; Only do it if this is a new window:
+ ;; (set-window-dedicated-p window t)
+ window))
+ ;; If no window yet, make one in a new frame.
+ (let ((frame
+ (with-current-buffer buffer
+ (make-frame (append args 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))))))
(defun handle-delete-frame (event)
"Handle delete-frame events from the X server."
\f
;;;; Arrangement of frames at startup
-;;; 1) Load the window system startup file from the lisp library and read the
-;;; high-priority arguments (-q and the like). The window system startup
-;;; file should create any frames specified in the window system defaults.
-;;;
-;;; 2) If no frames have been opened, we open an initial text frame.
-;;;
-;;; 3) Once the init file is done, we apply any newly set parameters
-;;; in initial-frame-alist to the frame.
+;; 1) Load the window system startup file from the lisp library and read the
+;; high-priority arguments (-q and the like). The window system startup
+;; file should create any frames specified in the window system defaults.
+;;
+;; 2) If no frames have been opened, we open an initial text frame.
+;;
+;; 3) Once the init file is done, we apply any newly set parameters
+;; in initial-frame-alist to the frame.
;; These are now called explicitly at the proper times,
;; since that is easier to understand.
;; (add-hook 'before-init-hook 'frame-initialize)
;; (add-hook 'window-setup-hook 'frame-notice-user-settings)
-;;; If we create the initial frame, this is it.
+;; 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-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.
+;; 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.
(defun frame-initialize ()
- "Create an in initial frame if necessary."
+ "Create an initial frame if necessary."
;; Are we actually running under a window system at all?
(if (and window-system (not noninteractive) (not (eq window-system 'pc)))
(progn
(defvar frame-notice-user-settings t
"Non-nil means function `frame-notice-user-settings' wasn't run yet.")
-;;; 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.
+;; 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 `default-frame-alist', `initial-frame-alist' there."
;; Make menu-bar-mode and default-frame-alist consistent.
- (if (boundp 'menu-bar-mode)
- (let ((default (assq 'menu-bar-lines default-frame-alist)))
- (if default
- (setq menu-bar-mode (not (eq (cdr default) 0)))
- (setq default-frame-alist
- (cons (cons 'menu-bar-lines (if menu-bar-mode 1 0))
- default-frame-alist)))))
+ (when (boundp 'menu-bar-mode)
+ (let ((default (assq 'menu-bar-lines default-frame-alist)))
+ (if default
+ (setq menu-bar-mode (not (eq (cdr default) 0)))
+ (setq default-frame-alist
+ (cons (cons 'menu-bar-lines (if menu-bar-mode 1 0))
+ default-frame-alist)))))
+
+ ;; Make tool-bar-mode and default-frame-alist consistent. Don't do
+ ;; it in batch mode since that would leave a tool-bar-lines
+ ;; parameter in default-frame-alist in a dumped Emacs, which is not
+ ;; what we want.
+ (when (and (boundp 'tool-bar-mode)
+ (not noninteractive))
+ (let ((default (assq 'tool-bar-lines default-frame-alist)))
+ (if default
+ (setq tool-bar-mode (not (eq (cdr default) 0)))
+ (setq default-frame-alist
+ (cons (cons 'tool-bar-lines (if tool-bar-mode 1 0))
+ default-frame-alist)))))
;; Creating and deleting frames may shift the selected frame around,
;; and thus the current buffer. Protect against that. We don't
(when (and frame-notice-user-settings
(null frame-initial-frame))
- ;; This case happens when we don't have a window system.
+ ;; This case happens when we don't have a window system, and
+ ;; also for MS-DOS frames.
(let ((parms (frame-parameters frame-initial-frame)))
;; 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
- (append initial-frame-alist
- default-frame-alist
- parms
- nil))))
+ (if (null window-system)
+ (append initial-frame-alist
+ default-frame-alist
+ parms
+ nil)
+ ;; initial-frame-alist and
+ ;; default-frame-alist were already
+ ;; applied in pc-win.el.
+ parms))
+ (if (null window-system) ;; MS-DOS does this differently in pc-win.el
+ (let ((newparms (frame-parameters))
+ (frame (selected-frame)))
+ (tty-handle-reverse-video frame newparms)
+ ;; 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))))))
;; If the initial frame is still around, apply initial-frame-alist
;; and default-frame-alist to it.
- (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 (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))
- (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)))
+
(if (assq 'height frame-initial-geometry-arguments)
- (setq allparms (assq-delete-all 'height allparms)))
+ (setq parms (assq-delete-all 'height parms)))
(if (assq 'width frame-initial-geometry-arguments)
- (setq allparms (assq-delete-all 'width allparms)))
+ (setq parms (assq-delete-all 'width parms)))
(if (assq 'left frame-initial-geometry-arguments)
- (setq allparms (assq-delete-all 'left allparms)))
+ (setq parms (assq-delete-all 'left parms)))
(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.
- (while tail
- (let (newval oldval)
- (setq oldval (assq (car (car tail))
- frame-initial-frame-alist))
- (setq newval (cdr (assq (car (car tail)) allparms)))
- (or (and oldval (eq (cdr oldval) newval))
- (setq newparms
- (cons (cons (car (car tail)) newval) newparms))))
- (setq tail (cdr tail)))
- (setq newparms (nreverse newparms))
- (modify-frame-parameters frame-initial-frame
- newparms)
- ;; 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 (assq 'background-mode newparms)
- (frame-set-background-mode frame-initial-frame))
- (face-set-after-frame-default frame-initial-frame))
- (if (assq 'font newparms)
- (frame-update-faces frame-initial-frame)))))
+ (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))
+ (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 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.
+ (while tail
+ (let (newval oldval)
+ (setq oldval (assq (car (car tail))
+ frame-initial-frame-alist))
+ (setq newval (cdr (assq (car (car tail)) allparms)))
+ (or (and oldval (eq (cdr oldval) newval))
+ (setq newparms
+ (cons (cons (car (car tail)) newval) newparms))))
+ (setq tail (cdr tail)))
+ (setq newparms (nreverse newparms))
+ (modify-frame-parameters frame-initial-frame
+ newparms)
+ ;; 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 (assq 'background-mode newparms)
+ (frame-set-background-mode frame-initial-frame))
+ (face-set-after-frame-default frame-initial-frame)))))
;; Restore the original buffer.
(set-buffer old-buffer)
;;;; Creation of additional frames, and other frame miscellanea
+(defun modify-all-frames-parameters (alist)
+ "Modify all current and future frames' parameters according to ALIST.
+This changes `default-frame-alist' and possibly `initial-frame-alist'.
+See help of `modify-frame-parameters' for more information."
+ (let (element) ;; temp
+ (dolist (frame (frame-list))
+ (modify-frame-parameters frame alist))
+
+ (dolist (pair alist) ;; conses to add/replace
+ ;; initial-frame-alist needs setting only when
+ ;; frame-notice-user-settings is true
+ (and frame-notice-user-settings
+ (setq element (assoc (car pair) initial-frame-alist))
+ (setq initial-frame-alist (delq element initial-frame-alist)))
+ (and (setq element (assoc (car pair) default-frame-alist))
+ (setq default-frame-alist (delq element default-frame-alist)))))
+ (and frame-notice-user-settings
+ (setq initial-frame-alist (append initial-frame-alist alist)))
+ (setq default-frame-alist (append default-frame-alist alist)))
+
(defun get-other-frame ()
"Return some frame other than the current frame.
Create one if necessary. Note that the minibuffer frame, if separate,
(interactive)
(select-window (next-window (selected-window)
(> (minibuffer-depth) 0)
- t)))
+ 0))
+ (select-frame-set-input-focus (selected-frame)))
(defun previous-multiframe-window ()
"Select the previous window, regardless of which frame it is on."
(interactive)
(select-window (previous-window (selected-window)
(> (minibuffer-depth) 0)
- t)))
+ 0))
+ (select-frame-set-input-focus (selected-frame)))
(defun make-frame-on-display (display &optional parameters)
"Make a frame on display DISPLAY.
"Functions to run after a frame is created.
The functions are run with one arg, the newly created frame.")
-(defvar after-setting-font-hooks nil
+(defvar after-setting-font-hook nil
"Functions to run after a frame's font has been changed.")
;; Alias, kept temporarily.
-(defalias 'new-frame 'make-frame)
+(define-obsolete-function-alias 'new-frame 'make-frame "22.1")
(defun make-frame (&optional parameters)
"Return a newly created frame displaying the current buffer.
Before the frame is created (via `frame-creation-function'), functions on the
hook `before-make-frame-hook' are run. After the frame is created, functions
-on `after-make-frame-functions' are run with one arg, the newly created frame."
+on `after-make-frame-functions' are run with one arg, the newly created frame.
+
+This function itself does not make the new frame the selected frame.
+The previously selected frame remains selected. However, the
+window system may select the new frame for its own reasons, for
+instance if the frame appears under the mouse pointer and your
+setup is for focus to follow the pointer."
(interactive)
(run-hooks 'before-make-frame-hook)
(let ((frame (funcall frame-creation-function parameters)))
(defun filtered-frame-list (predicate)
"Return a list of all live frames which satisfy PREDICATE."
- (let ((frames (frame-list))
- good-frames)
+ (let* ((frames (frame-list))
+ (list frames))
(while (consp frames)
- (if (funcall predicate (car frames))
- (setq good-frames (cons (car frames) good-frames)))
+ (unless (funcall predicate (car frames))
+ (setcar frames nil))
(setq frames (cdr frames)))
- good-frames))
+ (delq nil list)))
(defun minibuffer-frame-list ()
"Return a list of all frames with their own minibuffers."
"Return a list of all frames on DISPLAY.
DISPLAY is a name of a display, a string of the form HOST:SERVER.SCREEN.
If DISPLAY is omitted or nil, it defaults to the selected frame's display."
- (let* ((display (or display
- (cdr (assoc 'display (frame-parameters)))))
- (func
- (function (lambda (frame)
- (eq (cdr (assoc 'display (frame-parameters frame)))
- display)))))
+ (let* ((display (or display (frame-parameter nil 'display)))
+ (func #'(lambda (frame)
+ (equal (frame-parameter frame 'display) display))))
(filtered-frame-list func)))
(defun framep-on-display (&optional display)
(nreverse frame-initial-geometry-arguments))
(cdr param-list))
-
(defcustom focus-follows-mouse t
- "*Non-nil if window system changes focus when you move the mouse."
+ "*Non-nil if window system changes focus when you move the mouse.
+You should set this variable to tell Emacs how your window manager
+handles focus, since there is no way in general for Emacs to find out
+automatically."
:type 'boolean
:group 'frames
:version "20.3")
+(defun select-frame-set-input-focus (frame)
+ "Select FRAME, raise it, and set input focus, if possible."
+ (select-frame frame)
+ (raise-frame frame)
+ ;; Ensure, if possible, that frame gets input focus.
+ (cond ((memq window-system '(x mac))
+ (x-focus-frame frame))
+ ((eq window-system 'w32)
+ (w32-focus-frame frame)))
+ (cond (focus-follows-mouse
+ (set-mouse-position (selected-frame) (1- (frame-width)) 0))))
+
(defun other-frame (arg)
- "Select the ARG'th different visible frame, and raise it.
+ "Select the ARG'th different visible frame on current display, 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."
+A negative ARG moves in the opposite order.
+
+To make this command work properly, you must tell Emacs
+how the system (or the window manager) generally handles
+focus-switching between windows. If moving the mouse onto a window
+selects it (gives it focus), set `focus-follows-mouse' to t.
+Otherwise, that variable should be nil."
(interactive "p")
(let ((frame (selected-frame)))
(while (> arg 0)
(while (not (eq (frame-visible-p frame) t))
(setq frame (previous-frame frame)))
(setq arg (1+ arg)))
- (raise-frame frame)
- (select-frame frame)
- ;; Ensure, if possible, that frame gets input focus.
- (if (eq window-system 'w32)
- (w32-focus-frame frame)
- (when focus-follows-mouse
- (set-mouse-position (selected-frame) (1- (frame-width)) 0)))))
+ (select-frame-set-input-focus frame)))
+
+(defun iconify-or-deiconify-frame ()
+ "Iconify the selected frame, or deiconify if it's currently an icon."
+ (interactive)
+ (if (eq (cdr (assq 'visibility (frame-parameters))) t)
+ (iconify-frame)
+ (make-frame-visible)))
(defun make-frame-names-alist ()
(let* ((current-frame (selected-frame))
(defvar frame-name-history nil)
(defun select-frame-by-name (name)
- "Select the frame whose name is NAME and raise it.
+ "Select the frame on the current terminal whose name is NAME and raise it.
If there is no frame by that name, signal an error."
(interactive
(let* ((frame-names-alist (make-frame-names-alist))
(raise-frame frame)
(select-frame frame)
;; Ensure, if possible, that frame gets input focus.
- (if (eq window-system 'w32)
- (w32-focus-frame frame)
- (when focus-follows-mouse
- (set-mouse-position (selected-frame) (1- (frame-width)) 0)))))
+ (cond ((memq window-system '(x mac))
+ (x-focus-frame frame))
+ ((eq window-system 'w32)
+ (w32-focus-frame frame)))
+ (when focus-follows-mouse
+ (set-mouse-position frame (1- (frame-width frame)) 0))))
\f
;;;; Frame configurations
"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.
+However, this function does not restore deleted frames.
+
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."
;;;; Convenience functions for accessing and interactively changing
;;;; frame parameters.
-(defun frame-parameter (frame parameter)
- "Return FRAME's value for parameter PARAMETER.
-If FRAME is nil, describe the currently selected frame."
- (cdr (assq parameter (frame-parameters frame))))
-
(defun frame-height (&optional frame)
"Return number of lines available for display on FRAME.
If FRAME is omitted, describe the currently selected frame."
(cdr (assq 'width (frame-parameters frame))))
(defalias 'set-default-font 'set-frame-font)
-(defun set-frame-font (font-name)
+(defun set-frame-font (font-name &optional keep-size)
"Set the font of the selected frame to FONT-NAME.
When called interactively, prompt for the name of the font to use.
-To get the frame's current default font, use `frame-parameters'."
- (interactive "sFont name: ")
- (modify-frame-parameters (selected-frame)
- (list (cons 'font font-name)))
- ;; Update faces that want a bold or italic version of the default font.
- (frame-update-faces (selected-frame))
- (run-hooks 'after-setting-font-hooks))
+To get the frame's current default font, use `frame-parameters'.
+
+The default behavior is to keep the numbers of lines and columns in
+the frame, thus may change its pixel size. If optional KEEP-SIZE is
+non-nil (interactively, prefix argument) the current frame size (in
+pixels) is kept by adjusting the numbers of the lines and columns."
+ (interactive
+ (let* ((completion-ignore-case t)
+ (font (completing-read "Font name: "
+ (mapcar #'list
+ ;; x-list-fonts will fail with an error
+ ;; if this frame doesn't support fonts.
+ (x-list-fonts "*" nil (selected-frame)))
+ nil nil nil nil
+ (frame-parameter nil 'font))))
+ (list font current-prefix-arg)))
+ (let (fht fwd)
+ (if keep-size
+ (setq fht (* (frame-parameter nil 'height) (frame-char-height))
+ fwd (* (frame-parameter nil 'width) (frame-char-width))))
+ (modify-frame-parameters (selected-frame)
+ (list (cons 'font font-name)))
+ (if keep-size
+ (modify-frame-parameters
+ (selected-frame)
+ (list (cons 'height (round fht (frame-char-height)))
+ (cons 'width (round fwd (frame-char-width)))))))
+ (run-hooks 'after-setting-font-hook 'after-setting-font-hooks))
+
+(defun set-frame-parameter (frame parameter value)
+ "Set frame parameter PARAMETER to VALUE on FRAME.
+If FRAME is nil, it defaults to the selected frame.
+See `modify-frame-parameters.'"
+ (modify-frame-parameters frame (list (cons parameter value))))
(defun set-background-color (color-name)
"Set the background color of the selected frame to COLOR-NAME.
When called interactively, prompt for the name of the color to use.
To get the frame's current background color, use `frame-parameters'."
- (interactive (list (facemenu-read-color)))
+ (interactive (list (facemenu-read-color "Background color: ")))
(modify-frame-parameters (selected-frame)
(list (cons 'background-color color-name)))
- (frame-update-face-colors (selected-frame)))
+ (or window-system
+ (face-set-after-frame-default (selected-frame))))
(defun set-foreground-color (color-name)
"Set the foreground color of the selected frame to COLOR-NAME.
When called interactively, prompt for the name of the color to use.
To get the frame's current foreground color, use `frame-parameters'."
- (interactive (list (facemenu-read-color)))
+ (interactive (list (facemenu-read-color "Foreground color: ")))
(modify-frame-parameters (selected-frame)
(list (cons 'foreground-color color-name)))
- (frame-update-face-colors (selected-frame)))
+ (or window-system
+ (face-set-after-frame-default (selected-frame))))
(defun set-cursor-color (color-name)
"Set the text cursor color of the selected frame to COLOR-NAME.
When called interactively, prompt for the name of the color to use.
To get the frame's current cursor color, use `frame-parameters'."
- (interactive (list (facemenu-read-color)))
+ (interactive (list (facemenu-read-color "Cursor color: ")))
(modify-frame-parameters (selected-frame)
(list (cons 'cursor-color color-name))))
"Set the color of the mouse pointer of the selected frame to COLOR-NAME.
When called interactively, prompt for the name of the color to use.
To get the frame's current mouse color, use `frame-parameters'."
- (interactive (list (facemenu-read-color)))
+ (interactive (list (facemenu-read-color "Mouse color: ")))
(modify-frame-parameters (selected-frame)
(list (cons 'mouse-color
(or color-name
"Set the color of the border of the selected frame to COLOR-NAME.
When called interactively, prompt for the name of the color to use.
To get the frame's current border color, use `frame-parameters'."
- (interactive (list (facemenu-read-color)))
+ (interactive (list (facemenu-read-color "Border color: ")))
(modify-frame-parameters (selected-frame)
(list (cons 'border-color color-name))))
(interactive "sFrame name: ")
(modify-frame-parameters (selected-frame)
(list (cons 'name name))))
+
+(defun frame-current-scroll-bars (&optional frame)
+ "Return the current scroll-bar settings in frame FRAME.
+Value is a cons (VERTICAL . HORIZ0NTAL) where VERTICAL specifies the
+current location of the vertical scroll-bars (left, right, or nil),
+and HORIZONTAL specifies the current location of the horizontal scroll
+bars (top, bottom, or nil)."
+ (let ((vert (frame-parameter frame 'vertical-scroll-bars))
+ (hor nil))
+ (unless (memq vert '(left right nil))
+ (setq vert default-frame-scroll-bars))
+ (cons vert hor)))
\f
;;;; Frame/display capabilities.
(defun display-mouse-p (&optional display)
((eq frame-type 'pc)
(msdos-mouse-p))
((eq system-type 'windows-nt)
- (> w32-num-mouse-buttons 0))
+ (with-no-warnings
+ (> w32-num-mouse-buttons 0)))
((memq frame-type '(x mac))
t) ;; We assume X and Mac *always* have a pointing device
(t
frame's display)."
(not (null (memq (framep-on-display display) '(x w32 mac)))))
+(defun display-images-p (&optional display)
+ "Return non-nil if DISPLAY can display images.
+
+DISPLAY can be a display name, a frame, or nil (meaning the selected
+frame's display)."
+ (and (display-graphic-p display)
+ (fboundp 'image-mask-p)
+ (fboundp 'image-size)))
+
+(defalias 'display-multi-frame-p 'display-graphic-p)
+(defalias 'display-multi-font-p 'display-graphic-p)
+
(defun display-selections-p (&optional display)
"Return non-nil if DISPLAY supports selections.
A selection is a way to transfer text or other data between programs
((eq frame-type 'pc)
;; MS-DOG frames support selections when Emacs runs inside
;; the Windows' DOS Box.
- (not (null dos-windows-version)))
+ (with-no-warnings
+ (not (null dos-windows-version))))
((memq frame-type '(x w32 mac))
t) ;; FIXME?
(t
"Return the number of screens associated with DISPLAY."
(let ((frame-type (framep-on-display display)))
(cond
- ((memq frame-type '(x w32))
+ ((memq frame-type '(x w32 mac))
(x-display-screens display))
- (t ;; FIXME: is this correct for the Mac?
+ (t
1))))
(defun display-pixel-height (&optional display)
((eq frame-type 'pc)
16)
(t
- (length (tty-color-alist))))))
+ (tty-display-color-cells)))))
(defun display-visual-class (&optional display)
"Returns the visual class of DISPLAY.
\f
;;;; Aliases for backward compatibility with Emacs 18.
-(defalias 'screen-height 'frame-height)
-(defalias 'screen-width 'frame-width)
+(define-obsolete-function-alias 'screen-height 'frame-height) ;before 19.15
+(define-obsolete-function-alias 'screen-width 'frame-width) ;before 19.15
(defun set-screen-width (cols &optional pretend)
- "Obsolete function to change the size of the screen to COLS columns.
+ "Change the size of the screen to COLS columns.
Optional second arg non-nil means that redisplay should use COLS columns
but that the idea of the actual width of the frame should not be changed.
-This function is provided only for compatibility with Emacs 18; new code
-should use `set-frame-width instead'."
+This function is provided only for compatibility with Emacs 18."
(set-frame-width (selected-frame) cols pretend))
(defun set-screen-height (lines &optional pretend)
- "Obsolete function to change the height of the screen to LINES lines.
+ "Change the height of the screen to LINES lines.
Optional second arg non-nil means that redisplay should use LINES lines
but that the idea of the actual height of the screen should not be changed.
-This function is provided only for compatibility with Emacs 18; new code
-should use `set-frame-height' instead."
+This function is provided only for compatibility with Emacs 18."
(set-frame-height (selected-frame) lines pretend))
(defun delete-other-frames (&optional frame)
"Delete all frames except FRAME.
-FRAME nil or omitted means delete all frames except the selected frame."
+If FRAME uses another frame's minibuffer, the minibuffer frame is
+left untouched. FRAME nil or omitted means use the selected frame."
(interactive)
(unless frame
(setq frame (selected-frame)))
- (mapcar 'delete-frame (delq frame (frame-list))))
-
-
-(make-obsolete 'screen-height 'frame-height)
-(make-obsolete 'screen-width 'frame-width)
-(make-obsolete 'set-screen-width 'set-frame-width)
-(make-obsolete 'set-screen-height 'set-frame-height)
+ (let* ((mini-frame (window-frame (minibuffer-window frame)))
+ (frames (delq mini-frame (delq frame (frame-list)))))
+ ;; Delete mon-minibuffer-only frames first, because `delete-frame'
+ ;; signals an error when trying to delete a mini-frame that's
+ ;; still in use by another frame.
+ (dolist (frame frames)
+ (unless (eq (frame-parameter frame 'minibuffer) 'only)
+ (delete-frame frame)))
+ ;; Delete minibuffer-only frames.
+ (dolist (frame frames)
+ (when (eq (frame-parameter frame 'minibuffer) 'only)
+ (delete-frame frame)))))
+
+(make-obsolete 'set-screen-width 'set-frame-width) ;before 19.15
+(make-obsolete 'set-screen-height 'set-frame-height) ;before 19.15
+
+;; miscellaneous obsolescence declarations
+(define-obsolete-variable-alias 'delete-frame-hook
+ 'delete-frame-functions "22.1")
\f
-;;; Highlighting trailing whitespace.
+;; Highlighting trailing whitespace.
(make-variable-buffer-local 'show-trailing-whitespace)
(defcustom show-trailing-whitespace nil
- "*Non-nil means highlight trailing whitespace in face `trailing-whitespace'."
- :tag "Highlight trailing whitespace."
- :set #'(lambda (symbol value) (set-default symbol value))
+ "*Non-nil means highlight trailing whitespace.
+This is done in the face `trailing-whitespace'."
:type 'boolean
- :group 'font-lock)
+ :group 'whitespace-faces)
+
+
+\f
+;; Scrolling
+
+(defgroup scrolling nil
+ "Scrolling windows."
+ :version "21.1"
+ :group 'frames)
+(defcustom auto-hscroll-mode t
+ "*Allow or disallow automatic scrolling windows horizontally.
+If non-nil, windows are automatically scrolled horizontally to make
+point visible."
+ :version "21.1"
+ :type 'boolean
+ :group 'scrolling)
+(defvaralias 'automatic-hscrolling 'auto-hscroll-mode)
\f
-;;; Blinking cursor
+;; Blinking cursor
(defgroup cursor nil
"Displaying text cursors."
(defcustom blink-cursor-delay 0.5
"*Seconds of idle time after which cursor starts to blink."
- :tag "Delay in seconds."
:type 'number
:group 'cursor)
(defcustom blink-cursor-interval 0.5
"*Length of cursor blink interval in seconds."
- :tag "Blink interval in seconds."
:type 'number
:group 'cursor)
(defvar blink-cursor-timer nil
"Timer started from `blink-cursor-start'.
-This timer calls `blink-cursor' every `blink-cursor-interval' seconds.")
+This timer calls `blink-cursor-timer-function' every
+`blink-cursor-interval' seconds.")
-(defvar blink-cursor-mode nil
- "Non-nil means blinking cursor is active.")
-
-(defun blink-cursor-mode (arg)
+(define-minor-mode blink-cursor-mode
"Toggle blinking cursor mode.
-With arg, turn blinking cursor mode on iff arg is positive.
+With a numeric argument, turn blinking cursor mode on iff ARG is positive.
When blinking cursor mode is enabled, the cursor of the selected
-window blinks."
- (interactive "P")
- (let ((on-p (if (null arg)
- (not blink-cursor-mode)
- (> (prefix-numeric-value arg) 0))))
- (if blink-cursor-idle-timer
- (cancel-timer blink-cursor-idle-timer))
- (if blink-cursor-timer
- (cancel-timer blink-cursor-timer))
- (setq blink-cursor-idle-timer nil
- blink-cursor-timer nil
- blink-cursor-mode nil)
- (if on-p
- (progn
- ;; Hide the cursor.
- (internal-show-cursor nil nil)
- (setq blink-cursor-idle-timer
- (run-with-idle-timer blink-cursor-delay
- blink-cursor-delay
- 'blink-cursor-start))
- (setq blink-cursor-mode t))
- (internal-show-cursor nil t))))
-
-(defcustom blink-cursor (not (eq system-type 'ms-dos))
- "*Non-nil means blinking cursor mode is active."
- :tag "Blinking cursor"
- :type 'boolean
+window blinks.
+
+Note that this command is effective only when Emacs
+displays through a window system, because then Emacs does its own
+cursor display. On a text-only terminal, this is not implemented."
+ :init-value (not (or noninteractive
+ no-blinking-cursor
+ (eq system-type 'ms-dos)
+ (not (memq window-system '(x w32 mac)))))
+ :initialize 'custom-initialize-safe-default
:group 'cursor
- :set #'(lambda (symbol value)
- (set-default symbol value)
- (blink-cursor-mode (or value 0))))
+ :global t
+ (if blink-cursor-idle-timer (cancel-timer blink-cursor-idle-timer))
+ (if blink-cursor-timer (cancel-timer blink-cursor-timer))
+ (setq blink-cursor-idle-timer nil
+ blink-cursor-timer nil)
+ (if blink-cursor-mode
+ (progn
+ ;; Hide the cursor.
+ ;;(internal-show-cursor nil nil)
+ (setq blink-cursor-idle-timer
+ (run-with-idle-timer blink-cursor-delay
+ blink-cursor-delay
+ 'blink-cursor-start)))
+ (internal-show-cursor nil t)))
+
+(define-obsolete-variable-alias 'blink-cursor 'blink-cursor-mode "22.1")
(defun blink-cursor-start ()
"Timer function called from the timer `blink-cursor-idle-timer'.
command starts, by installing a pre-command hook."
(when (null blink-cursor-timer)
(add-hook 'pre-command-hook 'blink-cursor-end)
+ (internal-show-cursor nil nil)
(setq blink-cursor-timer
(run-with-timer blink-cursor-interval blink-cursor-interval
'blink-cursor-timer-function))))
(defun blink-cursor-end ()
"Stop cursor blinking.
This is installed as a pre-command hook by `blink-cursor-start'.
-When run, it cancels the timer `blink-cursor-timer' and removes
+When run, it cancels the timer `blink-cursor-timer' and removes
itself as a pre-command hook."
(remove-hook 'pre-command-hook 'blink-cursor-end)
(internal-show-cursor nil t)
\f
-;;; Busy-cursor.
+;; Hourglass pointer
-(defcustom busy-cursor t
- "*Non-nil means show a busy-cursor when running under a window system."
- :tag "Busy-cursor"
+(defcustom display-hourglass t
+ "*Non-nil means show an hourglass pointer, when Emacs is busy.
+This feature only works when on a window system that can change
+cursor shapes."
:type 'boolean
- :group 'cursor
- :get #'(lambda (symbol) display-busy-cursor)
- :set #'(lambda (symbol value)
- (set-default symbol value)
- (setq display-busy-cursor value)))
+ :group 'cursor)
-(defcustom busy-cursor-delay-seconds 1
- "*Seconds to wait before displaying a busy-cursor."
- :tag "Busy-cursor delay"
+(defcustom hourglass-delay 1
+ "*Seconds to wait before displaying an hourglass pointer when Emacs is busy."
:type 'number
- :group 'cursor
- :get #'(lambda (symbol) busy-cursor-delay)
- :set #'(lambda (symbol value)
- (set-default symbol value)
- (setq busy-cursor-delay value)))
+ :group 'cursor)
\f
-(defcustom show-cursor-in-non-selected-windows t
- "*Non-nil means show a hollow box cursor in non-selected-windows.
-If nil, don't show a cursor except in the selected window."
- :tag "Cursor in non-selected windows"
+(defcustom cursor-in-non-selected-windows t
+ "*Non-nil means show a hollow box cursor in non-selected windows.
+If nil, don't show a cursor except in the selected window.
+Use Custom to set this variable to get the display updated."
+ :tag "Cursor In Non-selected Windows"
:type 'boolean
:group 'cursor
- :get #'(lambda (symbol) cursor-in-non-selected-windows)
:set #'(lambda (symbol value)
(set-default symbol value)
- (setq cursor-in-non-selected-windows value)
(force-mode-line-update t)))
-
+
\f
;;;; Key bindings
(provide 'frame)
+;; arch-tag: 82979c70-b8f2-4306-b2ad-ddbd6b328b56
;;; frame.el ends here
-(frame-notice-user-settings):