;;; 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.
+These may be set in your init file, like this:
+
+ ;; 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))))
+
+Also see `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.
(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)
(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)))
;; 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
- (function
- (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.")
;; 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
default-frame-alist
parms
;; 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)
(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 (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."
+ (interactive "fOpen frame on tty device: \nsTerminal type of %s: ")
+ (unless device
+ (error "Invalid terminal device"))
+ (unless type
+ (error "Invalid terminal type"))
+ (make-frame `((window-system . nil) (tty . ,device) (tty-type . ,type) . ,parameters)))
(defun make-frame-command ()
"Make a new frame, and select it if the terminal displays only one frame."
(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.
+
+ (device . ID) The frame should use the display device 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.
instance if the frame appears under the mouse pointer and your
setup is for focus to follow the pointer."
(interactive)
- (run-hooks 'before-make-frame-hook)
- (let ((frame (funcall frame-creation-function parameters)))
+ (let* ((w (cond
+ ((assq 'device parameters)
+ (let ((type (display-live-p (cdr (assq 'device parameters)))))
+ (cond
+ ((eq type t) nil)
+ ((eq type nil) (error "Display %s does not exist" (cdr (assq 'device 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)))
+ 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 (append parameters (cdr (assq w window-system-default-frame-alist)))))
(run-hook-with-args 'after-make-frame-functions frame)
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.
+
+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.
+
If DISPLAY is omitted or nil, it defaults to the selected frame's display."
- (let* ((display (or display (frame-parameter nil 'display)))
+ (let* ((display (or display (frame-display)))
(func #'(lambda (frame)
- (equal (frame-parameter frame 'display) display))))
+ (or (eq (frame-display frame) display)
+ (equal (frame-parameter frame 'display) display)))))
(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.
+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 (framep display)
+ (or (display-live-p display)
+ (framep display)
(framep (car (frames-on-display-list display)))))
(defun frame-remove-geometry-params (param-list)
(select-frame frame)
(raise-frame frame)
;; Ensure, if possible, that frame gets input focus.
- (cond ((eq window-system 'x)
+ (cond ((eq (window-system frame) 'x)
(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))))
(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 terminal,
+`suspend-tty' from a secondary terminal, 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)
+ (suspend-emacs)
+ (suspend-tty)))
+ (t (suspend-emacs)))))
+
+
(defun make-frame-names-alist ()
(let* ((current-frame (selected-frame))
(falist
(raise-frame frame)
(select-frame frame)
;; Ensure, if possible, that frame gets input focus.
- (cond ((eq window-system 'x)
+ (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))))
(cons vert hor)))
\f
;;;; Frame/display capabilities.
+(defun selected-display ()
+ "Return the display that is now selected."
+ (frame-display (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
((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.
:init-value (not (or noninteractive
no-blinking-cursor
(eq system-type 'ms-dos)
- (not (memq window-system '(x w32)))))
+ (not (memq initial-window-system '(x w32)))))
:initialize 'custom-initialize-safe-default
:group 'cursor
:global t
(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)
+
+
+(defun terminal-id (terminal)
+ "Return the numerical id of terminal TERMINAL.
+
+TERMINAL can be a terminal id, a frame, or nil (meaning the
+selected frame's terminal)."
+ (cond
+ ((integerp terminal)
+ terminal)
+ ((or (null terminal) (framep terminal))
+ (frame-display terminal))
+ (t
+ (error "Invalid argument %s in `terminal-id'" terminal))))
+
+(defvar terminal-parameter-alist nil
+ "An alist of terminal parameter alists.")
+
+(defun terminal-parameters (&optional terminal)
+ "Return the paramater-alist of terminal TERMINAL.
+It is a list of elements of the form (PARM . VALUE), where PARM is a symbol.
+
+TERMINAL can be a terminal id, a frame, or nil (meaning the
+selected frame's terminal)."
+ (cdr (assq (terminal-id terminal) terminal-parameter-alist)))
+
+(defun terminal-parameter (terminal parameter)
+ "Return TERMINAL's value for parameter PARAMETER.
+
+TERMINAL can be a terminal id, a frame, or nil (meaning the
+selected frame's terminal)."
+ (cdr (assq parameter (cdr (assq (terminal-id terminal) terminal-parameter-alist)))))
+
+(defun set-terminal-parameter (terminal parameter value)
+ "Set TERMINAL's value for parameter PARAMETER to VALUE.
+Returns the previous value of PARAMETER.
+
+TERMINAL can be a terminal id, a frame, or nil (meaning the
+selected frame's terminal)."
+ (setq terminal (terminal-id terminal))
+ (let* ((alist (assq terminal terminal-parameter-alist))
+ (pair (assq parameter (cdr alist)))
+ (result (cdr pair)))
+ (cond
+ (pair (setcdr pair value))
+ (alist (setcdr alist (cons (cons parameter value) (cdr alist))))
+ (t (setq terminal-parameter-alist
+ (cons (cons terminal
+ (cons (cons parameter value)
+ nil))
+ terminal-parameter-alist))))
+ result))
+
+(defun terminal-handle-delete-frame (frame)
+ "Clean up terminal parameters of FRAME, if it's the last frame on its terminal."
+ ;; XXX We assume that the display is closed immediately after the
+ ;; last frame is deleted on it. It would be better to create a hook
+ ;; called `delete-display-functions', and use it instead.
+ (when (and (frame-live-p frame)
+ (= 1 (length (frames-on-display-list (frame-display frame)))))
+ (setq terminal-parameter-alist
+ (assq-delete-all (frame-display frame) terminal-parameter-alist))))
+
+(add-hook 'delete-frame-functions 'terminal-handle-delete-frame)
+
(provide 'frame)
;; arch-tag: 82979c70-b8f2-4306-b2ad-ddbd6b328b56