;;; frame.el --- multi-frame management independent of window systems
;; Copyright (C) 1993, 1994, 1996, 1997, 2000, 2001, 2002, 2003,
-;; 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
+;; 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
;; Maintainer: FSF
;; Keywords: internal
(list (cons nil
(if (fboundp 'tty-create-frame-with-faces)
'tty-create-frame-with-faces
- (function
- (lambda (parameters)
- (error "Can't create multiple frames without a window system"))))))
+ (lambda (parameters)
+ (error "Can't create multiple frames without a window system")))))
"Alist of window-system dependent functions to call to create a new frame.
The window system startup file should add its frame creation
function to this list, which should take an alist of parameters
;; Copy the environment of the Emacs process into the new frame.
(set-frame-parameter frame-initial-frame 'environment
(frame-parameter terminal-frame 'environment))
- (set-frame-parameter frame-initial-frame 'term-environment-variable
- (getenv "TERM"))
- (set-frame-parameter frame-initial-frame 'display-environment-variable
- (getenv "DISPLAY"))
;; At this point, we know that we have a frame open, so we
;; can delete the terminal frame.
(delete-frame terminal-frame)
;; the buffer of the selected window, which fails when the selected
;; window is the minibuffer.
(let ((old-buffer (current-buffer))
- (window-system-frame-alist (cdr (assq initial-window-system
- window-system-default-frame-alist))))
+ (window-system-frame-alist
+ (cdr (assq initial-window-system
+ window-system-default-frame-alist))))
(when (and frame-notice-user-settings
(null frame-initial-frame))
0))
(select-frame-set-input-focus (selected-frame)))
+(declare-function x-initialize-window-system "term/x-win" ())
+
(defun make-frame-on-display (display &optional parameters)
"Make a frame on X display DISPLAY.
The optional second argument PARAMETERS specifies additional frame parameters."
;; Alias, kept temporarily.
(define-obsolete-function-alias 'new-frame 'make-frame "22.1")
+(defvar frame-inherited-parameters '()
+ ;; FIXME: Shouldn't we add `font' here as well?
+ "Parameters `make-frame' copies from the `selected-frame' to the new frame.")
+
(defun make-frame (&optional parameters)
"Return a newly created frame displaying the current buffer.
Optional argument PARAMETERS is an alist of parameters for the new frame.
(let ((type (terminal-live-p (cdr (assq 'terminal parameters)))))
(cond
((eq type t) nil)
- ((eq type nil) (error "Terminal %s does not exist" (cdr (assq 'terminal 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)))
(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 (append parameters (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)
- ;; Inherit the 'environment and 'client parameters.
- (let ((env (frame-parameter oldframe 'environment))
- (client (frame-parameter oldframe 'client))
- (termenv (frame-parameter oldframe 'term-environment-variable))
- (displayenv (frame-parameter oldframe 'display-environment-variable)))
- (if (not (framep env))
- (setq env oldframe))
- (if (and env (not (assq 'environment parameters)))
- (set-frame-parameter frame 'environment env))
- (if (and termenv (not (assq 'term-environment-variable parameters)))
- (set-frame-parameter frame 'term-environment-variable termenv))
- (if (and displayenv (not (assq 'display-environment-variable parameters)))
- (set-frame-parameter frame 'display-environment-variable displayenv))
- (if (and client (not (assq 'client parameters)))
- (set-frame-parameter frame 'client client)))
+ ;; Inherit the original frame's parameters.
+ (dolist (param frame-inherited-parameters)
+ (unless (assq param parameters) ;Overridden by explicit parameters.
+ (let ((val (frame-parameter oldframe param)))
+ (when val (set-frame-parameter frame param val)))))
(run-hook-with-args 'after-make-frame-functions frame)
frame))
(lambda (frame)
(eq frame (window-frame (minibuffer-window frame))))))
-(defun frames-on-display-list (&optional terminal)
- "Return a list of all frames on TERMINAL.
-
-TERMINAL should be a terminal identifier (an integer), a frame,
-or a name of an X display (a string of the form
+;; Used to be called `terminal-id' in termdev.el.
+(defun get-device-terminal (device)
+ "Return the terminal corresponding to DEVICE.
+DEVICE can be a terminal, a frame, nil (meaning the selected frame's terminal),
+the name of an X display device (HOST.SERVER.SCREEN) or a tty device file."
+ (cond
+ ((or (null device) (framep device))
+ (frame-terminal device))
+ ((stringp device)
+ (let ((f (car (filtered-frame-list
+ (lambda (frame)
+ (or (equal (frame-parameter frame 'display) device)
+ (equal (frame-parameter frame 'tty) device)))))))
+ (or f (error "Display %s does not exist" device))
+ (frame-terminal f)))
+ ((terminal-live-p device) device)
+ (t
+ (error "Invalid argument %s in `get-device-terminal'" device))))
+
+(defun frames-on-display-list (&optional device)
+ "Return a list of all frames on DEVICE.
+
+DEVICE should be a terminal, a frame,
+or a name of an X display or tty (a string of the form
HOST:SERVER.SCREEN).
-If TERMINAL is omitted or nil, it defaults to the selected
+If DEVICE is omitted or nil, it defaults to the selected
frame's terminal device."
- (let* ((terminal (terminal-id terminal))
+ (let* ((terminal (get-device-terminal device))
(func #'(lambda (frame)
(eq (frame-terminal frame) terminal))))
(filtered-frame-list func)))
(nreverse frame-initial-geometry-arguments))
(cdr param-list))
-(defcustom focus-follows-mouse (not (eq window-system 'mac))
- "*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.
-
-This variable does not have any effect on MS-Windows."
- :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 frame) '(x max))
- (x-focus-frame frame))
- ((eq (window-system frame) 'w32)
- (w32-focus-frame frame)))
- (cond (focus-follows-mouse
- (set-mouse-position (selected-frame) (1- (frame-width)) 0))))
+ (when (memq (window-system frame) '(x mac w32))
+ (x-focus-frame frame))
+ (when focus-follows-mouse
+ (set-mouse-position (selected-frame) (1- (frame-width)) 0)))
(defun other-frame (arg)
"Select the ARGth different visible frame on current display, and raise it.
(interactive)
(let ((type (framep (selected-frame))))
(cond
- ((eq type 'x) (iconify-or-deiconify-frame))
+ ((memq type '(x w32)) (iconify-or-deiconify-frame))
((eq type t)
(if (controlling-tty-p)
(suspend-emacs)
(raise-frame frame)
(select-frame frame)
;; Ensure, if possible, that frame gets input focus.
- (cond ((eq (window-system frame) 'x)
- (x-focus-frame frame))
- ((eq (window-system frame) 'w32)
- (w32-focus-frame frame)))
+ (cond ((memq (window-system frame) '(x w32))
+ (x-focus-frame frame)))
(when focus-follows-mouse
(set-mouse-position frame (1- (frame-width frame)) 0))))
\f
;; Since we can't set a frame's minibuffer status,
;; we might as well omit the parameter altogether.
(let* ((parms (nth 1 parameters))
- (mini (assq 'minibuffer parms)))
- (if mini (setq parms (delq mini parms)))
+ (mini (assq 'minibuffer parms))
+ (name (assq 'name parms))
+ (explicit-name (cdr (assq 'explicit-name parms))))
+ (when mini (setq parms (delq mini parms)))
+ ;; Leave name in iff it was set explicitly.
+ ;; This should fix the behavior reported in
+ ;; http://lists.gnu.org/archive/html/emacs-devel/2007-08/msg01632.html
+ (when (and name (not explicit-name))
+ (setq parms (delq name parms)))
parms))
(set-window-configuration (nth 2 parameters)))
(setq frames-to-delete (cons frame frames-to-delete)))))
"Return the terminal that is now selected."
(frame-terminal (selected-frame)))
+(declare-function msdos-mouse-p "dosfns.c")
+
(defun display-mouse-p (&optional display)
"Return non-nil if DISPLAY has a mouse available.
DISPLAY can be a display name, a frame, or nil (meaning the selected
(defun display-mm-height (&optional display)
"Return the height of DISPLAY's screen in millimeters.
-System values can be overriden by `display-mm-dimensions-alist'.
+System values can be overridden by `display-mm-dimensions-alist'.
If the information is unavailable, value is nil."
(and (memq (framep-on-display display) '(x w32 mac))
(or (cddr (assoc (or display (frame-parameter nil 'display))
(defun display-mm-width (&optional display)
"Return the width of DISPLAY's screen in millimeters.
-System values can be overriden by `display-mm-dimensions-alist'.
+System values can be overridden by `display-mm-dimensions-alist'.
If the information is unavailable, value is nil."
(and (memq (framep-on-display display) '(x w32 mac))
(or (cadr (assoc (or display (frame-parameter nil 'display))
'static-gray))))
\f
+;;;; Frame geometry values
+
+(defun frame-geom-value-cons (type value &optional frame)
+ "Return equivalent geometry value for FRAME as a cons with car `+'.
+A geometry value equivalent to VALUE for FRAME is returned,
+where the value is a cons with car `+', not numeric.
+TYPE is the car of the original geometry spec (TYPE . VALUE).
+ It is `top' or `left', depending on which edge VALUE is related to.
+VALUE is the cdr of a frame geometry spec: (left/top . VALUE).
+If VALUE is a number, then it is converted to a cons value, perhaps
+ relative to the opposite frame edge from that in the original spec.
+FRAME defaults to the selected frame.
+
+Examples (measures in pixels) -
+ Assuming display height/width=1024, frame height/width=600:
+ 300 inside display edge: 300 => (+ 300)
+ (+ 300) => (+ 300)
+ 300 inside opposite display edge: (- 300) => (+ 124)
+ -300 => (+ 124)
+ 300 beyond display edge
+ (= 724 inside opposite display edge): (+ -300) => (+ -300)
+ 300 beyond display edge
+ (= 724 inside opposite display edge): (- -300) => (+ 724)
+
+In the 3rd, 4th, and 6th examples, the returned value is relative to
+the opposite frame edge from the edge indicated in the input spec."
+ (cond ((and (consp value) (eq '+ (car value))) ; e.g. (+ 300), (+ -300)
+ value)
+ ((natnump value) (list '+ value)) ; e.g. 300 => (+ 300)
+ (t ; e.g. -300, (- 300), (- -300)
+ (list '+ (- (if (eq 'left type) ; => (+ 124), (+ 124), (+ 724)
+ (x-display-pixel-width)
+ (x-display-pixel-height))
+ (if (integerp value) (- value) (cadr value))
+ (if (eq 'left type)
+ (frame-pixel-width frame)
+ (frame-pixel-height frame)))))))
+
+(defun frame-geom-spec-cons (spec &optional frame)
+ "Return equivalent geometry spec for FRAME as a cons with car `+'.
+A geometry specification equivalent to SPEC for FRAME is returned,
+where the value is a cons with car `+', not numeric.
+SPEC is a frame geometry spec: (left . VALUE) or (top . VALUE).
+If VALUE is a number, then it is converted to a cons value, perhaps
+ relative to the opposite frame edge from that in the original spec.
+FRAME defaults to the selected frame.
+
+Examples (measures in pixels) -
+ Assuming display height=1024, frame height=600:
+ top 300 below display top: (top . 300) => (top + 300)
+ (top + 300) => (top + 300)
+ bottom 300 above display bottom: (top - 300) => (top + 124)
+ (top . -300) => (top + 124)
+ top 300 above display top
+ (= bottom 724 above display bottom): (top + -300) => (top + -300)
+ bottom 300 below display bottom
+ (= top 724 below display top): (top - -300) => (top + 724)
+
+In the 3rd, 4th, and 6th examples, the returned value is relative to
+the opposite frame edge from the edge indicated in the input spec."
+ (cons (car spec) (frame-geom-value-cons (car spec) (cdr spec))))
+\f
;;;; Aliases for backward compatibility with Emacs 18.
(define-obsolete-function-alias 'screen-height 'frame-height) ;before 19.15
(define-obsolete-function-alias 'screen-width 'frame-width) ;before 19.15
(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.
+If t, display a cursor related to the usual cursor type
+ \(a solid box becomes hollow, a bar becomes a narrower bar).
+You can also specify the cursor type as in the `cursor-type' variable.
Use Custom to set this variable to get the display updated."
:tag "Cursor In Non-selected Windows"
:type 'boolean
HCoop / bpt / emacs.git / blobdiff