;;; frame.el --- multi-frame management independent of window systems
-;; Copyright (C) 1993, 1994, 1996, 1997, 2000, 2001, 2003, 2004, 2005
-;; 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 'whitespace-faces)
(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.")
-;; We do not know the standard _evaluated_ value yet, because the standard
-;; expression uses values that are not yet set. The correct evaluated
-;; standard value will be installed in startup.el using exactly the same
-;; expression as in the defcustom.
(define-minor-mode blink-cursor-mode
"Toggle blinking cursor mode.
With a numeric argument, turn blinking cursor mode on iff ARG is positive.
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
- (if (boundp 'no-blinking-cursor) no-blinking-cursor)
+ no-blinking-cursor
(eq system-type 'ms-dos)
- (not (memq initial-window-system '(x w32)))))
+ (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))
'blink-cursor-start)))
(internal-show-cursor nil t)))
-(defvaralias 'blink-cursor 'blink-cursor-mode)
-(make-obsolete-variable 'blink-cursor 'blink-cursor-mode "22.1")
+(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
HCoop / bpt / emacs.git / blobdiff