-;;; 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
+;; Free Software Foundation, Inc.
;; Maintainer: FSF
;; Keywords: internal
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
+;;; Commentary:
+
;;; Code:
(defvar frame-creation-function nil
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,
(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))))))
+ (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)))
+ ;; (set-window-dedicated-p window t)
+ 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))))))
(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 initial frame if necessary."
;; Are we actually running under a window system at all?
(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."
(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
(when (display-graphic-p)
(let ((tool-bar-lines (or (assq 'tool-bar-lines initial-frame-alist)
(assq 'tool-bar-lines default-frame-alist))))
- (when (or (null tool-bar-lines)
- (null (cdr tool-bar-lines))
- (eq 0 (cdr tool-bar-lines)))
+ (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 24)
+ (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))
(relief (if (and (integerp tool-bar-button-relief)
(> tool-bar-button-relief 0))
tool-bar-button-relief 3))
- (lines (/ (+ image-height
+ (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
+ (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)))
- (setq newparms
- (append newparms
+ (setq newparms
+ (append newparms
`((top . ,(+ top (* lines char-height))))
nil)))
(modify-frame-parameters frame-initial-frame newparms)
(sleep-for 1))
(setq parms (frame-parameters frame-initial-frame))
- ;; Get rid of `name' unless it was specified explicitly before.
+ ;; 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 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
+ ;; 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
+ ;; once the user has seen the frame and been able to alter it
;; manually.
(while tail
(let (newval oldval)
(interactive)
(select-window (next-window (selected-window)
(> (minibuffer-depth) 0)
- t)))
+ t))
+ (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)))
+ t))
+ (select-frame-set-input-focus (selected-frame)))
(defun make-frame-on-display (display &optional parameters)
"Make a frame on display DISPLAY.
If DISPLAY is omitted or nil, it defaults to the selected frame's display."
(let* ((display (or display (frame-parameter nil 'display)))
(func #'(lambda (frame)
- (eq (frame-parameter frame 'display) display))))
+ (equal (frame-parameter frame 'display) display))))
(filtered-frame-list func)))
(defun framep-on-display (&optional display)
(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 ((eq window-system 'x)
+ (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)))
- (select-frame frame)
- (raise-frame frame)
- ;; Ensure, if possible, that frame gets input focus.
- (when (eq window-system 'w32)
- (w32-focus-frame frame))
- (cond (focus-follows-mouse
- (unless (eq window-system 'w32)
- (set-mouse-position (selected-frame) (1- (frame-width)) 0)))
- (t
- (when (eq window-system 'x)
- (x-focus-frame frame))))))
+ (select-frame-set-input-focus frame)))
(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 ((eq window-system 'x)
+ (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
"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
+ (interactive
(list
(let ((completion-ignore-case t))
(completing-read "Font name: "
(list (cons 'font font-name)))
(run-hooks 'after-setting-font-hook 'after-setting-font-hooks))
+(defun set-frame-parameter (frame parameter value)
+ (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)))
(modify-frame-parameters (selected-frame)
- (list (cons 'background-color color-name))))
+ (list (cons 'background-color color-name)))
+ (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.
To get the frame's current foreground color, use `frame-parameters'."
(interactive (list (facemenu-read-color)))
(modify-frame-parameters (selected-frame)
- (list (cons 'foreground-color color-name))))
+ (list (cons 'foreground-color color-name)))
+ (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.
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)
((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.
(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))))
+ (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 'screen-height 'frame-height) ;before 19.15
(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
+(defvaralias 'delete-frame-hook 'delete-frame-functions)
+(make-obsolete-variable 'delete-frame-hook 'delete-frame-functions "21.4")
+
\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'."
+ "*Non-nil means highlight trailing whitespace in face `trailing-whitespace'.
+
+Setting this variable makes it local to the current buffer."
:tag "Highlight trailing whitespace."
- :set #'(lambda (symbol value) (set-default symbol value))
:type 'boolean
:group 'font-lock)
\f
-;;; Scrolling
+;; Scrolling
(defgroup scrolling nil
"Scrolling windows."
:version "21.1"
:group 'frames)
-(defcustom automatic-hscrolling t
- "*Allow or disallow autmatic scrolling windows horizontally.
+(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."
"Toggle blinking cursor mode.
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."
+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."
(interactive "P")
(let ((on-p (if (null arg)
(not blink-cursor-mode)
(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 running under a window system."
+ :tag "Hourglass pointer"
: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."
+ :tag "Hourglass delay"
: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
+(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.
-Setting this variable directly has no effect; use custom instead
-(or set the variable `cursor-in-non-selected-windows')."
+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