[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] Changes to emacs/lisp/frame.el,v
|
From: |
Miles Bader |
|
Subject: |
[Emacs-diffs] Changes to emacs/lisp/frame.el,v |
|
Date: |
Wed, 29 Aug 2007 05:28:43 +0000 |
CVSROOT: /cvsroot/emacs
Module name: emacs
Changes by: Miles Bader <miles> 07/08/29 05:28:10
Index: lisp/frame.el
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/frame.el,v
retrieving revision 1.246
retrieving revision 1.247
diff -u -b -r1.246 -r1.247
--- lisp/frame.el 13 Aug 2007 13:41:01 -0000 1.246
+++ lisp/frame.el 29 Aug 2007 05:28:04 -0000 1.247
@@ -27,10 +27,28 @@
;;; Code:
-(defvar frame-creation-function nil
- "Window-system dependent function to call to create a new frame.
-The window system startup file should set this to its frame creation
-function, which should take an alist of parameters as its argument.")
+(defvar frame-creation-function-alist
+ (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"))))))
+ "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
+as its argument.")
+
+(defvar window-system-default-frame-alist nil
+ "Alist of window-system dependent default frame parameters.
+You can set this in your `.emacs' file; for example,
+
+ ;; Disable menubar and toolbar on the console, but enable them under X.
+ (setq window-system-default-frame-alist
+ '((x (menu-bar-lines . 1) (tool-bar-lines . 1))
+ (nil (menu-bar-lines . 0) (tool-bar-lines . 0))))
+
+Parameters specified here supersede the values given in
`default-frame-alist'.")
;; The initial value given here used to ask for a minibuffer.
;; But that's not necessary, because the default is to have one.
@@ -189,7 +207,9 @@
(defun frame-initialize ()
"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)))
+ (if (and initial-window-system
+ (not noninteractive)
+ (not (eq initial-window-system 'pc)))
(progn
;; Turn on special-display processing only if there's a window system.
(setq special-display-function 'special-display-popup-frame)
@@ -206,6 +226,9 @@
(setq frame-initial-frame-alist
(cons '(horizontal-scroll-bars . t)
frame-initial-frame-alist)))
+ (setq frame-initial-frame-alist
+ (cons (cons 'window-system initial-window-system)
+ frame-initial-frame-alist))
(setq default-minibuffer-frame
(setq frame-initial-frame
(make-frame frame-initial-frame-alist)))
@@ -215,20 +238,17 @@
;; because that would override explicit user resizing.
(setq initial-frame-alist
(frame-remove-geometry-params initial-frame-alist))))
+ ;; 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)
- (setq terminal-frame nil))
-
- ;; No, we're not running a window system. Use make-terminal-frame if
- ;; we support that feature, otherwise arrange to cause errors.
- (or (eq window-system 'pc)
- (setq frame-creation-function
- (if (fboundp 'tty-create-frame-with-faces)
- 'tty-create-frame-with-faces
- (lambda (parameters)
- (error
- "Can't create multiple frames without a window
system")))))))
+ (setq terminal-frame nil))))
(defvar frame-notice-user-settings t
"Non-nil means function `frame-notice-user-settings' wasn't run yet.")
@@ -238,7 +258,9 @@
;; 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)))
@@ -257,16 +279,26 @@
(let ((default (assq 'tool-bar-lines default-frame-alist)))
(if default
(setq tool-bar-mode (not (eq (cdr default) 0)))
+ ;; If Emacs was started on a tty, changing default-frame-alist
+ ;; would disable the toolbar on X frames created later. We
+ ;; want to keep the default of showing a toolbar under X even
+ ;; in this case.
+ ;;
+ ;; If the user explicitly called `tool-bar-mode' in .emacs,
+ ;; then default-frame-alist is already changed anyway.
+ (when initial-window-system
(setq default-frame-alist
(cons (cons 'tool-bar-lines (if tool-bar-mode 1 0))
- default-frame-alist)))))
+ default-frame-alist))))))
;; Creating and deleting frames may shift the selected frame around,
;; and thus the current buffer. Protect against that. We don't
;; 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))
@@ -278,8 +310,9 @@
;; Can't modify the minibuffer parameter, so don't try.
(setq parms (delq (assq 'minibuffer parms) parms))
(modify-frame-parameters nil
- (if (null window-system)
+ (if (null initial-window-system)
(append initial-frame-alist
+ window-system-frame-alist
default-frame-alist
parms
nil)
@@ -287,7 +320,7 @@
;; default-frame-alist were already
;; applied in pc-win.el.
parms))
- (if (null window-system) ;; MS-DOS does this differently in pc-win.el
+ (if (null initial-window-system) ;; MS-DOS does this differently in
pc-win.el
(let ((newparms (frame-parameters))
(frame (selected-frame)))
(tty-handle-reverse-video frame newparms)
@@ -309,6 +342,7 @@
;; 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)
@@ -369,6 +403,7 @@
;; 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))
@@ -388,6 +423,7 @@
(setq parms (delq (assq 'name parms) parms)))
(setq parms (append initial-frame-alist
+ window-system-frame-alist
default-frame-alist
parms
nil))
@@ -463,6 +499,7 @@
;; 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)))
@@ -519,19 +556,25 @@
(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'.
+Furthermore, this function removes all parameters in ALIST from
+`window-system-default-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
+ ;; 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)))))
+ (setq initial-frame-alist
+ (assq-delete-all (car pair) initial-frame-alist)))
+ (setq default-frame-alist
+ (assq-delete-all (car pair) default-frame-alist))
+ ;; Remove any similar settings from the window-system specific
+ ;; parameters---they would override default-frame-alist.
+ (dolist (w window-system-default-frame-alist)
+ (setcdr w (assq-delete-all (car pair) (cdr w)))))
+
(and frame-notice-user-settings
(setq initial-frame-alist (append initial-frame-alist alist)))
(setq default-frame-alist (append default-frame-alist alist)))
@@ -562,12 +605,28 @@
(select-frame-set-input-focus (selected-frame)))
(defun make-frame-on-display (display &optional parameters)
- "Make a frame on display DISPLAY.
+ "Make a frame on X display DISPLAY.
The optional second argument PARAMETERS specifies additional frame parameters."
(interactive "sMake frame on display: ")
(or (string-match "\\`[^:]*:[0-9]+\\(\\.[0-9]+\\)?\\'" display)
(error "Invalid display, not HOST:SERVER or HOST:SERVER.SCREEN"))
- (make-frame (cons (cons 'display display) parameters)))
+ (when (and (boundp 'x-initialized) (not x-initialized))
+ (setq x-display-name display)
+ (x-initialize-window-system))
+ (make-frame `((window-system . x) (display . ,display) . ,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 tty
+ (error "Invalid terminal device"))
+ (unless type
+ (error "Invalid terminal type"))
+ (make-frame `((window-system . nil) (tty . ,tty) (tty-type . ,type) .
,parameters)))
(defun close-display-connection (display)
"Close the connection to a display, deleting all its associated frames.
@@ -636,7 +695,12 @@
(minibuffer . only) The frame should contain only a minibuffer.
(minibuffer . WINDOW) The frame should use WINDOW as its minibuffer window.
-Before the frame is created (via `frame-creation-function'), functions on the
+ (window-system . nil) The frame should be displayed on a terminal device.
+ (window-system . x) The frame should be displayed in an X window.
+
+ (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
on `after-make-frame-functions' are run with one arg, the newly created frame.
@@ -646,8 +710,39 @@
instance if the frame appears under the mouse pointer and your
setup is for focus to follow the pointer."
(interactive)
+ (let* ((w (cond
+ ((assq 'terminal parameters)
+ (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))))
+ (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)
- (let ((frame (funcall frame-creation-function parameters)))
+ (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)))
(run-hook-with-args 'after-make-frame-functions frame)
frame))
@@ -667,23 +762,29 @@
(lambda (frame)
(eq frame (window-frame (minibuffer-window frame))))))
-(defun frames-on-display-list (&optional display)
- "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 (frame-parameter nil 'display)))
+(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
+HOST:SERVER.SCREEN).
+
+If TERMINAL is omitted or nil, it defaults to the selected
+frame's terminal device."
+ (let* ((terminal (terminal-id terminal))
(func #'(lambda (frame)
- (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 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 (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.
@@ -722,9 +823,9 @@
(select-frame frame)
(raise-frame frame)
;; Ensure, if possible, that frame gets input focus.
- (cond ((memq window-system '(x mac))
+ (cond ((memq (window-system frame) '(x max))
(x-focus-frame frame))
- ((eq window-system 'w32)
+ ((eq (window-system frame) 'w32)
(w32-focus-frame frame)))
(cond (focus-follows-mouse
(set-mouse-position (selected-frame) (1- (frame-width)) 0))))
@@ -761,6 +862,21 @@
(iconify-frame)
(make-frame-visible)))
+(defun suspend-frame ()
+ "Do whatever is right to suspend the current frame.
+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 (controlling-tty-p)
+ (suspend-emacs)
+ (suspend-tty)))
+ (t (suspend-emacs)))))
+
(defun make-frame-names-alist ()
(let* ((current-frame (selected-frame))
(falist
@@ -794,9 +910,9 @@
(raise-frame frame)
(select-frame frame)
;; Ensure, if possible, that frame gets input focus.
- (cond ((memq window-system '(x mac))
+ (cond ((eq (window-system frame) 'x)
(x-focus-frame frame))
- ((eq window-system 'w32)
+ ((eq (window-system frame) 'w32)
(w32-focus-frame frame)))
(when focus-follows-mouse
(set-mouse-position frame (1- (frame-width frame)) 0))))
@@ -1006,6 +1122,10 @@
(cons vert hor)))
;;;; Frame/display capabilities.
+(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.
DISPLAY can be a display name, a frame, or nil (meaning the selected
@@ -1183,7 +1303,7 @@
((eq frame-type 'pc)
16)
(t
- (tty-display-color-cells)))))
+ (tty-display-color-cells display)))))
(defun display-visual-class (&optional display)
"Returns the visual class of DISPLAY.