cgit.sxemacs.org Git - packages/blob - xemacs-packages/escreen/escreen.el

   1 ;;; escreen.el --- emacs window session manager
   2
   3 ;;; Copyright (C) 1992, 94, 95, 97, 2001 Noah S. Friedman
   4
   5 ;;; Author: Noah Friedman <friedman@splode.com>
   6 ;;; Maintainer: friedman@splode.com
   7 ;;; Keywords: extensions
   8 ;;; Created: 1992-03-23
   9
  10 ;;; $Id: escreen.el,v 1.1.1.1 2004-03-15 16:25:50 viteno Exp $
  11
  12 ;; This program is free software; you can redistribute it and/or modify
  13 ;; it under the terms of the GNU General Public License as published by
  14 ;; the Free Software Foundation; either version 2, or (at your option)
  15 ;; any later version.
  16 ;;
  17 ;; This program is distributed in the hope that it will be useful,
  18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  20 ;; GNU General Public License for more details.
  21 ;;
  22 ;; You should have received a copy of the GNU General Public License
  23 ;; along with this program; if not, you can either send email to this
  24 ;; program's maintainer or write to: The Free Software Foundation,
  25 ;; Inc.; 59 Temple Place, Suite 330; Boston, MA 02111-1307, USA.
  26
  27 ;;; Commentary:
  28
  29 ;; To install, put this file in your load-path, byte-compile it, and add
  30 ;; the following to your .emacs:
  31 ;;
  32 ;;   (load "escreen")
  33 ;;   (escreen-install)
  34
  35 ;; If you are using Emacs 18 or Emacs 19, you may have trouble loading this
  36 ;; program because of the customs syntax officially introduced in Emacs 20.
  37 ;; In that case, first load cust-stub.el, available from
  38 ;;
  39 ;;     http://www.splode.com/~friedman/software/emacs-lisp/
  40 ;;
  41 ;; Updates to escreen.el will also be made available on that page.
  42
  43 ;; Inspired by:
  44 ;;   * wicos.el, written by Heikki Suopanki <suopanki@phoenix.oulu.fi>
  45 ;;   * `screen', written by Oliver Laumann, Juergen Weigert,
  46 ;;     and Michael Schroeder.
  47
  48 ;; Todo:
  49 ;;   * per-frame screen configurations
  50 ;;   * symbolic names for screens (a la wicos.el)
  51 ;;   * switching active screen from pull-down menu from menubar
  52 ;;   * switching active screen from escreen menu
  53 ;;   * persistance of screens across instances of emacs
  54 ;;     (this may be impossible to do sanely.)
  55
  56 ;;; Code:
  57
  58 ;; Variable declarations -- can be set by user
  59
  60 (defgroup escreen nil
  61   "Window configuration management"
  62   :group 'escreen
  63   :group 'extensions)
  64
  65 (defcustom escreen-max-screens 10
  66   "*Maximum number of screens that may be created."
  67   :type 'integer
  68   :group 'escreen)
  69
  70 (defcustom escreen-new-screen-default-buffer "*scratch*"
  71   "*Default buffer to display in newly-created screens."
  72   :type 'string
  73   :group 'escreen)
  74
  75 (defcustom escreen-restore-killed-buffers nil
  76   "*If non-nil, automatically revisit files if they have been killed.
  77 That is, if a buffer was killed while in another screen session,
  78 recreate them, visiting whatever file they were visiting."
  79   :type 'boolean
  80   :group 'escreen)
  81
  82 (defcustom escreen-preserve-buffer-list-order t
  83   "*If non-nil, preserve buffer list for each screen when switching.
  84 When returning to a previously-saved screen, the buffer list order is
  85 restored.  Buffers which have been created since the saved screen was last
  86 visited, are put at the end of the list but the relative order is preserved.
  87
  88 This buffer list order is returned by the function `buffer-list' and
  89 affects the behavior of `other-buffer', etc.
  90
  91 In Emacs 20 and later, each frame has its own ordered buffer list.
  92 Switching screen sessions affects the selected frame's buffer list only."
  93   :type 'boolean
  94   :group 'escreen)
  95
  96 (defcustom escreen-number-mode t
  97   "*If non-nil, display current escreen number in mode line."
  98   :type 'boolean
  99   :group 'escreen)
 100
 101 (defcustom escreen-install-number-mode-format t
 102   "*If non-nil, install `escreen-mode-line-format' on `global-mode-string'.
 103 This is performed by `escreen-install'."
 104   :type 'boolean
 105   :group 'escreen)
 106
 107 (defcustom escreen-goto-screen-hook nil
 108   "*Hook to run after `escreen-goto-screen' completes.
 109 An example function that can make use of this hook is
 110 `escreen-enable-number-mode-if-more-than-one-screen'."
 111   :type 'hook
 112   :group 'escreen)
 113
 114 (defcustom escreen-menu-mode-hook nil
 115   "*Hook to run by `escreen-menu' after everything else."
 116   :type 'hook
 117   :group 'escreen)
 118
 119 \f
 120 ;; Keybindings
 121
 122 (defcustom escreen-prefix-char "\C-\\"
 123   "*Character prefixing escreen commands.
 124 If you wish to change this, you must also do
 125
 126    (global-set-key escreen-prefix-char 'escreen-prefix)
 127
 128 to update the prefix in the global keymap."
 129   :type 'string
 130   :group 'escreen)
 131
 132 (defvar escreen-map nil
 133   "*Keymap for escreen commands.")
 134 (cond
 135  ((null escreen-map)
 136   (setq escreen-map (make-sparse-keymap))
 137   (define-key escreen-map escreen-prefix-char 'escreen-goto-last-screen)
 138   (define-key escreen-map "0"    'escreen-goto-screen-0)
 139   (define-key escreen-map "1"    'escreen-goto-screen-1)
 140   (define-key escreen-map "2"    'escreen-goto-screen-2)
 141   (define-key escreen-map "3"    'escreen-goto-screen-3)
 142   (define-key escreen-map "4"    'escreen-goto-screen-4)
 143   (define-key escreen-map "5"    'escreen-goto-screen-5)
 144   (define-key escreen-map "6"    'escreen-goto-screen-6)
 145   (define-key escreen-map "7"    'escreen-goto-screen-7)
 146   (define-key escreen-map "8"    'escreen-goto-screen-8)
 147   (define-key escreen-map "9"    'escreen-goto-screen-9)
 148   (define-key escreen-map "?"    'escreen-help)
 149   (define-key escreen-map "\C-b" 'escreen-menu)
 150   (define-key escreen-map "a"    'escreen-get-active-screen-numbers)
 151   (define-key escreen-map "b"    'escreen-get-current-screen-number)
 152   (define-key escreen-map "c"    'escreen-create-screen)
 153   (define-key escreen-map "g"    'escreen-goto-screen)
 154   (define-key escreen-map "k"    'escreen-kill-screen)
 155   (define-key escreen-map "n"    'escreen-goto-next-screen)
 156   (define-key escreen-map "p"    'escreen-goto-prev-screen)))
 157
 158 (defalias 'escreen-prefix escreen-map)
 159
 160 \f
 161 ;;; Internal variables.  Do not set these yourself.
 162
 163 ;; This should not be modified by the user.  The information it provides is
 164 ;; critical and the calling conventions are different than for
 165 ;; escreen-map-data-format.  The order here is important too.
 166 ;; Do not change this data structure without also changing the
 167 ;; escreen-configuration-data-map-critical-* accessors.
 168 (defvar escreen-map-critical-data-format
 169   (list 'current-buffer
 170         (function (lambda () (buffer-name)))
 171         'buffer-file-name))
 172
 173 ;; If you want to add or change this list, it's best to set
 174 ;; escreen-configuration-alist to nil and run escreen-install afterward.
 175 ;; Otherwise, the new table will be used with old data and may cause errors.
 176 ;;
 177 ;; Note that resetting escreen in this way loses all but the current
 178 ;; window configuration.
 179 (defvar escreen-map-data-format
 180   '((escreen-map-save-window-start    . escreen-map-restore-window-start)
 181     (mark-marker                      . escreen-map-restore-mark-marker)
 182     (escreen-map-save-point           . escreen-map-restore-point)
 183     (escreen-map-save-narrowed-region . escreen-map-restore-narrowed-region)
 184     (escreen-map-save-truncate-lines  . escreen-map-restore-truncate-lines)
 185     (escreen-map-save-mode-line-face  . escreen-map-restore-mode-line-face)
 186     (escreen-map-save-menu-bar-mode   . escreen-map-restore-menu-bar-mode)
 187     (buffer-list                      . escreen-map-restore-buffer-list)))
 188
 189 ;; Keeps track of escreen state (window config, buffers, etc.)
 190 ;; The structure of each elt is
 191 ;;
 192 ;;  (screen-number #<window-configuration>
 193 ;;                 (((critical-data-buffer-1) user-data-buffer-1 ...)
 194 ;;                  ((critical-data-buffer-2) user-data-buffer-2 ...)
 195 ;;                  ...)
 196 ;;                 selected-window-number)
 197 ;;
 198 (defvar escreen-configuration-alist nil)
 199
 200 ;; Current screen number.  Smallest possible screen number is 0.
 201 (defvar escreen-current-screen-number 0)
 202
 203 ;; Current screen number as a string.
 204 ;; Smallest possible screen number is 0.
 205 (defvar escreen-current-screen-string
 206   (int-to-string escreen-current-screen-number))
 207
 208 ;; Last-visited screen number.  Smallest possible screen number is 0.
 209 (defvar escreen-last-screen-number 0)
 210
 211 ;; Highest screen number currently in use.
 212 (defvar escreen-highest-screen-number-used 0)
 213
 214 ;; It's ok to change this, but it makes use of internal variables
 215 (defvar escreen-mode-line-format
 216   '(escreen-number-mode ("S" escreen-current-screen-string " ")))
 217
 218 \f
 219 ;;;###autoload
 220 (defun escreen-install ()
 221   (interactive)
 222   (global-set-key escreen-prefix-char 'escreen-prefix)
 223
 224   ;; Install screen number on global-mode-string
 225   (and escreen-install-number-mode-format
 226        (let ((elt '("" escreen-mode-line-format)))
 227          (or (escreen-member elt global-mode-string)
 228              (setq global-mode-string
 229                    (cons elt global-mode-string)))))
 230
 231   (if escreen-number-mode
 232       (escreen-number-mode 1))
 233
 234   ;; Initialize escreen-configuration-alist by placing current window
 235   ;; config in it.
 236   (escreen-save-current-screen-configuration))
 237
 238 (defun escreen-number-mode (&optional prefix)
 239   "*Toggle escreen-number-mode (see variable docstring).
 240 If called with a positive prefix argument, always enable.
 241 If called with a negative prefix argument, always disable.
 242 If called with no prefix argument, toggle current state."
 243   (interactive "P")
 244   (setq escreen-number-mode
 245         (cond ((null prefix)
 246                (not escreen-number-mode))
 247               (t
 248                (>= (prefix-numeric-value prefix) 0)))))
 249
 250 \f
 251 (defun escreen-create-screen ()
 252   "Create a new screen and switch to it.
 253 New screen will display one window with the buffer specified by
 254 `escreen-new-screen-default-buffer'."
 255   (interactive)
 256   (let ((new-screen-number (escreen-first-unused-screen-number)))
 257     (or new-screen-number
 258         (error "escreen: No more screens (see \"escreen-max-screens\")"))
 259     ;; Save window configuration before switching to a new one.
 260     (escreen-save-current-screen-configuration)
 261     (and (> new-screen-number escreen-highest-screen-number-used)
 262          (setq escreen-highest-screen-number-used new-screen-number))
 263     (setq escreen-last-screen-number escreen-current-screen-number)
 264     (setq escreen-current-screen-number new-screen-number)
 265     (setq escreen-current-screen-string (int-to-string new-screen-number))
 266     (delete-other-windows)
 267     (switch-to-buffer escreen-new-screen-default-buffer)
 268     ;; Save new window configuration so that it's in the alist.
 269     (escreen-save-current-screen-configuration))
 270   ;; We run this hook because, in a sense, we have gone to a new
 271   ;; screen. but we don't actually call escreen-goto-screen because of the
 272   ;; extra setup work here.
 273   (run-hooks 'escreen-goto-screen-hook))
 274
 275 (defun escreen-kill-screen (&optional number)
 276   "Kill current screen, or screen given by optional argument NUMBER.
 277 No error occurs if the specified screen number doesn't exist.
 278 You cannot kill the last existing screen.
 279 Switch to previous screen if killing active one."
 280   (interactive)
 281   (let* ((screen-number (or number escreen-current-screen-number))
 282          (killing-current-screen-p (eq escreen-current-screen-number
 283                                        screen-number))
 284          (screen-data (escreen-configuration-escreen screen-number))
 285          previous-screen)
 286     (cond (screen-data
 287            (and killing-current-screen-p
 288                 (escreen-configuration-one-screen-p)
 289                 (error "escreen: only one screen, can't kill."))
 290            ;; Don't bother looking for previous screen number unless killing
 291            ;; current screen, because only then do we need to switch screens.
 292            (and killing-current-screen-p
 293                 (setq previous-screen (escreen-get-prev-screen-number)))
 294            (escreen-configuration-escreen-delete screen-data)
 295            (and (eq screen-number escreen-highest-screen-number-used)
 296                 ;; We're killing the screen with the highest number.
 297                 ;; Look for the next highest number.
 298                 (setq escreen-highest-screen-number-used
 299                       (car (sort (escreen-configuration-screen-numbers) '>))))
 300            (and killing-current-screen-p
 301                 (escreen-goto-screen previous-screen 'dont-update-current))))))
 302
 303 \f
 304 (defun escreen-goto-screen (number &optional dont-update-current)
 305   "Switch to screen number N.
 306 Optional arg DONT-UPDATE-CURRENT means don't save the current screen
 307 configuration, though this isn't intended to be used interactively."
 308   (interactive "NGo to escreen number: ")
 309   (let ((screen-data (escreen-configuration-escreen number)))
 310     (or screen-data
 311         (error "escreen: %d: invalid screen number." number))
 312     (or dont-update-current
 313         (escreen-save-current-screen-configuration))
 314     (escreen-restore-screen-map screen-data)
 315     (setq escreen-current-screen-string (int-to-string number))
 316     (or dont-update-current
 317         (setq escreen-last-screen-number escreen-current-screen-number))
 318     (setq escreen-current-screen-number number))
 319   (run-hooks 'escreen-goto-screen-hook))
 320
 321 (defun escreen-goto-last-screen ()
 322   "Switch to the last visited screen."
 323   (interactive)
 324   (let ((n (if (= escreen-last-screen-number escreen-current-screen-number)
 325                (escreen-get-next-screen-number escreen-last-screen-number)
 326              escreen-last-screen-number)))
 327     (setq escreen-last-screen-number escreen-current-screen-number)
 328     (escreen-goto-screen n)))
 329
 330 (defun escreen-goto-prev-screen (&optional n)
 331   "Switch to the previous screen.
 332 This is the nearest lower-numbered existing screen from the current one,
 333 wrapping around list of screens if necessary.
 334 If prefix arg N given, jump to the Nth previous screen."
 335   (interactive "p")
 336   (if (< n 0)
 337       (escreen-goto-prev-or-next-screen-internal (- n) 'next)
 338     (escreen-goto-prev-or-next-screen-internal n 'prev)))
 339
 340 (defun escreen-goto-next-screen (&optional n)
 341   "Switch to the next screen.
 342 This is the nearest greater-numbered existing screen from the current one,
 343 wrapping around list of screens if necessary.
 344 If prefix arg N given, jump to the Nth next screen."
 345   (interactive "p")
 346   (if (< n 0)
 347       (escreen-goto-prev-or-next-screen-internal (- n) 'prev)
 348     (escreen-goto-prev-or-next-screen-internal n 'next)))
 349
 350 (defun escreen-goto-prev-or-next-screen-internal (n prev-or-next)
 351   (let ((total (length (escreen-get-active-screen-numbers)))
 352         (func (if (eq prev-or-next 'next)
 353                   'escreen-get-next-screen-number
 354                 'escreen-get-prev-screen-number))
 355         (i 0)
 356         (screen-number escreen-current-screen-number))
 357     (and (> n total)
 358          ;; Trim off excess amount so we do fewer iterations, since
 359          ;; wrapping over the total number of screens even once is
 360          ;; wasteful and slow.
 361          (setq n (- n (* (/ n total) total))))
 362     (while (< i n)
 363       (setq screen-number (funcall func screen-number)
 364             i (1+ i)))
 365     (escreen-goto-screen screen-number)))
 366
 367 (defun escreen-goto-screen-0 () (interactive) (escreen-goto-screen 0))
 368 (defun escreen-goto-screen-1 () (interactive) (escreen-goto-screen 1))
 369 (defun escreen-goto-screen-2 () (interactive) (escreen-goto-screen 2))
 370 (defun escreen-goto-screen-3 () (interactive) (escreen-goto-screen 3))
 371 (defun escreen-goto-screen-4 () (interactive) (escreen-goto-screen 4))
 372 (defun escreen-goto-screen-5 () (interactive) (escreen-goto-screen 5))
 373 (defun escreen-goto-screen-6 () (interactive) (escreen-goto-screen 6))
 374 (defun escreen-goto-screen-7 () (interactive) (escreen-goto-screen 7))
 375 (defun escreen-goto-screen-8 () (interactive) (escreen-goto-screen 8))
 376 (defun escreen-goto-screen-9 () (interactive) (escreen-goto-screen 9))
 377
 378 \f
 379 (defun escreen-get-current-screen-number ()
 380   "Returns the currently selected screen number.
 381 If called interactively, also print this result in the minibuffer."
 382   (interactive)
 383   (if (interactive-p)
 384       (message "escreen: current screen is number %d"
 385                escreen-current-screen-number)
 386     escreen-current-screen-number))
 387
 388 (defun escreen-get-active-screen-numbers ()
 389   "Print a list of the active screen numbers in the echo area.
 390 Returns a list of numbers which represent screen numbers presently in use."
 391   (interactive)
 392   (let ((screen-list (sort (escreen-configuration-screen-numbers) '<))
 393         (str "escreen: active screens:"))
 394     (and (interactive-p)
 395          (progn
 396            (mapcar (function (lambda (num)
 397                                (setq str (format "%s %d" str num))))
 398                    screen-list)
 399            (message str)))
 400     screen-list))
 401
 402 (defun escreen-help ()
 403   "Display a short summary of escreen commands."
 404   (interactive)
 405   (if (string-lessp emacs-version "19")
 406       ;; emacs 18 couldn't list only bindings with a common prefix.
 407       (describe-bindings)
 408     ;; Emacs 19 can handle escreen-prefix-char (as a string) directly, but
 409     ;; for XEmacs, it must be converted to a vector.
 410     (describe-bindings (escreen-string-to-vector escreen-prefix-char))))
 411
 412 (defun escreen-string-to-vector (s)
 413   (let* ((l (length s))
 414          (v (make-vector l nil))
 415          (i 0))
 416     (while (< i l)
 417       (aset v i (aref s i))
 418       (setq i (1+ i)))
 419     v))
 420
 421 \f
 422 ;; Return the first unused number available for designation as a screen
 423 ;; number, or nil if  escreen-max-screens  screens are already in use.
 424 (defun escreen-first-unused-screen-number ()
 425   (let ((number 0))
 426     (while (and (< number escreen-max-screens)
 427                 (escreen-configuration-escreen number))
 428       (setq number (1+ number)))
 429     (and (< number escreen-max-screens) number)))
 430
 431 ;; Save window configuration, buffer configuration, and current marks and
 432 ;; point for each displayed buffer for the current screen.
 433 (defun escreen-save-current-screen-configuration ()
 434   (let ((screen-data (escreen-screen-defined))
 435         (new-alist-member nil))
 436     (if screen-data
 437         (setcdr screen-data (escreen-save-screen-map))
 438       (setq new-alist-member (cons escreen-current-screen-number
 439                                    (escreen-save-screen-map)))
 440       (setq escreen-configuration-alist
 441             (cons new-alist-member escreen-configuration-alist)))))
 442
 443 ;; Return attributes for screen N, or nil if it doesn't exist.
 444 (defun escreen-screen-defined (&optional n)
 445   (escreen-configuration-escreen (or n escreen-current-screen-number)))
 446
 447 ;; Return nearest number less than current screen number that is
 448 ;; an active screen, wrapping around end of screen list if necessary.
 449 (defun escreen-get-prev-screen-number (&optional current-screen-number)
 450   (or current-screen-number
 451       (setq current-screen-number escreen-current-screen-number))
 452   (if (eq 0 escreen-highest-screen-number-used)
 453       0
 454     ;; Decrement/wrap current screen number
 455     (setq current-screen-number (1- current-screen-number))
 456     (and (< current-screen-number 0)
 457          (setq current-screen-number escreen-highest-screen-number-used))
 458     (while (not (assq current-screen-number escreen-configuration-alist))
 459       ;; Decrement/wrap current screen number
 460       (setq current-screen-number (1- current-screen-number))
 461       (and (< current-screen-number 0)
 462            (setq current-screen-number escreen-highest-screen-number-used)))
 463     current-screen-number))
 464
 465 ;; Return nearest number greater than current screen number that is
 466 ;; an active screen, wrapping around end of screen list if necessary.
 467 (defun escreen-get-next-screen-number (&optional current-screen-number)
 468   (or current-screen-number
 469       (setq current-screen-number escreen-current-screen-number))
 470   (if (eq 0 escreen-highest-screen-number-used)
 471       0
 472     ;; Increment/wrap current screen number
 473     (setq current-screen-number (1+ current-screen-number))
 474     (and (> current-screen-number escreen-highest-screen-number-used)
 475          (setq current-screen-number 0))
 476     (while (not (assq current-screen-number escreen-configuration-alist))
 477       ;; Increment/wrap current screen number
 478       (setq current-screen-number (1+ current-screen-number))
 479       (and (> current-screen-number escreen-highest-screen-number-used)
 480            (setq current-screen-number 0)))
 481     current-screen-number))
 482
 483 \f
 484 ;;; Primitive accessors for escreen-configuration-alist
 485
 486 (defun escreen-configuration-escreen (number)
 487   (assq number escreen-configuration-alist))
 488
 489 (defun escreen-configuration-escreen-delete (data)
 490   (setq escreen-configuration-alist
 491         (delq (if (numberp data)
 492                   (escreen-configuration-escreen data)
 493                 data)
 494               escreen-configuration-alist)))
 495
 496 (defun escreen-configuration-screen-numbers ()
 497   (mapcar 'car escreen-configuration-alist))
 498
 499 (defun escreen-configuration-one-screen-p ()
 500   (>= 1 (length escreen-configuration-alist)))
 501
 502 ;; Sort the alist so that they are in order numerically.
 503 (defun escreen-configuration-alist-sort-by-number ()
 504   (setq escreen-configuration-alist
 505         (sort escreen-configuration-alist
 506               (function (lambda (a b)
 507                           (< (car a) (car b)))))))
 508
 509 ;;; map-data sub-accessors
 510
 511 (defun escreen-configuration-screen-number (l)
 512   (nth 0 l))
 513
 514 (defun escreen-configuration-window-data-configuration (l)
 515   (nth 1 l))
 516
 517 (defun escreen-configuration-data-map (l)
 518   (nth 2 l))
 519
 520 (defun escreen-configuration-selected-window-count (l)
 521   (nth 3 l))
 522
 523 ;;; screen map data accessors
 524
 525 (defun escreen-configuration-data-map-critical (data)
 526   (car data))
 527
 528 (defun escreen-configuration-data-map-user (data)
 529   (cdr data))
 530
 531 ;;; critical map data accessors
 532
 533 (defun escreen-configuration-data-map-critical-buffer (crit-map)
 534   (nth 0 crit-map))
 535
 536 (defun escreen-configuration-data-map-critical-buffer-name (crit-map)
 537   (nth 1 crit-map))
 538
 539 (defun escreen-configuration-data-map-critical-buffer-file-name (crit-map)
 540   (nth 2 crit-map))
 541
 542 \f
 543 (defun escreen-save-screen-map ()
 544   (let ((config (current-window-configuration))
 545         (win-data nil)
 546         (sel-win-count 0)
 547         (sel-window (selected-window))
 548         (first-window (escreen-first-window))
 549         (window nil))
 550     (save-excursion
 551       (save-window-excursion
 552         (select-window first-window)
 553         (while (not (eq window first-window))
 554           (cond ((null sel-window))
 555                 ((eq (selected-window) sel-window)
 556                  (setq sel-window nil))
 557                 (t
 558                  (setq sel-win-count (1+ sel-win-count))))
 559           (setq win-data
 560                 (cons (cons (escreen-save-critical-data)
 561                             (escreen-save-user-data))
 562                       win-data))
 563           (setq window (select-window (next-window)))
 564           (set-buffer (window-buffer (selected-window))))))
 565     (list config (nreverse win-data) sel-win-count)))
 566
 567 (defun escreen-restore-screen-map (map)
 568   (let ((config (escreen-configuration-window-data-configuration map))
 569         (map (escreen-configuration-data-map map))
 570         (sel-win-number (escreen-configuration-selected-window-count map))
 571         (win-count 0)
 572         (sel-win nil))
 573     (set-window-configuration config)
 574     (select-window (escreen-first-window))
 575     (while map
 576       (and (= win-count sel-win-number)
 577            (setq sel-win (selected-window)))
 578       (setq win-count (1+ win-count))
 579
 580       (escreen-restore-critical-data
 581         (escreen-configuration-data-map-critical (car map)))
 582       (widen)
 583       (escreen-restore-user-data
 584         (escreen-configuration-data-map-user (car map)))
 585       (select-window (next-window))
 586       (setq map (cdr map)))
 587     (select-window (or sel-win (escreen-first-window)))))
 588
 589 (defun escreen-save-critical-data ()
 590   (mapcar 'funcall escreen-map-critical-data-format))
 591
 592 (defun escreen-restore-critical-data (data)
 593   (let ((buffer (escreen-configuration-data-map-critical-buffer data))
 594         (buffer-name
 595          (escreen-configuration-data-map-critical-buffer-name data))
 596         (buf-file-name
 597          (escreen-configuration-data-map-critical-buffer-file-name data)))
 598     (cond ((escreen-killed-buffer-p buffer)
 599            (cond ((null escreen-restore-killed-buffers)
 600                   (set-window-buffer (selected-window)
 601                                      (get-buffer-create
 602                                       escreen-new-screen-default-buffer)))
 603                  ((stringp buf-file-name)
 604                   (setq buffer (find-file-noselect buf-file-name))
 605                   (set-window-buffer (selected-window) buffer)
 606                   (or (get-buffer buffer-name)
 607                       (rename-buffer buffer-name)))
 608                  (t
 609                   (set-window-buffer (selected-window)
 610                                      (get-buffer-create
 611                                       escreen-new-screen-default-buffer)))))
 612           (t
 613            (set-window-buffer (selected-window) buffer)))))
 614
 615 (defun escreen-save-user-data ()
 616   (mapcar (function (lambda (pair) (funcall (car pair))))
 617           escreen-map-data-format))
 618
 619 (defun escreen-restore-user-data (data)
 620   (let ((funlist escreen-map-data-format))
 621     (while (and data funlist)
 622       (funcall (cdr (car funlist)) (car data))
 623       (setq funlist (cdr funlist))
 624       (setq data (cdr data)))))
 625
 626 \f
 627 ;; Functions used to save and restore screen configuration state.
 628 ;; These are mapped over via presence in escreen-map-data-format.
 629
 630 (defun escreen-map-save-window-start ()
 631   (escreen-make-marker (window-start)))
 632
 633 (defun escreen-map-restore-window-start (p)
 634   (and (escreen-position-valid-p p)
 635        (set-window-start (selected-window) p t)))
 636
 637 (defun escreen-map-restore-mark-marker (mark)
 638   (cond ((escreen-position-valid-p mark)
 639          (set-marker (or (mark-marker)
 640                          ;; when XEmacs zmacs-regions are set, mark-marker
 641                          ;; can return nil unless optional arg forcep is
 642                          ;; non-nil.
 643                          ;; In Emacs transient-mark-mode, mark-marker will
 644                          ;; still return a marker, so no magic needed.
 645                          (mark-marker t))
 646                      (marker-position mark)
 647                      (marker-buffer mark)))))
 648
 649 (defun escreen-map-save-point ()
 650   ;; If there is a process mark in the current buffer and point is at it,
 651   ;; then return the process mark also.  That way, when we return to this
 652   ;; screen, point will be at the end of the process output even if that
 653   ;; has advanced since then.  Otherwise, just use a before-insertion
 654   ;; marker (if supported).
 655   (let* ((point-mark (escreen-make-marker (point-marker) nil t))
 656          (proc (get-buffer-process (current-buffer)))
 657          (proc-mark (and proc (process-mark proc))))
 658     (if (and (escreen-position-valid-p proc-mark)
 659              (= proc-mark (point)))
 660         (cons proc-mark point-mark)
 661       point-mark)))
 662
 663 (defun escreen-map-restore-point (pos)
 664   (cond ((consp pos)
 665          (cond ((escreen-position-valid-p (car pos))
 666                 (goto-char (car pos)))
 667                ((escreen-position-valid-p (cdr pos))
 668                 (goto-char (cdr pos)))))
 669         (t
 670          (and (escreen-position-valid-p pos)
 671               (goto-char pos)))))
 672
 673 (defun escreen-map-save-narrowed-region ()
 674   (cons (and (> (point-min) 1)
 675              (escreen-make-marker (point-min)))
 676         (and (<= (point-max) (buffer-size))
 677              (escreen-make-marker (point-max) nil t))))
 678
 679 (defun escreen-map-restore-narrowed-region (reg)
 680   (let ((size (1+ (buffer-size)))
 681         (beg (or (car reg) (point-min)))
 682         (end (or (cdr reg) (point-max))))
 683     (and (escreen-position-valid-p beg)
 684          (escreen-position-valid-p end)
 685          (<= beg size)
 686          (<= end size)
 687          (narrow-to-region beg end))))
 688
 689 (defun escreen-map-save-truncate-lines ()
 690   truncate-lines)
 691
 692 (defun escreen-map-restore-truncate-lines (v)
 693   (setq truncate-lines v))
 694
 695 (defun escreen-map-save-mode-line-face ()
 696   (cond ((fboundp 'face-reverse-p)
 697          ;; XEmacs mode line face properties
 698          (list (face-reverse-p 'modeline)
 699                (face-background 'modeline)
 700                (face-foreground 'modeline)))
 701         ((boundp 'mode-line-inverse-video)
 702          mode-line-inverse-video)))
 703
 704 (defun escreen-map-restore-mode-line-face (v)
 705   (cond ((fboundp 'face-reverse-p)
 706          (set-face-reverse-p 'modeline (nth 0 v))
 707          (set-face-background 'modeline (nth 1 v))
 708          (set-face-foreground 'modeline (nth 2 v)))
 709         ((boundp 'mode-line-inverse-video)
 710          (setq mode-line-inverse-video v))))
 711
 712 ;; Emacs 19.30 and beyond supports menu bars on ascii terminals, but beware
 713 ;; of turning them off or on once escreen is loaded; if a stored window
 714 ;; configuration was for a frame with a menu bar, but there is no menu bar
 715 ;; presently, that will crash emacs.  This fatal bug is present in all
 716 ;; versions of Emacs prior to 21.0.
 717 (defun escreen-map-save-menu-bar-mode ()
 718   (and (boundp 'menu-bar-mode)
 719        menu-bar-mode))
 720
 721 (defun escreen-map-restore-menu-bar-mode (v)
 722   (cond ((fboundp 'menu-bar-mode)
 723          (if v
 724              (menu-bar-mode 1)
 725            (menu-bar-mode -1)))))
 726
 727 (defun escreen-map-restore-buffer-list (olist)
 728   (and escreen-preserve-buffer-list-order
 729        (escreen-set-buffer-list-order olist)))
 730
 731 \f
 732 (defun escreen-killed-buffer-p (buffer)
 733   (not (if (fboundp 'buffer-live-p)
 734            (buffer-live-p buffer)
 735          ;; Emacs 18 doesn't have buffer-live-p.
 736          ;; Killed buffers have no names.
 737          (buffer-name buffer))))
 738
 739 (defun escreen-position-valid-p (pos)
 740   (cond ((numberp pos)
 741          (<= pos (1+ (buffer-size))))
 742         ((markerp pos)
 743          (and (eq (marker-buffer pos) (current-buffer))
 744               (numberp (marker-position pos))
 745               (<= pos (1+ (buffer-size)))))
 746         (t nil)))
 747
 748 (defun escreen-set-buffer-list-order (olist)
 749   (let (firstbuf buf)
 750     (while olist
 751       (setq buf (car olist))
 752       (and (stringp buf)
 753            (setq buf (get-buffer buf)))
 754       (cond ((escreen-killed-buffer-p buf))
 755             (t
 756              (bury-buffer buf)
 757              (or firstbuf
 758                  (setq firstbuf buf))))
 759       (setq olist (cdr olist)))
 760     (setq olist (buffer-list))
 761     (while (not (eq (car olist) firstbuf))
 762       (bury-buffer (car olist))
 763       (setq olist (cdr olist)))))
 764
 765 ;; Copy existing marker, or make a new one from point.
 766 ;; Emacs 19.30 and later can create markers which are advanced if text is
 767 ;; inserted before them, without needing to call insert-before-markers
 768 ;; explicitly.  This is useful for storing point, mark, etc. since the
 769 ;; buffer may be edited while we are in other escreens.
 770 (defun escreen-make-marker (pos &optional buffer insertion-type)
 771   (let ((new-marker nil))
 772     (cond ((markerp pos)
 773            (setq new-marker (copy-marker pos))
 774            (and buffer
 775                 (set-marker new-marker (marker-position pos) buffer)))
 776           (t
 777            (setq new-marker (make-marker))
 778            (set-marker new-marker pos buffer)))
 779     (and (fboundp 'set-marker-insertion-type)
 780          (set-marker-insertion-type new-marker insertion-type))
 781     new-marker))
 782
 783 (defun escreen-first-window ()
 784   (cond ((fboundp 'frame-highest-window)
 785          (funcall 'frame-highest-window))
 786         ((fboundp 'frame-first-window)
 787          (funcall 'frame-first-window))
 788         ((one-window-p)
 789          (selected-window))
 790         (t
 791          (let ((win (selected-window)))
 792            (while (not (escreen-first-window-p win))
 793              (setq win (next-window win)))
 794            win))))
 795
 796 (defun escreen-first-window-p (win)
 797   (let ((edges (escreen-window-edges win)))
 798     (and (= (nth 0 edges) 0)
 799          (= (nth 1 edges) 0))))
 800
 801 \f
 802 (defun escreen-menu ()
 803   (interactive)
 804   (escreen-configuration-alist-sort-by-number)
 805   (let ((escreen-menu-buffer (get-buffer-create "*Escreen List*"))
 806         alist data-map screen-number)
 807     ;; Display buffer now so update of screen cofiguration will be correct.
 808     (display-buffer escreen-menu-buffer)
 809     ;; Update escreen-configuration-alist to contain up-to-date information
 810     ;; on current screen, since we'll be displaying data about it.
 811     (escreen-save-current-screen-configuration)
 812     (setq alist escreen-configuration-alist)
 813     (save-excursion
 814       (set-buffer escreen-menu-buffer)
 815       (setq buffer-read-only nil)
 816       (erase-buffer)
 817       (insert " Screen Buffers\n ------ -------\n")
 818       (while alist
 819         (setq screen-data (car alist))
 820         (setq alist (cdr alist))
 821
 822         (setq screen-number (escreen-configuration-screen-number screen-data))
 823         (setq data-map (escreen-configuration-data-map screen-data))
 824
 825         (if (= screen-number escreen-current-screen-number)
 826             (insert (format "*%-6d " screen-number))
 827           (insert (format " %-6d " screen-number)))
 828         (while data-map
 829           (insert (if (> (current-column) 0) "" "        ")
 830                   (escreen-configuration-data-map-critical-buffer-name
 831                    (escreen-configuration-data-map-critical (car data-map)))
 832                   "\n")
 833           (setq data-map (cdr data-map)))
 834         (insert "\n"))
 835       (escreen-menu-mode))))
 836
 837 (defun escreen-menu-mode ()
 838   (fundamental-mode)
 839   (kill-all-local-variables)
 840   (setq buffer-undo-list t)
 841   (setq truncate-lines t)
 842   (setq buffer-read-only t)
 843   (setq major-mode 'escreen-menu-mode)
 844   (setq mode-name "Escreen Menu")
 845   (run-hooks 'escreen-menu-mode-hook))
 846
 847 \f
 848 ;; Install this by doing
 849 ;;
 850 ;;    (add-hook 'escreen-goto-screen-hook
 851 ;;              'escreen-enable-number-mode-if-more-than-one-screen)
 852 ;;
 853 ;; By doing so, escreen-number-mode is disabled whenever only a single
 854 ;; escreen is in use.  The only reason for doing this, however, is to save
 855 ;; valuable mode line real estate.
 856 (defun escreen-enable-number-mode-if-more-than-one-screen ()
 857   (if (> (length (escreen-get-active-screen-numbers)) 1)
 858       (escreen-number-mode 1)
 859     (escreen-number-mode -1))
 860   (escreen-force-mode-line-update t))
 861
 862
 863 ;;; Compatiblity tweaks for Emacs 19, 18, and XEmacs.
 864
 865 (defun escreen-window-edges (&rest args)
 866   (apply (if (fboundp 'window-edges)
 867              'window-edges
 868            ;; For XEmacs 19.13 and later.
 869            'window-pixel-edges)
 870          args))
 871
 872 (defun escreen-force-mode-line-update (&optional allp)
 873   (if (fboundp 'force-mode-line-update)
 874       (force-mode-line-update allp)
 875     ;; Emacs 18 doesn't have force-mode-line-update
 876     (and all (save-excursion (set-buffer (other-buffer))))
 877     (set-buffer-modified-p (buffer-modified-p))))
 878
 879 ;; Some versions of emacs 18 did not have `member'.
 880 (defun escreen-member (x y)
 881   (if (fboundp 'member)
 882       (member x y)
 883     (while (and y (not (equal x (car y))))
 884       (setq y (cdr y)))
 885     y))
 886
 887 (provide 'escreen)
 888
 889 ;;; escreen.el ends here