;;; frame.el --- multi-frame management independent of window systems
-;; Copyright (C) 1993, 1994, 1996, 1997, 2000, 2001, 2003, 2004
-;; Free Software Foundation, Inc.
+;; Copyright (C) 1993, 1994, 1996, 1997, 2000, 2001, 2002, 2003,
+;; 2004, 2005 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:
;; 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."
+React to settings of `initial-frame-alist',
+`window-system-default-frame-alist' and `default-frame-alist'
+there (in decreasing order of priority)."
;; Make menu-bar-mode and default-frame-alist consistent.
(when (boundp 'menu-bar-mode)
(let ((default (assq 'menu-bar-lines default-frame-alist)))
;; 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)))
+ (let ((old-buffer (current-buffer))
+ (window-system-frame-alist (cdr (assq initial-window-system
+ window-system-default-frame-alist))))
(when (and frame-notice-user-settings
(null frame-initial-frame))
(modify-frame-parameters nil
(if (null initial-window-system)
(append initial-frame-alist
+ window-system-frame-alist
default-frame-alist
parms
nil)
;; 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 window-system-frame-alist)
(assq 'tool-bar-lines default-frame-alist))))
(when (and tool-bar-originally-present
(or (null tool-bar-lines)
;; 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 window-system-frame-alist)
(assq 'minibuffer default-frame-alist)
'(minibuffer . t)))
t))
(setq parms (delq (assq 'name parms) parms)))
(setq parms (append initial-frame-alist
+ window-system-frame-alist
default-frame-alist
parms
nil))
;; 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)))
(x-initialize-window-system))
(make-frame `((window-system . x) (display . ,display) . ,parameters)))
-(defun make-frame-on-tty (device type &optional parameters)
- "Make a frame on terminal DEVICE which is of type TYPE (e.g., \"xterm\").
-The optional third argument PARAMETERS specifies additional frame parameters."
+(defun make-frame-on-tty (tty type &optional parameters)
+ "Make a frame on terminal device TTY.
+TTY should be the file name of the tty device to use. TYPE
+should be the terminal type string of TTY, for example \"xterm\"
+or \"vt100\". The optional third argument PARAMETERS specifies
+additional frame parameters."
(interactive "fOpen frame on tty device: \nsTerminal type of %s: ")
- (unless device
+ (unless tty
(error "Invalid terminal device"))
(unless type
(error "Invalid terminal type"))
- (make-frame `((window-system . nil) (tty . ,device) (tty-type . ,type) . ,parameters)))
+ (make-frame `((window-system . nil) (tty . ,tty) (tty-type . ,type) . ,parameters)))
(defun make-frame-command ()
"Make a new frame, and select it if the terminal displays only one frame."
"Functions to run after a frame's font has been changed.")
;; Alias, kept temporarily.
-(defalias 'new-frame 'make-frame)
-(make-obsolete 'new-frame 'make-frame "22.1")
+(define-obsolete-function-alias 'new-frame 'make-frame "22.1")
(defun make-frame (&optional parameters)
"Return a newly created frame displaying the current buffer.
(window-system . nil) The frame should be displayed on a terminal device.
(window-system . x) The frame should be displayed in an X window.
- (display-id . ID) The frame should use the display identified by ID.
+ (terminal . ID) The frame should use the terminal identified by ID.
Before the frame is created (via `frame-creation-function-alist'), functions on the
hook `before-make-frame-hook' are run. After the frame is created, functions
setup is for focus to follow the pointer."
(interactive)
(let* ((w (cond
- ((assq 'display-id parameters)
- (let ((type (display-live-p (cdr (assq 'display-id parameters)))))
+ ((assq 'terminal parameters)
+ (let ((type (terminal-live-p (cdr (assq 'terminal parameters)))))
(cond
((eq type t) nil)
- ((eq type nil) (error "Display %s does not exist" (cdr (assq 'display-id parameters))))
+ ((eq type nil) (error "Terminal %s does not exist" (cdr (assq 'terminal parameters))))
(t type))))
((assq 'window-system parameters)
(cdr (assq 'window-system parameters)))
(t window-system)))
(frame-creation-function (cdr (assq w frame-creation-function-alist)))
+ (oldframe (selected-frame))
frame)
(unless frame-creation-function
(error "Don't know how to create a frame on window system %s" w))
(run-hooks 'before-make-frame-hook)
- (setq frame (funcall frame-creation-function parameters))
- (modify-frame-parameters frame
- (cdr (assq w window-system-default-frame-alist)))
+ (setq frame (funcall frame-creation-function (append parameters (cdr (assq w window-system-default-frame-alist)))))
+ (normal-erase-is-backspace-setup-frame frame)
+ ;; Set up the frame-local environment, if needed.
+ (when (eq (frame-terminal frame) (frame-terminal oldframe))
+ (let ((env (frame-parameter oldframe 'environment)))
+ (if (not (framep env))
+ (setq env oldframe))
+ (if env
+ (set-frame-parameter frame 'environment env))))
(run-hook-with-args 'after-make-frame-functions frame)
frame))
(function (lambda (frame)
(eq frame (window-frame (minibuffer-window frame)))))))
-(defun frames-on-display-list (&optional display)
- "Return a list of all frames on DISPLAY.
+(defun frames-on-display-list (&optional terminal)
+ "Return a list of all frames on TERMINAL.
-DISPLAY should be a display identifier (an integer), but it may
-also be a name of a display, a string of the form HOST:SERVER.SCREEN.
+TERMINAL should be a terminal identifier (an integer), a frame,
+or a name of an X 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 (frame-display)))
+If TERMINAL is omitted or nil, it defaults to the selected
+frame's terminal device."
+ (let* ((terminal (terminal-id terminal))
(func #'(lambda (frame)
- (or (eq (frame-display frame) display)
- (equal (frame-parameter frame 'display) display)))))
+ (eq (frame-terminal frame) terminal))))
(filtered-frame-list func)))
-(defun framep-on-display (&optional display)
- "Return the type of frames on DISPLAY.
-DISPLAY may be a display id, a display name or a frame. If it is
-a frame, its type is returned.
-If DISPLAY is omitted or nil, it defaults to the selected frame's display.
-All frames on a given display are of the same type."
- (or (display-live-p display)
- (framep display)
- (framep (car (frames-on-display-list display)))))
+(defun framep-on-display (&optional terminal)
+ "Return the type of frames on TERMINAL.
+TERMINAL may be a terminal id, a display name or a frame. If it
+is a frame, its type is returned. If TERMINAL is omitted or nil,
+it defaults to the selected frame's terminal device. All frames
+on a given display are of the same type."
+ (or (terminal-live-p terminal)
+ (framep terminal)
+ (framep (car (frames-on-display-list terminal)))))
(defun frame-remove-geometry-params (param-list)
"Return the parameter list PARAM-LIST, but with geometry specs removed.
(defun suspend-frame ()
"Do whatever is right to suspend the current frame.
-Calls `suspend-emacs' if invoked from the controlling terminal,
-`suspend-tty' from a secondary terminal, and
+Calls `suspend-emacs' if invoked from the controlling tty device,
+`suspend-tty' from a secondary tty device, and
`iconify-or-deiconify-frame' from an X frame."
(interactive)
(let ((type (framep (selected-frame))))
(cond
((eq type 'x) (iconify-or-deiconify-frame))
((eq type t)
- (if (display-controlling-tty-p)
+ (if (controlling-tty-p)
(suspend-emacs)
(suspend-tty)))
(t (suspend-emacs)))))
-
(defun make-frame-names-alist ()
(let* ((current-frame (selected-frame))
(falist
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
+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
(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)))
(or window-system
"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)))
(or window-system
"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))))
(defun frame-current-scroll-bars (&optional frame)
"Return the current scroll-bar settings in frame FRAME.
-Value is a cons (VERTICAL . HORISONTAL) where VERTICAL specifies the
+Value is a cons (VERTICAL . HORIZ0NTAL) where VERTICAL specifies the
current location of the vertical scroll-bars (left, right, or nil),
-and HORISONTAL specifies the current location of the horisontal scroll
+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))
(cons vert hor)))
\f
;;;; Frame/display capabilities.
-(defun selected-display ()
- "Return the display that is now selected."
- (frame-display (selected-frame)))
+(defun selected-terminal ()
+ "Return the terminal that is now selected."
+ (frame-terminal (selected-frame)))
(defun display-mouse-p (&optional display)
"Return non-nil if DISPLAY has a mouse available.
"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)
\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)
(when (eq (frame-parameter frame 'minibuffer) 'only)
(delete-frame frame)))))
-(make-obsolete 'screen-height 'frame-height) ;before 19.15
-(make-obsolete 'screen-width 'frame-width) ;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 "22.1")
+(define-obsolete-variable-alias 'delete-frame-hook
+ 'delete-frame-functions "22.1")
\f
;; Highlighting trailing whitespace.
(defcustom show-trailing-whitespace nil
"*Non-nil means highlight trailing whitespace.
This is done in the face `trailing-whitespace'."
- :tag "Highlight trailing whitespace."
:type 'boolean
- :group 'font-lock)
+ :group 'whitespace-faces)
\f
(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)
This timer calls `blink-cursor-timer-function' every
`blink-cursor-interval' seconds.")
-;; The strange sequence below is meant to set both the right temporary
-;; value and the right "standard expression" , according to Custom,
-;; for blink-cursor-mode. We do not know the standard _evaluated_
-;; value yet, because the standard expression uses values that are not
-;; yet set. Evaluating it now would yield an error, but we make sure
-;; that it is not evaluated, by ensuring that blink-cursor-mode is set
-;; before the defcustom is evaluated and by using the right :initialize
-;; function. The correct evaluated standard value will be installed
-;; in startup.el using exactly the same expression as in the defcustom.
-(defvar blink-cursor-mode)
-(unless (boundp 'blink-cursor-mode) (setq blink-cursor-mode nil))
-(defcustom blink-cursor-mode
- (not (or noninteractive
- emacs-quick-startup
- (eq system-type 'ms-dos)
- (not (memq initial-window-system '(x w32)))))
- "*Non-nil means Blinking Cursor mode is active."
- :group 'cursor
- :tag "Blinking cursor"
- :type 'boolean
- :initialize 'custom-initialize-set
- :set #'(lambda (symbol value)
- (set-default symbol value)
- (blink-cursor-mode (or value 0))))
-
-(defvaralias 'blink-cursor 'blink-cursor-mode)
-(make-obsolete-variable 'blink-cursor 'blink-cursor-mode "22.1")
-
-(defun blink-cursor-mode (arg)
+(define-minor-mode blink-cursor-mode
"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
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)
- (> (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))))
+ :init-value (not (or noninteractive
+ no-blinking-cursor
+ (eq system-type 'ms-dos)
+ (not (memq initial-window-system '(x w32 mac)))))
+ :initialize 'custom-initialize-safe-default
+ :group 'cursor
+ :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'.
;; Hourglass pointer
(defcustom display-hourglass t
- "*Non-nil means show an hourglass pointer when running under a window system."
- :tag "Hourglass pointer"
+ "*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)
(defcustom hourglass-delay 1
- "*Seconds to wait before displaying an hourglass pointer."
- :tag "Hourglass delay"
+ "*Seconds to wait before displaying an hourglass pointer when Emacs is busy."
:type 'number
:group 'cursor)
\f
(defcustom cursor-in-non-selected-windows t
- "*Non-nil means show a hollow box cursor in non-selected-windows.
+ "*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"
+ :tag "Cursor In Non-selected Windows"
:type 'boolean
:group 'cursor
:set #'(lambda (symbol value)
(define-key ctl-x-5-map "0" 'delete-frame)
(define-key ctl-x-5-map "o" 'other-frame)
-(substitute-key-definition 'suspend-emacs 'suspend-frame global-map)
-
(provide 'frame)
-;;; arch-tag: 82979c70-b8f2-4306-b2ad-ddbd6b328b56
+;; arch-tag: 82979c70-b8f2-4306-b2ad-ddbd6b328b56
;;; frame.el ends here