# HG changeset patch # User Richard M. Stallman # Date 861080600 0 # Node ID 141077afaa74eb5b5cb783df6b101f6e0d199911 # Parent 94face85736e4a2ac268323c1b0a556d62f52a0d Initial revision diff -r 94face85736e -r 141077afaa74 lisp/winner.el --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/winner.el Tue Apr 15 05:03:20 1997 +0000 @@ -0,0 +1,356 @@ +;;; winner.el --- Restore window configuration or change buffer + +;; (C) 1997 Ivar Rummelhoff + +;; Author: Ivar Rummelhoff +;; Maintainer: Ivar Rummelhoff +;; Created: 27 Feb 1997 +;; Version: 1.13 +;; RCS: $Id: winner.el,v 1.13 1997/04/01 11:11:12 ivarr Exp ivarr $ +;; Keywords: extensions,windows +;; Location: http://www.ifi.uio.no/~ivarr/share/elisp/ + +;; This program 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. + +;; This program 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: +;; +;; Winner.el provides a minor mode (`winner-mode') that does +;; essentially two things: +;; +;; 1) It keeps track of changing window configurations, so that +;; when you wish to go back to a previous view, all you have +;; to do is to press C-left a couple of times. +;; +;; 2) It lets you switch to other buffers by pressing C-right. +;; +;; +;; Installation: +;; +;; 1. Put this file in a directory on your (emacs) load-path +;; 2. Byte-compile the file (eg. with M-x byte-compile-file) +;; 3. Put these two lines in your .emacs - file: +;; +;; (autoload 'winner-mode "winner" "Toggle Winner mode." t) +;; (add-hook 'after-init-hook (lambda () (winner-mode 1))) +;; +;; 4. Restart emacs for changes to take effect. +;; +;; (This version of) Winner will only run properly +;; on Emacs-19.35 or newer. +;; + +;; Details: +;; +;; 1. You may of course decide to use other bindings than those +;; mentioned above. Just set these variables in your .emacs: +;; +;; `winner-prev-event' +;; `winner-next-event' +;; +;; 2. When you have found the view of your choice +;; (using your favourite keys), you may press ctrl-space +;; (`winner-max-event') to `delete-other-windows'. +;; +;; 3. Winner now keeps one configuration stack for each frame. +;; +;; +;; +;; Yours sincerely, Ivar Rummelhoff +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;;; Code: + + + +;;;; Variables you may want to change + +(defvar winner-prev-event 'C-left + "Winner mode binds this event to the command `winner-previous'.") + +(defvar winner-next-event 'C-right + "Winner mode binds this event to the command `winner-next'.") + +(defvar winner-max-event 67108896 ; CTRL-space + "Event for deleting other windows +after having selected a view with Winner. + +The normal functions of this event will also be performed. +In the default case (CTRL-SPACE) the mark will be set.") + +(defvar winner-skip-buffers + '("*Messages*", + "*Compile-Log*", + ".newsrc-dribble", + "*Completions*", + "*Buffer list*") + "Exclude these buffer names +from any \(Winner mode\) list of buffers.") + +(defvar winner-skip-regexps '("^ ") + "Exclude buffers with names matching any of these regexps. +..from any \(Winner mode\) list of buffers. + +By default `winner-skip-regexps' is set to \(\"^ \"\), +which excludes \"invisible buffers\".") + + +(defvar winner-limit 50 + "Winner will save no more than 2 * `winner-limit' window configurations. +\(.. and no less than `winner-limit'.\)") + +(defvar winner-mode-hook nil + "Functions to run whenever Winner mode is turned on.") + +(defvar winner-mode-leave-hook nil + "Functions to run whenever Winner mode is turned off.") + +(defvar winner-dont-bind-my-keys nil + "If non-nil: Do not use `winner-mode-map' in Winner mode.") + + + +;;;; Winner mode + +(eval-when-compile (require 'cl)) + + +(defvar winner-mode nil) ; For the modeline. +(defvar winner-mode-map nil "Keymap for Winner mode.") +(defun winner-mode (&optional arg) + "Toggle Winner mode. +With arg, turn Winner mode on if and only if arg is positive." + (interactive "P") + (let ((on-p (if arg (> (prefix-numeric-value arg) 0) + (not winner-mode)))) + (cond + (on-p (let ((winner-frames-changed (frame-list))) + (winner-do-save)) ; Save current configurations + (add-hook 'window-configuration-change-hook 'winner-save-configuration) + (setq winner-mode t) + (run-hooks 'winner-mode-hook)) + (t (remove-hook 'window-configuration-change-hook 'winner-save-configuration) + (when winner-mode + (setq winner-mode nil) + (run-hooks 'winner-mode-leave-hook)))) + (force-mode-line-update))) + + +;; List of frames which have changed +(defvar winner-frames-changed nil) + +;; Time to save the window configuration. +(defun winner-save-configuration () + (push (selected-frame) winner-frames-changed) + (add-hook 'post-command-hook 'winner-do-save)) + + +(defun winner-do-save () + (let ((current (selected-frame))) + (unwind-protect + (do ((frames winner-frames-changed (cdr frames))) + ((null frames)) + (unless (memq (car frames) (cdr frames)) + ;; Process each frame once. + (select-frame (car frames)) + (winner-push (current-window-configuration) (car frames)))) + (setq winner-frames-changed nil) + (select-frame current) + (remove-hook 'post-command-hook 'winner-do-save)))) + + + + + +;;;; Configuration stacks (one for each frame) + + +(defvar winner-stacks nil) ; ------ " ------ + + +;; A stack of window configurations with some additional information. +(defstruct (winner-stack + (:constructor winner-stack-new + (config &aux + (data (list config)) + (place data)))) + data place (count 1)) + + +;; Return the stack of this frame +(defun winner-stack (frame) + (let ((stack (cdr (assq frame winner-stacks)))) + (if stack (winner-stack-data stack) + ;; Else make new stack + (letf (((selected-frame) frame)) + (let ((config (current-window-configuration))) + (push (cons frame (winner-stack-new config)) + winner-stacks) + (list config)))))) + + + + +;; Push this window configuration on the right stack, +;; but make sure the stack doesn't get too large etc... +(defun winner-push (config frame) + (let ((this (cdr (assq frame winner-stacks)))) + (if (not this) (push (cons frame (winner-stack-new config)) + winner-stacks) + (push config (winner-stack-data this)) + (when (> (incf (winner-stack-count this)) winner-limit) + ;; No more than 2*winner-limit configs + (setcdr (winner-stack-place this) nil) + (setf (winner-stack-place this) + (winner-stack-data this)) + (setf (winner-stack-count this) 1))))) + + + + + + + + +;;;; Selecting a window configuration + + +;; Return list of names of other buffers, excluding the current buffer +;; and buffers specified by the user. +(defun winner-other-buffers () + (loop for buf in (buffer-list) + for name = (buffer-name buf) + unless (or (eq (current-buffer) buf) + (member name winner-skip-buffers) + (loop for regexp in winner-skip-regexps + if (string-match regexp name) return t + finally return nil)) + collect name)) + + + +(defun winner-select (&optional arg) + + "Change to previous or new window configuration. +With arg start at position 1 if arg is positive, and +at -1 if arg is negative; else start at position 0. +\(For Winner to record changes in window configurations, +Winner mode must be turned on.\)" + (interactive "P") + + (setq arg + (cond + ((not arg) nil) + ((> (prefix-numeric-value arg) 0) winner-next-event) + ((< (prefix-numeric-value arg) 0) winner-prev-event) + (t nil))) + (if arg (push arg unread-command-events)) + + (let ((stack (winner-stack (selected-frame))) + (store nil) + (buffers (winner-other-buffers)) + (passed nil) + (config (current-window-configuration)) + (pos 0) event) + ;; `stack' and `store' are stacks of window configuration while + ;; `buffers' and `passed' are stacks of buffer names. + + (condition-case nil + + (loop + (setq event (read-event)) + (cond + + ((eq event winner-prev-event) + (cond (passed (push (pop passed) buffers)(decf pos)) + ((cdr stack)(push (pop stack) store) (decf pos)) + (t (setq stack (append (nreverse store) stack)) + (setq store nil) + (setq pos 0)))) + + ((eq event winner-next-event) + (cond (store (push (pop store) stack) (incf pos)) + (buffers (push (pop buffers) passed) (incf pos)) + (t (setq buffers (nreverse passed)) + (setq passed nil) + (setq pos 0)))) + + ((eq event winner-max-event) + ;; Delete other windows and leave. + (delete-other-windows) + ;; Let this change be saved. + (setq pos -1) + ;; Perform other actions of this event. + (push event unread-command-events) + (return)) + (t (push event unread-command-events) (return))) + + (cond + ;; Display + (passed (set-window-buffer (selected-window) (car passed)) + (message (concat "Winner\(%d\): [%s] " + (mapconcat 'identity buffers " ")) + pos (car passed))) + + (t (set-window-configuration (car stack)) + (if (window-minibuffer-p (selected-window)) + (other-window 1)) + (message "Winner\(%d\)" pos)))) + + (quit (set-window-configuration config) + (setq pos 0))) + (if (zerop pos) + ;; Do not record these changes. + (remove-hook 'post-command-hook 'winner-do-save) + ;; Else update the buffer list and make sure that the displayed + ;; buffer is the same as the current buffer. + (switch-to-buffer (window-buffer))))) + + + + + +(defun winner-previous () + "Change to previous window configuration." + (interactive) + (winner-select -1)) + +(defun winner-next () + "Change to new window configuration." + (interactive) + (winner-select 1)) + + + + +;;;; To be evaluated when the package is loaded: + +(unless winner-mode-map + (setq winner-mode-map (make-sparse-keymap)) + (define-key winner-mode-map (vector winner-prev-event) 'winner-previous) + (define-key winner-mode-map (vector winner-next-event) 'winner-next)) + +(unless (or (assq 'winner-mode minor-mode-map-alist) + winner-dont-bind-my-keys) + (push (cons 'winner-mode winner-mode-map) + minor-mode-map-alist)) + +(unless (assq 'winner-mode minor-mode-alist) + (push '(winner-mode " Win") minor-mode-alist)) + +(provide 'winner) + +;;; Winner.el ends here