diff options
Diffstat (limited to 'lisp/winring.el')
| -rw-r--r-- | lisp/winring.el | 597 |
1 files changed, 597 insertions, 0 deletions
diff --git a/lisp/winring.el b/lisp/winring.el new file mode 100644 index 0000000..baac31f --- /dev/null +++ b/lisp/winring.el @@ -0,0 +1,597 @@ +;;; 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 |