;;; winring.el --- Window configuration rings
;; Copyright (C) 1998 Free Software Foundation, Inc.
;; Author: 1997-1998 Barry A. Warsaw
;; Maintainer: bwarsaw@python.org
;; Created: March 1997
;; Keywords: frames tools
(defconst winring-version "3.5"
"winring version number.")
;; 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, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
;;; Commentary:
;;
;; This package provides lightweight support for circular rings of
;; window configurations. A window configuration is the layout of
;; windows and associated buffers within a frame. There is always at
;; least one configuration on the ring, the current configuration.
;; You can create new configurations and cycle through the layouts in
;; either direction. You can also delete configurations from the ring
;; (except the last one of course!). Window configurations are named,
;; and you can jump to and delete named configurations. Display of
;; the current window configuration name in the mode line is only
;; supported as of Emacs 20.3 and XEmacs 21.0.
;;
;; Window configuration rings are frame specific. That is, each frame
;; has its own ring which can be cycled through independently of other
;; frames. This is the way I like it.
;;
;; You are always looking at the current window configuration for each
;; frame, which consists of the windows in the frame, the buffers in
;; those windows, and point in the current buffer. As you run
;; commands such as "C-x 4 b", "C-x 2", and "C-x 0" you are modifying
;; the current window configuration. When you jump to a new
;; configuration, the layout that existed before the jump is captured,
;; and the ring is rotated to the selected configuration. Window
;; configurations are captured with `current-window-configuration',
;; however winring also saves point for the current buffer.
;; To use, make sure this file is on your `load-path' and put the
;; following in your .emacs file:
;;
;; (require 'winring)
;; (winring-initialize)
;;
;; Note that by default, this binds the winring keymap to the C-x 7
;; prefix, but you can change this by setting the value of
;; `winring-keymap-prefix', before you call `winring-initialize'.
;; Note that this is a change from previous versions of winring; the
;; prefix used to be M-o but was changed on the suggestion of RMS.
;; The following commands are defined:
;;
;; C-x 7 n -- Create a new window configuration. The new
;; configuration will contain a single buffer, the one
;; named in the variable `winring-new-config-buffer-name'
;;
;; With C-u, winring prompts for the name of the new
;; configuration. If you don't use C-u the function in
;; `winring-name-generator' will be called to get the
;; new configuration's name.
;;
;; C-x 7 2 -- Create a duplicate of the current window
;; configuration. C-u has the same semantics as with
;; "C-x 7 c".
;;
;; C-x 7 j -- Jump to a named configuration (prompts for the name).
;;
;; C-x 7 0 -- Kill the current window configuration and rotate to the
;; previous layout on the ring. You cannot delete the
;; last configuration in the ring. With C-u, prompts
;; for the name of the configuration to kill.
;;
;; C-x 7 o -- Go to the next configuration on the ring.
;;
;; C-x 7 p -- Go to the previous configuration on the ring.
;;
;; Note that the sequence `C-x 7 o C-x 7 p' is a no-op;
;; it leaves you in the same configuration you were in
;; before the sequence.
;;
;; C-x 7 r -- Rename the current window configuration.
;;
;; C-x 7 b -- Submit a bug report on winring.
;;
;; C-x 7 v -- Echo the winring version.
;; As mentioned, window configuration names can be displayed in the
;; modeline, but this feature only works with Emacs 20.3 and XEmacs
;; 21.0. A patch for XEmacs 20.4 to support this feature is available
;; at the URL below. Note that the default value of
;; `winring-show-names' is currently nil by default because if your
;; X/Emacs doesn't have the necessary support, ugly things can happen
;; (no you won't crash your X/Emacs -- it just won't do what you
;; want).
;;
;; If your X/Emacs has the necessary support, you can turn on display
;; of window configuration names by setting `winring-show-names' to
;; t. If you don't like the position in the modeline where winring
;; names are shown, you can change this by passing in your own
;; modeline hacker function to `winring-initialize'.
;;; Winring on the Web:
;;
;; The winring Web page (including the aforementioned XEmacs 20.4
;; patch) is
;;
;; http://www.python.org/emacs/winring/
;;; History:
;;
;; A long long time ago there was a package called `wicos' written by
;; Heikki Suopanki, which was based on yet another earlier package
;; called `screens' also written by Suopanki. This in turn was based
;; on the Unix tty session manager `screen' (unrelated to Emacs) by
;; Oliver Laumann, Juergen Weigert, and Michael Schroeder.
;;
;; Wicos essentially provided fancy handling for window
;; configurations. I liked the basic ideas, but wicos broke with
;; later versions of Emacs and XEmacs. I re-implemented just the
;; functionality I wanted, simplifying things in the process, and
;; porting the code to run with XEmacs 19 and 20, and Emacs 20 (I
;; don't know if winring works in Emacs 19.34).
;;
;; Wicos used the M-o prefix which I've recently changed to C-x 7 as
;; the default, by suggestion of RMS. Wicos also had some support for
;; multiple frames, and saving configurations on all visible frames,
;; but it didn't work too well, and I like frame independent rings
;; better.
;;
;; I know of a few other related packages:
;;
;; - `escreen' by Noah Friedman. A much more ambitious package
;; that does Emacs window session management. Very cool, but I
;; wanted something more lightweight.
;;
;; - `wconfig' by Bob Weiner as part of Hyperbole. I think wconfig
;; is similar in spirit to winring; it seems to have also have
;; named window configurations, but not frame-specific window
;; rings.
;;
;; - `winner' by Ivar Rummelhoff. This package comes with Emacs
;; 20, and appears to differ from winring by providing undo/redo
;; semantics to window configuration changes. winner is a minor
;; mode and does seem to support frame-specific window rings.
;;
;; - `window-xemacs' by the XEmacs Development Team. It appears
;; that this package, which is specific to XEmacs (and perhaps
;; just XEmacs 20) implements stacks of window configurations
;; which are frame independent.
;; Please feel free to email me if my rendition of history, or my
;; explanation of the related packages, is inaccurate.
;;; Code:
(require 'ring)
(defgroup winring nil
"Window configuration rings"
:prefix "winring-"
:group 'frames)
(defcustom winring-ring-size 7
"*Size of the window configuration ring."
:type 'integer
:group 'winring)
(defcustom winring-prompt-on-create 'usually
"*When true, prompt for new configuration name on creation.
If not t and not nil, prompt for configuration name on creation,
except when creating the initial configuration on a new frame."
:type '(radio
(const :tag "Never prompt for configuration name" nil)
(const :tag "Always prompt for configuration name" t)
(const :tag "Prompt for all but initial configuration name"
usually)
)
:group 'winring)
(defcustom winring-new-config-buffer-name "*scratch*"
"*Name of the buffer to switch to when a new configuration is created."
:type 'string
:group 'winring)
(defcustom winring-show-names nil
"*If non-nil, window configuration names are shown in the modeline.
If nil, the name is echoed in the minibuffer when switching window
configurations."
:type 'boolean
:group 'winring)
(defcustom winring-name-generator 'winring-next-name
"*Function that generates new automatic window configuration names.
When a new window configuration is created with `winring-new-configuration',
and the user did not specify an explicit name, this function is called with
no arguments to get the new name. It must return a string."
:type 'function
:group 'winring)
;; Not yet customized
(defvar winring-keymap-prefix "\C-x7"
"*Prefix key that the `winring-map' is placed on in the global keymap.
If you change this, you must do it before calling `winring-initialize'.")
;; Set up keymap
(defvar winring-map nil
"Keymap used for winring, window configuration rings.")
(if winring-map
nil
(setq winring-map (make-sparse-keymap))
(define-key winring-map "b" 'winring-submit-bug-report)
(define-key winring-map "n" 'winring-new-configuration)
(define-key winring-map "2" 'winring-duplicate-configuration)
(define-key winring-map "j" 'winring-jump-to-configuration)
(define-key winring-map "0" 'winring-delete-configuration)
(define-key winring-map "o" 'winring-next-configuration)
(define-key winring-map "p" 'winring-prev-configuration)
(define-key winring-map "r" 'winring-rename-configuration)
(define-key winring-map "v" 'winring-version)
)
;; Winring names
(defvar winring-name nil
"The name of the currently displayed window configuration.")
(defvar winring-name-index 1
"Index used as a sequence number for new unnamed window configurations.")
(defvar winring-name-history nil
"History variable for window configuration name prompts.")
(defun winring-next-name ()
(let ((name (format "%03d" winring-name-index)))
(setq winring-name-index (1+ winring-name-index))
name))
;; Compatibility
(defun winring-set-frame-ring (frame ring)
(cond
;; XEmacs
((fboundp 'set-frame-property)
(set-frame-property frame 'winring-ring ring))
;; Emacs
((fboundp 'modify-frame-parameters)
(modify-frame-parameters frame (list (cons 'winring-ring ring))))
;; Not supported
(t (error "This version of Emacs is not supported by winring"))))
(defun winring-get-frame-ring (frame)
(cond
;; XEmacs
((fboundp 'frame-property)
(frame-property frame 'winring-ring))
;; Emacs 20
((fboundp 'frame-parameter)
(frame-parameter frame 'winring-ring))
;; Emacs 19.34
((fboundp 'frame-parameters)
(cdr (assq 'winring-ring (frame-parameters frame))))
;; Unsupported
(t (error "This version of Emacs is not supported by winring"))))
(defun winring-create-frame-hook (frame)
;; generate the name, but specify the newly created frame
(winring-set-name (and (eq winring-prompt-on-create t)
(read-string "Initial window configuration name? "
nil 'winring-name-history))
frame))
;; Utilities
(defun winring-set-name (&optional name frame)
"Set the window configuration name.
Optional NAME is the name to use; if not given, then
`winring-name-generator' is `funcall'd with no arguments to get the
generated name. Optional FRAME is the frame to set the name for; if
not given then the currently selected frame is used."
(let ((name (or name (funcall winring-name-generator)))
(frame (or frame (selected-frame))))
(if (fboundp 'add-spec-to-specifier)
;; The XEmacs way. Only supported in hacked 20.4 or 21.0
(add-spec-to-specifier winring-name name frame)
;; the Emacs way. Only supported in Emacs 20.3
(setq winring-name name)
(modify-frame-parameters frame (list (cons 'winring-name name)))
))
(if (not winring-show-names)
(message "Switching to window configuration: %s" name)))
(defun winring-get-ring ()
(let* ((frame (selected-frame))
(ring (winring-get-frame-ring frame)))
(when (not ring)
(setq ring (make-ring winring-ring-size))
(winring-set-frame-ring frame ring))
ring))
(defsubst winring-name-of (config)
(car config))
(defsubst winring-conf-of (config)
(car (cdr config)))
(defsubst winring-point-of (config)
(nth 2 config))
(defsubst winring-name-of-current ()
(if (fboundp 'specifier-instance)
;; In XEmacs, this variable holds a specifier which
;; must be instanced to get the current
;; configuration name.
(specifier-instance winring-name)
;; In Emacs, just use the variable's string value
;; directly, since the `displayed' value is kept as a
;; frame parameter
winring-name))
(defun winring-save-current-configuration (&optional at-front)
(let* ((ring (winring-get-ring))
(name (winring-name-of-current))
(here (point))
(conf (list name (current-window-configuration) here)))
(if at-front
(ring-insert-at-beginning ring conf)
(ring-insert ring conf))))
(defun winring-restore-configuration (item)
(let ((conf (winring-conf-of item))
(name (winring-name-of item))
(here (winring-point-of item)))
(set-window-configuration conf)
;; current-window-configuration does not save point in current
;; window. That sucks!
(goto-char here)
(winring-set-name name))
(force-mode-line-update))
(defun winring-complete-name ()
(let* ((ring (winring-get-ring))
(n (1- (ring-length ring)))
(current (winring-name-of-current))
(table (list (cons current -1)))
name)
;; populate the completion table
(while (<= 0 n)
(setq table (cons (cons (winring-name-of (ring-ref ring n)) n) table)
n (1- n)))
(setq name (completing-read
(format "Window configuration name (%s): " current)
table nil 'must nil 'winring-name-history))
(if (string-equal name "")
(setq name current))
(cdr (assoc name table))))
(defun winring-read-name (prompt)
(let* ((ring (winring-get-ring))
(n (1- (ring-length ring)))
(table (list (winring-name-of-current)))
name)
;; get the list of all the names in the ring
(while (<= 0 n)
(setq table (cons (winring-name-of (ring-ref ring n)) table)
n (1- n)))
(setq name (read-string prompt nil 'winring-name-history))
(if (member name table)
(error "Window configuration name already in use: %s" name))
name))
;; Commands
;;;###autoload
(defun winring-new-configuration (&optional arg)
"Save the current window configuration and create an empty new one.
The buffer shown in the new empty configuration is defined by
`winring-new-config-buffer-name'.
With \\[universal-argument] prompt for the new configuration's name.
Otherwise, the function in `winring-name-generator' will be called to
get the new configuration's name."
(interactive "P")
(let ((name (and (or arg winring-prompt-on-create)
(winring-read-name "New window configuration name? "))))
;; Empty string is not allowed
(if (string-equal name "")
(setq name (funcall winring-name-generator)))
(winring-save-current-configuration)
(delete-other-windows)
(switch-to-buffer winring-new-config-buffer-name)
(winring-set-name name)))
;;;###autoload
(defun winring-duplicate-configuration (&optional arg)
"Push the current window configuration on the ring, and duplicate it.
With \\[universal-argument] prompt for the new configuration's name.
Otherwise, the function in `winring-name-generator' will be called to
get the new configuration's name."
(interactive "P")
(let ((name (and (or arg winring-prompt-on-create)
(winring-read-name "New window configuration name? "))))
;; Empty string is not allowed
(if (string-equal name "")
(setq name (funcall winring-name-generator)))
(winring-save-current-configuration)
(winring-set-name name)))
;;;###autoload
(defun winring-next-configuration ()
"Switch to the next window configuration for this frame."
(interactive)
(let ((next (ring-remove (winring-get-ring))))
(winring-save-current-configuration)
(winring-restore-configuration next)))
;;;###autoload
(defun winring-prev-configuration ()
"Switch to the previous window configuration for this frame."
(interactive)
(let ((prev (ring-remove (winring-get-ring) 0)))
(winring-save-current-configuration 'at-front)
(winring-restore-configuration prev)))
;;;###autoload
(defun winring-jump-to-configuration ()
"Go to the named window configuration."
(interactive)
(let* ((ring (winring-get-ring))
(index (winring-complete-name))
item)
;; if the current configuration was chosen, winring-complete-name
;; returns -1
(when (<= 0 index)
(setq item (ring-remove ring index))
(winring-save-current-configuration)
(winring-restore-configuration item))
))
;;;###autoload
(defun winring-delete-configuration (&optional arg)
"Delete the current configuration and switch to the next one.
With \\[universal-argument] prompt for named configuration to delete."
(interactive "P")
(let ((ring (winring-get-ring))
index)
(if (or (not arg)
(> 0 (setq index (winring-complete-name))))
;; remove the current one, so install the next one
(winring-restore-configuration (ring-remove ring))
;; otherwise, remove the named one but don't change the current config
(ring-remove ring index)
)))
;;;###autoload
(defun winring-rename-configuration (name)
"Rename the current configuration to NAME."
(interactive "sNew window configuration name? ")
(winring-set-name name))
(defconst winring-help-address "bwarsaw@python.org"
"Address accepting bug report submissions.")
(defun winring-version ()
"Echo the current version of winring in the minibuffer."
(interactive)
(message "Using winring version %s" winring-version)
;;(setq zmacs-region-stays t)
)
(defun winring-submit-bug-report (comment-p)
"Submit via mail a bug report on winring.
With \\[universal-argument] just send any type of comment."
(interactive
(list (not (y-or-n-p
"Is this a bug report? (hit `n' to send other comments) "))))
(let ((reporter-prompt-for-summary-p (if comment-p
"(Very) brief summary: "
t)))
(require 'reporter)
(reporter-submit-bug-report
winring-help-address ;address
(concat "winring " winring-version) ;pkgname
;; varlist
(if comment-p nil
'(winring-ring-size
winring-new-config-buffer-name
winring-show-names
winring-name-generator
winring-keymap-prefix))
nil ;pre-hooks
nil ;post-hooks
"Dear Barry,") ;salutation
(if comment-p nil
(set-mark (point))
(insert
"Please replace this text with a description of your problem.\n\
The more accurately and succinctly you can describe the\n\
problem you are encountering, the more likely I can fix it\n\
in a timely way.\n\n")
(exchange-point-and-mark)
;;(setq zmacs-region-stays t)
)))
;; Initialization. This is completely different b/w Emacs and XEmacs.
;; The Emacs 20.3 way is to create a frame-local variable (this is a
;; new feature with Emacs 20.3), and save the config name as a frame
;; property.
;;
;; In XEmacs 21.0 (a.k.a. 20.5), you create a generic specifier, and
;; save the config name as an instantiator over the current frame
;; locale.
;; Be sure to do this only once
(defvar winring-initialized nil)
(defun winring-initialize (&optional hack-modeline-function)
(unless winring-initialized
;;
;; Create the variable that holds the window configuration name
;;
(cond
;; The Emacs 20.3 way: frame-local variables
((fboundp 'make-variable-frame-local)
(make-variable-frame-local 'winring-name))
;; The XEmacs 21 way: specifiers
((fboundp 'make-specifier)
(setq winring-name (make-specifier 'generic)))
;; Not supported in older X/Emacsen
(t nil))
;;
;; Glom the configuration name into the mode-line. I've
;; experimented with a couple of different locations, including
;; for Emacs 20.3 mode-line-frame-identification, and for XEmacs,
;; just splicing it before the modeline-buffer-identification.
;; Sticking it on the very left side of the modeline, even before
;; mode-line-modified seems like the most useful and
;; cross-compatible place.
;;
;; Note that you can override the default hacking of the modeline
;; by passing in your own `hack-modeline-function'.
;;
(if hack-modeline-function
(funcall hack-modeline-function)
;; Else, default insertion hackery
(let ((format (list 'winring-show-names
'("<" winring-name "> ")))
(splice (cdr mode-line-format)))
(setcar splice (list format (car splice)))))
;;
;; We need to add a hook so that all newly created frames get
;; initialized properly. Again, different for Emacs and XEmacs.
;;
(if (boundp 'create-frame-hook)
;; XEmacs
(add-hook 'create-frame-hook 'winring-create-frame-hook)
;; better be Emacs!
(add-hook 'after-make-frame-functions 'winring-create-frame-hook))
;;
;; Now set the initial configuration name on the initial frame...
(winring-create-frame-hook (selected-frame))
;; ...the keymap...
(global-set-key winring-keymap-prefix winring-map)
;; ...and the init fence
(setq winring-initialized t)))
(provide 'winring)
;;; winring.el ends here
