;;; screen.el --- multi-screen management independent of window systems.
;; Copyright (C) 1990, 1992, 1993, 1994 Free Software Foundation, Inc.
;; Maintainer: FSF
;; Keywords: internal
;;; This file is part of GNU Emacs.
;;;
;;; GNU Emacs is free software; you can redistribute it and/or modify
;;; it under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 2, or (at your option)
;;; any later version.
;;;
;;; GNU Emacs is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; 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, 675 Mass Ave, Cambridge, MA 02139, USA.
;;; Code:
(define-key global-map "\^Z" 'iconify-emacs)
;; Former, inferior names for functions.
;; These may disappear at some point.
(fset 'live-screen-p 'screen-live-p)
(fset 'x-pixel-width 'screen-pixel-width)
(fset 'x-pixel-height 'screen-pixel-height)
;; These are called from select_screen()
(defvar select-screen-hook nil
"Function or functions to run just after a new screen is selected.")
(defvar deselect-screen-hook nil
"Function or functions to run just before selecting another screen.")
(defvar screen-creation-function '-no-window-system-yet-
"Window-system dependent function to call to create a new screen.
The window system startup file should set this to its screen creation
function, which should take an alist of parameters as its argument.")
(defvar default-screen-alist nil
"Alist of default values for screen creation, other than the first one.
These may be set in your init file, like this:
(setq default-screen-alist '((width . 80) (height . 55)))
Since the first X screen is created before loading your .emacs file,
you must use the X resource database for that.
See also the variable `x-screen-defaults', which is like `default-screen-alist'
except that it applies only to X screens (wheras `default-screen-alist' applies
to all types of screens.)")
(defvar initial-screen-alist nil
"Alist of default values for the first screen.
This may be set by the window-system-specific init file.")
;;;; Creating the initial window-system screen
(defun screen-initialize ()
(cond ((and window-system (not (noninteractive)))
;; Don't call select-screen here - focus is a matter of WM policy.
(make-screen initial-screen-alist)
(delete-screen terminal-screen)
(setq terminal-screen nil))
(t
;; We're not running a window system, so arrange to cause errors.
(setq screen-creation-function
#'(lambda (parameters)
(error
"Can't create multiple screens without a window system"))))))
;;;; Creation of additional screens, and other screen miscellanea
(defun get-other-screen ()
"Return some screen other than the current screen, creating one if necessary."
(let* ((this (selected-screen))
;; search visible screens first
(next (next-screen this nil t)))
;; then search iconified screens
(if (eq this next)
(setq next (next-screen this nil nil)))
(if (eq this next)
;; otherwise, make a new screen
(make-screen)
next)))
(defun next-multiscreen-window ()
"Select the next window, regardless of which screen it is on."
(interactive)
(select-window (next-window (selected-window)
(> (minibuffer-depth) 0)
t)))
(defun previous-multiscreen-window ()
"Select the previous window, regardless of which screen it is on."
(interactive)
(select-window (previous-window (selected-window)
(> (minibuffer-depth) 0)
t)))
;; Alias, kept temporarily.
(defalias 'new-screen 'make-screen)
(make-obsolete 'new-screen 'make-screen)
(defun make-screen (&optional parameters)
"Create a new screen, displaying the current buffer.
Optional argument PARAMETERS is an alist of parameters for the new
screen. Specifically, PARAMETERS is a list of pairs, each having one
of the following forms:
(name . STRING) - The screen should be named STRING.
(height . NUMBER) - The screen should be NUMBER text lines high.
(width . NUMBER) - The screen should be NUMBER columns wide.
The documentation for the function `x-create-screen' describes
additional screen parameters that Emacs recognizes for X window screens."
; (minibuffer . t) - the screen should have a minibuffer
; (minibuffer . nil) - the screen should have no minibuffer
; (minibuffer . only) - the screen should contain only a minibuffer
; (minibuffer . WINDOW) - the screen should use WINDOW as its minibuffer window.
(interactive)
(let (nscreen)
;; lemacs has a more versatile hook than these
;;(run-hooks 'before-make-screen-hook)
(setq nscreen (funcall screen-creation-function
(append parameters
;; Where does FSFmacs consult this?
default-screen-alist)))
;;(run-hooks 'after-make-screen-hook)
nscreen))
;(defun filtered-screen-list (predicate)
; "Return a list of all live screens which satisfy PREDICATE."
; (let ((screens (screen-list))
; good-screens)
; (while (consp screens)
; (if (funcall predicate (car screens))
; (setq good-screens (cons (car screens) good-screens)))
; (setq screens (cdr screens)))
; good-screens))
;(defun minibuffer-screen-list ()
; "Return a list of all screens with their own minibuffers."
; (filtered-screen-list
; (function (lambda (screen)
; (eq screen (window-screen (minibuffer-window screen)))))))
;(defun screen-remove-geometry-params (param-list)
; "Return the parameter list PARAM-LIST, but with geometry specs removed.
;This deletes all bindings in PARAM-LIST for `top', `left', `width',
;and `height' parameters.
;Emacs uses this to avoid overriding explicit moves and resizings from
;the user during startup."
; (setq param-list (cons nil param-list))
; (let ((tail param-list))
; (while (consp (cdr tail))
; (if (and (consp (car (cdr tail)))
; (memq (car (car (cdr tail))) '(height width top left)))
; (setcdr tail (cdr (cdr tail)))
; (setq tail (cdr tail)))))
; (cdr param-list))
(defun other-screen (arg)
"Select the ARG'th different visible screen, and raise it.
All screens are arranged in a cyclic order.
This command selects the screen ARG steps away in that order.
A negative ARG moves in the opposite order."
(interactive "p")
(let ((screen (selected-screen)))
(while (> arg 0)
(setq screen (next-screen screen nil t))
(setq arg (1- arg)))
(while (< arg 0)
(setq screen (previous-screen screen nil t))
(setq arg (1+ arg)))
(raise-screen screen)
(select-screen screen)
))
;;;; Screen configurations
;; This stuff doesn't quite work yet - feel free to fix it
;(defun current-screen-configuration ()
; "Return a list describing the positions and states of all screens.
;Its car is `screen-configuration'.
;Each element of the cdr is a list of the form (SCREEN ALIST WINDOW-CONFIG),
;where
; SCREEN is a screen object,
; ALIST is an association list specifying some of SCREEN's parameters, and
; WINDOW-CONFIG is a window configuration object for SCREEN."
; (cons 'screen-configuration
; (mapcar (function
; (lambda (screen)
; (list screen
; (screen-parameters screen)
; (current-window-configuration screen))))
; (screen-list))))
;(defun set-screen-configuration (configuration &optional nodelete)
; "Restore the screens to the state described by CONFIGURATION.
;Each screen listed in CONFIGURATION has its position, size, window
;configuration, and other parameters set as specified in CONFIGURATION.
;Ordinarily, this function deletes all existing screens not
;listed in CONFIGURATION. But if optional second argument NODELETE
;is given and non-nil, the unwanted screens are iconified instead."
; (or (screen-configuration-p configuration)
; (signal 'wrong-type-argument
; (list 'screen-configuration-p configuration)))
; (let ((config-alist (cdr configuration))
; screens-to-delete)
; (mapcar (function
; (lambda (screen)
; (let ((parameters (assq screen config-alist)))
; (if parameters
; (progn
; (modify-screen-parameters
; screen
; ;; Since we can't set a screen'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)))
; parms))
; (set-window-configuration (nth 2 parameters)))
; (setq screens-to-delete (cons screen screens-to-delete))))))
; (screen-list))
; (if nodelete
; ;; Note: making screens invisible here was tried
; ;; but led to some strange behavior--each time the screen
; ;; was made visible again, the window manager asked afresh
; ;; for where to put it.
; (mapcar 'iconify-screen screens-to-delete)
; (mapcar 'delete-screen screens-to-delete))))
;(defun screen-configuration-p (object)
; "Return non-nil if OBJECT seems to be a screen configuration.
;Any list whose car is `screen-configuration' is assumed to be a screen
;configuration."
; (and (consp object)
; (eq (car object) 'screen-configuration)))
;;; Iconifying emacs.
;;;
;;; The function iconify-emacs replaces every non-iconified emacs window
;;; with a *single* icon. Iconified emacs windows are left alone. When
;;; emacs is in this globally-iconified state, de-iconifying any emacs icon
;;; will uniconify all screens that were visible, and iconify all screens
;;; that were not. This is done by temporarily changing the value of
;;; `map-screen-hook' to `deiconify-emacs' (which should never be called
;;; except from the map-screen-hook while emacs is iconified.)
;;;
;;; The title of the icon representing all emacs screens is controlled by
;;; the variable `icon-name'. This is done by temporarily changing the
;;; value of `screen-icon-title-format'. Unfortunately, this changes the
;;; titles of all emacs icons, not just the "big" icon.
;;;
;;; It would be nice if existing icons were removed and restored by
;;; iconifying the emacs process, but I couldn't make that work yet.
(defvar icon-name nil) ; set this at run time, not load time.
(defvar iconification-data nil)
(defun iconify-emacs ()
(interactive)
(if iconification-data (error "already iconified?"))
(let* ((screens (screen-list))
(rest screens)
(me (selected-screen))
screen)
(while rest
(setq screen (car rest))
(setcar rest (cons screen (screen-visible-p screen)))
; (if (memq (cdr (car rest)) '(icon nil))
; (progn
; (make-screen-visible screen) ; deiconify, and process the X event
; (sleep-for 500 t) ; process X events; I really want to XSync() here
; ))
(or (eq screen me) (make-screen-invisible screen))
(setq rest (cdr rest)))
(or (boundp 'map-screen-hook) (setq map-screen-hook nil))
(or icon-name
(setq icon-name (concat invocation-name " @ " (system-name))))
(setq iconification-data
(list screen-icon-title-format map-screen-hook screens)
screen-icon-title-format icon-name
map-screen-hook 'deiconify-emacs)
(iconify-screen me)))
(defun deiconify-emacs (&optional ignore)
(or iconification-data (error "not iconified?"))
(setq screen-icon-title-format (car iconification-data)
map-screen-hook (car (cdr iconification-data))
iconification-data (car (cdr (cdr iconification-data))))
(while iconification-data
(let ((visibility (cdr (car iconification-data))))
(cond ((eq visibility 't)
(make-screen-visible (car (car iconification-data))))
; (t ;; (eq visibility 'icon)
; (make-screen-visible (car (car iconification-data)))
; (sleep-for 500 t) ; process X events; I really want to XSync() here
; (iconify-screen (car (car iconification-data))))
;; (t nil)
))
(setq iconification-data (cdr iconification-data))))
;;; auto-raise and auto-lower
(defvar auto-raise-screen nil
"*If true, screens will be raised to the top when selected.
Under X, most ICCCM-compliant window managers will have an option to do this
for you, but this variable is provided in case you're using a broken WM.")
(defvar auto-lower-screen nil
"*If true, screens will be lowered to the bottom when no longer selected.
Under X, most ICCCM-compliant window managers will have an option to do this
for you, but this variable is provided in case you're using a broken WM.")
(defun default-select-screen-hook ()
"Implements the `auto-raise-screen' variable.
For use as the value of `select-screen-hook'."
(if auto-raise-screen (raise-screen (selected-screen))))
(defun default-deselect-screen-hook ()
"Implements the `auto-lower-screen' variable.
For use as the value of `deselect-screen-hook'."
(if auto-lower-screen (lower-screen (selected-screen))))
(or select-screen-hook
(add-hook 'select-screen-hook 'default-select-screen-hook))
(or deselect-screen-hook
(add-hook 'deselect-screen-hook 'default-deselect-screen-hook))
;;; Application-specific screen-management
(defvar get-screen-for-buffer-default-screen-name nil
"The default screen to select; see doc of `get-screen-for-buffer'.")
(defun get-screen-name-for-buffer (buffer)
(let ((mode (save-excursion (set-buffer buffer) major-mode)))
(or (get mode 'screen-name)
get-screen-for-buffer-default-screen-name)))
(defun get-screen-for-buffer-noselect (buffer
&optional not-this-window-p on-screen)
"Return a screen in which to display BUFFER.
This is a subroutine of `get-screen-for-buffer' (which see.)"
(let (name)
(cond
((or on-screen (eq (selected-window) (minibuffer-window)))
;; don't switch screens if a screen was specified, or to list
;; completions from the minibuffer, etc.
nil)
((setq name (get-screen-name-for-buffer buffer))
;;
;; This buffer's mode expressed a preference for a screen of a particular
;; name. That always takes priority.
;;
(let ((limit (get name 'instance-limit))
(defaults (get name 'screen-defaults))
(screens (screen-list))
(matching-screens '())
screen already-visible)
;; Sort the list so that iconic screens will be found last. They
;; will be used too, but mapped screens take prescedence. And
;; fully visible screens come before occluded screens.
(setq screens
(sort screens
#'(lambda (s1 s2)
(cond ((screen-totally-visible-p s2)
nil)
((not (screen-visible-p s2))
(screen-visible-p s1))
((not (screen-totally-visible-p s2))
(and (screen-visible-p s1)
(screen-totally-visible-p s1)))))))
;; but the selected screen should come first, even if it's occluded,
;; to minimize thrashing.
(setq screens (cons (selected-screen)
(delq (selected-screen) screens)))
(setq name (symbol-name name))
(while screens
(setq screen (car screens))
(if (equal name (screen-name screen))
(if (get-buffer-window buffer screen)
(setq already-visible screen
screens nil)
(setq matching-screens (cons screen matching-screens))))
(setq screens (cdr screens)))
(cond (already-visible
already-visible)
((or (null matching-screens)
(eq limit 0) ; means create with reckless abandon
(and limit (< (length matching-screens) limit)))
(let* ((sc (funcall screen-creation-function
(cons (cons 'name name)
(append defaults
default-screen-alist))))
(w (screen-root-window sc)))
;;
;; Make the one buffer being displayed in this newly created
;; screen be the buffer of interest, instead of something
;; random, so that it won't be shown in two-window mode.
;; Avoid calling switch-to-buffer here, since that's something
;; people might want to call this routine from.
;;
;; (If the root window doesn't have a buffer, then that means
;; there is more than one window on the screen, which can only
;; happen if the user has done something funny on the screen-
;; creation-hook. If that's the case, leave it alone.)
;;
(if (window-buffer w)
(set-window-buffer w buffer))
sc))
(t
;; do not switch any of the window/buffer associations in an
;; existing screen; this function only picks a screen; the
;; determination of which windows on it get reused is up to
;; display-buffer itself.
;; (or (window-dedicated-p (selected-window))
;; (switch-to-buffer buffer))
(car matching-screens)))))
(t
;;
;; This buffer's mode did not express a preference for a screen of a
;; particular name. So try to find a screen already displaying this
;; buffer.
;;
(let ((w (or (get-buffer-window buffer t) ; check visible first
(get-buffer-window buffer t t)))) ; then iconic
(cond ((null w)
;; It's not in any window - return nil, meaning no screen has
;; preference.
nil)
((and not-this-window-p
(eq (selected-screen) (window-screen w)))
;; It's in a window, but on this screen, and we have been
;; asked to pick another window. Return nil, meaning no
;; screen has preference.
nil)
(t
;; Otherwise, return the screen of the buffer's window.
(window-screen w))))))))
;; The pre-display-buffer-function is called for effect, so this needs to
;; actually select the screen it wants. Fdisplay_buffer() takes notice of
;; changes to the selected screen.
(defun get-screen-for-buffer (buffer &optional not-this-window-p on-screen)
"Select and return a screen in which to display BUFFER.
Normally, the buffer will simply be displayed in the current screen.
But if the symbol naming the major-mode of the buffer has a 'screen-name
property (which should be a symbol), then the buffer will be displayed in
a screen of that name. If there is no screen of that name, then one is
created.
If the major-mode doesn't have a 'screen-name property, then the screen
named by `get-screen-for-buffer-default-screen-name' will be used. If
that is nil (the default) then the currently selected screen will used.
If the screen-name symbol has an 'instance-limit property (an integer)
then each time a buffer of the mode in question is displayed, a new screen
with that name will be created, until there are `instance-limit' of them.
If instance-limit is 0, then a new screen will be created each time.
If a buffer is already displayed in a screen, then `instance-limit' is
ignored, and that screen is used.
If the screen-name symbol has a 'screen-defaults property, then that is
prepended to the `default-screen-alist' when creating a screen for the
first time.
This function may be used as the value of `pre-display-buffer-function',
to cause the display-buffer function and its callers to exhibit the above
behavior."
(let ((old-screens (visible-screen-list))
(screen (get-screen-for-buffer-noselect
buffer not-this-window-p on-screen)))
(if (null screen)
nil
(select-screen screen)
(or (member screen old-screens)
;; If the screen was already visible, just focus on it.
;; If it wasn't visible (it was just created, or it used
;; to be iconified) then uniconify, raise, etc.
(make-screen-visible screen))
screen)))
(defun show-temp-buffer-in-current-screen (buffer)
"For use as the value of temp-buffer-show-function:
always displays the buffer in the current screen, regardless of the behavior
that would otherwise be introduced by the `pre-display-buffer-function', which
is normally set to `get-screen-for-buffer' (which see.)"
(let ((pre-display-buffer-function nil)) ; turn it off, whatever it is
(let ((window (display-buffer buffer)))
(if (not (eq (selected-screen) (window-screen window)))
;; only the pre-display-buffer-function should ever do this.
(error "display-buffer switched screens on its own!!"))
(setq minibuffer-scroll-window window)
(set-window-start window 1) ; obeys narrowing
(set-window-point window 1)
nil)))
(setq pre-display-buffer-function 'get-screen-for-buffer)
(setq temp-buffer-show-function 'show-temp-buffer-in-current-screen)
(provide 'screen)
;;; screen.el ends here