# HG changeset patch # User Jim Blandy # Date 682291746 0 # Node ID 5bd386d1a1ccda10874863f4d6893c5edce7a42d # Parent 9827fd4d86a0e4cc9a09720e73f1014333a1c75c Initial revision diff -r 9827fd4d86a0 -r 5bd386d1a1cc lisp/frame.el --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/frame.el Thu Aug 15 21:29:06 1991 +0000 @@ -0,0 +1,243 @@ +;;;; Multi-screen management that is independent of window systems. +;;;; Copyright (C) 1990 Free Software Foundation, Inc. + +;;; 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 1, 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. + +(provide 'screen) + +(defvar screen-creation-function nil + "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.") + +;;; The default value for this must ask for a minibuffer. There must +;;; always exist a screen with a minibuffer, and after we delete the +;;; terminal screen, this will be the only screen. +(defvar initial-screen-alist '((minibuffer . nil)) + "Alist of values used when creating the initial emacs text screen. +These may be set in your init file, like this: + (setq initial-screen-alist '((top . 1) (left . 1) (width . 80) (height . 55))) +These supercede the values given in screen-default-alist.") + +(defvar minibuffer-screen-alist nil + "Alist of values to apply to a minibuffer screen. +These may be set in your init file, like this: + (setq minibuffer-screen-alist + '((top . 1) (left . 1) (width . 80) (height . 1))) +These supercede the values given in default-screen-alist.") + +(defvar pop-up-screen-alist nil + "Alist of values used when creating pop-up screens. +Pop-up screens are used for completions, help, and the like. +This variable can be set in your init file, like this: + (setq pop-up-screen-alist '((width . 80) (height . 20))) +These supercede the values given in default-screen-alist.") + +(setq pop-up-screen-function + (function (lambda () + (new-screen pop-up-screen-alist)))) + + +;;;; Arrangement of screens at startup + +;;; 1) Load the window system startup file from the lisp library and read the +;;; high-priority arguments (-q and the like). The window system startup +;;; file should create any screens specified in the window system defaults. +;;; +;;; 2) If no screens have been opened, we open an initial text screen. +;;; +;;; 3) Once the init file is done, we apply any newly set parameters +;;; in initial-screen-alist to the screen. + +(add-hook 'pre-init-hook 'screen-initialize) +(add-hook 'window-setup-hook 'screen-notice-user-settings) + +;;; If we create the initial screen, this is it. +(defvar screen-initial-screen nil) + +;;; startup.el calls this function before loading the user's init +;;; file - if there is no screen with a minibuffer open now, create +;;; one to display messages while loading the init file. +(defun screen-initialize () + + ;; Are we actually running under a window system at all? + (if (and window-system (not noninteractive)) + (let ((screens (screen-list))) + + ;; Look for a screen that has a minibuffer. + (while (and screens + (or (eq (car screens) terminal-screen) + (not (cdr (assq 'minibuffer + (screen-parameters + (car screens))))))) + (setq screens (cdr screens))) + + ;; If there was none, then we need to create the opening screen. + (or screens + (setq global-minibuffer-screen + (setq screen-initial-screen + (new-screen initial-screen-alist)))) + + ;; At this point, we know that we have a screen open, so we + ;; can delete the terminal screen. + (delete-screen terminal-screen) + (setq terminal-screen nil)) + + ;; No, we're not running a window system. Arrange to cause errors. + (setq screen-creation-function + (lambda (parameters) + (error + "Can't create multiple screens without a window system."))))) + +;;; startup.el calls this function after loading the user's init file. +;;; If we created a minibuffer before knowing if we had permission, we +;;; need to see if it should go away or change. Create a text screen +;;; here. +(defun screen-notice-user-settings () + (if screen-initial-screen + (progn + + ;; If the user wants a minibuffer-only screen, we'll have to + ;; make a new one; you can't remove or add a root window to/from + ;; an existing screen. + (if (eq (cdr (or (assq 'minibuffer initial-screen-alist) + '(minibuffer . t))) + 'only) + (progn + (setq global-minibuffer-screen + (new-screen initial-screen-alist)) + (delete-screen screen-initial-screen)) + (modify-screen-parameters screen-initial-screen + initial-screen-alist)))) + + ;; Make sure the initial screen can be GC'd if it is ever deleted. + (makunbound 'screen-initial-screen)) + + +;;;; Creation of additional screens + +;;; Return some screen other than the current screen, +;;; creating one if neccessary. Note that the minibuffer screen, if +;;; separate, is not considered (see next-screen). +(defun get-screen () + (let ((s (if (equal (next-screen (selected-screen)) (selected-screen)) + (new-screen) + (next-screen (selected-screen))))) + s)) + +(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))) + +(defun new-screen (&optional parameters) + "Create a new screen, displaying the current buffer." + (interactive) + (funcall screen-creation-function parameters)) + + +;;;; Iconification + +;;; A possible enhancement for the below: if you iconify a surrogate +;;; minibuffer screen, iconify all of its minibuffer's users too; +;;; de-iconify them as a group. This will need to wait until screens +;;; have mapping and unmapping hooks. + +(defun iconify () + "Iconify or deiconify the selected screen." + (interactive) + (let ((screen (selected-screen))) + (if (eq (screen-visible-p screen) t) + (iconify-screen screen) + (deiconify-screen screen)))) + + +;;;; Convenience functions for dynamically changing screen parameters + +(defun set-screen-height (h) + (interactive "NHeight: ") + (let* ((screen (selected-screen)) + (width (cdr (assoc 'width (screen-parameters (selected-screen)))))) + (set-screen-size (selected-screen) width h))) + +(defun set-screen-width (w) + (interactive "NWidth: ") + (let* ((screen (selected-screen)) + (height (cdr (assoc 'height (screen-parameters (selected-screen)))))) + (set-screen-size (selected-screen) w height))) + +(defun set-default-font (font-name) + (interactive "sFont name: ") + (modify-screen-parameters (selected-screen) + (list (cons 'font font-name)))) + +(defun set-screen-background (color-name) + (interactive "sColor: ") + (modify-screen-parameters (selected-screen) + (list (cons 'background-color color-name)))) + +(defun set-screen-foreground (color-name) + (interactive "sColor: ") + (modify-screen-parameters (selected-screen) + (list (cons 'foreground-color color-name)))) + +(defun set-cursor-color (color-name) + (interactive "sColor: ") + (modify-screen-parameters (selected-screen) + (list (cons 'cursor-color color-name)))) + +(defun set-pointer-color (color-name) + (interactive "sColor: ") + (modify-screen-parameters (selected-screen) + (list (cons 'mouse-color color-name)))) + +(defun set-auto-raise (toggle) + (interactive "xt or nil? ") + (modify-screen-parameters (selected-screen) + (list (cons 'auto-raise toggle)))) + +(defun set-auto-lower (toggle) + (interactive "xt or nil? ") + (modify-screen-parameters (selected-screen) + (list (cons 'auto-lower toggle)))) + +(defun set-vertical-bar (toggle) + (interactive "xt or nil? ") + (modify-screen-parameters (selected-screen) + (list (cons 'vertical-scroll-bar toggle)))) + +(defun set-horizontal-bar (toggle) + (interactive "xt or nil? ") + (modify-screen-parameters (selected-screen) + (list (cons 'horizontal-scroll-bar toggle)))) + +;;;; Key bindings +(define-prefix-command 'ctl-x-3-map) +(define-key ctl-x-map "3" 'ctl-x-3-map) + +(define-key global-map "\C-z" 'iconify) +(define-key ctl-x-3-map "2" 'new-screen) +(define-key ctl-x-3-map "0" 'delete-screen)