From 1ffece3a395a51200dab005bc63e1eaca22854f2 Mon Sep 17 00:00:00 2001 From: "Richard M. Stallman" Date: Wed, 27 Aug 1997 04:13:52 +0000 Subject: [PATCH] Many changes by Ivar Rummelhoff. --- lisp/winner.el | 556 ++++++++++++++++++++----------------------------- 1 file changed, 231 insertions(+), 325 deletions(-) rewrite lisp/winner.el (72%) diff --git a/lisp/winner.el b/lisp/winner.el dissimilarity index 72% index ff09b3a3fc..ad6ae4399e 100644 --- a/lisp/winner.el +++ b/lisp/winner.el @@ -1,325 +1,231 @@ -;;; winner.el --- Restore window configuration or change buffer - -;; Copyright (C) 1997 Free Software Foundation. Inc. - -;; Author: Ivar Rummelhoff -;; Maintainer: Ivar Rummelhoff -;; Created: 27 Feb 1997 -;; Keywords: extensions,windows - -;; 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: -;; -;; 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. -;; -;; To use Winner mode, put this line in your .emacs file: -;; -;; (add-hook 'after-init-hook (lambda () (winner-mode 1))) - -;; 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 '("^ ") - "Winner excludes buffers with names matching any of these regexps. -They are not included in 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.") - -;;;###autoload -(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) ; ------ " ------ - -;; This works around a bug in defstruct. -(defvar custom-print-functions 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 +;;; winner.el --- Restore window configuration (or switch buffer) + +;; Copyright (C) 1997 Free Software Foundation. Inc. + +;; Author: Ivar Rummelhoff +;; Maintainer: Ivar Rummelhoff +;; Created: 27 Feb 1997 +;; Keywords: extensions, windows + +;; 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: + +;; Winner mode is a global minor mode that when turned on records +;; changes in window configuration. This way the changes can be +;; "undone" using the function `winner-undo'. By default this one is +;; bound to the key sequence ctrl-x left. If you change your mind +;; (while undoing), you can press ctrl-x right (calling +;; `winner-redo'). Unlike the normal undo, you may have to skip +;; through several identical window configurations in order to find +;; the one you want. This is a bug due to some techical limitations +;; in Emacs and can maybe be fixed in the future. +;; +;; In addition to this I have added `winner-switch' which is a program +;; that switches to other buffers without disturbing Winner mode. If +;; you bind this command to a key sequence, you may step through all +;; your buffers (except the ones mentioned in `winner-skip-buffers' or +;; matched by `winner-skip-regexps'). With a numeric prefix argument +;; skip several buffers at a time. + +;;; Code: + +(eval-when-compile (require 'cl)) +(require 'ring) + +(defvar winner-dont-bind-my-keys nil + "If non-nil: Do not use `winner-mode-map' in Winner mode.") + +(defvar winner-ring-size 100 + "Maximum number of stored window configurations per frame.") + +(defvar winner-skip-buffers + '("*Messages*", + "*Compile-Log*", + ".newsrc-dribble", + "*Completions*", + "*Buffer list*") + "Exclude these buffer names from any \(Winner switch\) list of buffers.") + +(defvar winner-skip-regexps '("^ ") + "Winner excludes buffers with names matching any of these regexps. +They are not included in any Winner mode list of buffers. + +By default `winner-skip-regexps' is set to \(\"^ \"\), +which excludes \"invisible buffers\".") + +(defvar winner-ring-alist nil) + +(defsubst winner-ring (frame) + (or (cdr (assq frame winner-ring-alist)) + (progn + (push (cons frame (make-ring winner-ring-size)) + winner-ring-alist) + (cdar winner-ring-alist)))) + +(defvar winner-modified-list nil) + +(defun winner-change-fun () + (pushnew (selected-frame) winner-modified-list)) + +(defun winner-save-new-configurations () + (while winner-modified-list + (ring-insert + (winner-ring (car winner-modified-list)) + (current-window-configuration (pop winner-modified-list))))) + +(defun winner-set (conf) + (set-window-configuration conf) + (if (eq (selected-window) (minibuffer-window)) + (other-window 1))) + + +;;; Winner mode (a minor mode) + +(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-mode nil) ; mode variable +(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 + ;; Turn mode on + (on-p + (setq winner-mode t) + (add-hook 'window-configuration-change-hook 'winner-change-fun) + (add-hook 'post-command-hook 'winner-save-new-configurations) + (setq winner-modified-list (frame-list)) + (winner-save-new-configurations) + (run-hooks 'winner-mode-hook)) + ;; Turn mode off + (winner-mode + (setq winner-mode nil) + (run-hooks 'winner-mode-leave-hook))) + (force-mode-line-update))) + +;; Inspired by undo (simple.el) +(defun winner-undo (arg) + "Switch back to an earlier window configuration saved by Winner mode. +In other words, \"undo\" changes in window configuration." + (interactive "p") + (cond + ((not winner-mode) (error "Winner mode is turned off")) + ((eq (selected-window) (minibuffer-window)) + (error "No winner undo from minibuffer.")) + (t (setq this-command t) + (if (eq last-command 'winner-undo) + ;; This was no new window configuration after all. + (ring-remove winner-pending-undo-ring 0) + (setq winner-pending-undo-ring (winner-ring (selected-frame))) + (setq winner-undo-counter 0)) + (winner-undo-more (or arg 1)) + (message "Winner undo (%d)!" winner-undo-counter) + (setq this-command 'winner-undo)))) + +(defvar winner-pending-undo-ring nil) + +(defvar winner-undo-counter nil) + +(defun winner-undo-more (count) + "Undo N window configuration changes beyond what was already undone. +Call `winner-undo-start' to get ready to undo recent changes, +then call `winner-undo-more' one or more times to undo them." + (let ((len (ring-length winner-pending-undo-ring))) + (incf winner-undo-counter count) + (if (>= winner-undo-counter len) + (error "No further window configuration undo information") + (winner-set + (ring-ref winner-pending-undo-ring + winner-undo-counter))))) + +(defun winner-redo () + "Restore a more recent window configuration saved by Winner mode." + (interactive) + (cond + ((eq last-command 'winner-undo) + (ring-remove winner-pending-undo-ring 0) + (winner-set + (ring-remove winner-pending-undo-ring 0)) + (or (eq (selected-window) (minibuffer-window)) + (message "Winner undid undo!"))) + (t (error "Previous command was not a winner-undo")))) + +;;; Winner switch + +(defun winner-switch-buffer-list () + (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)) + +(defvar winner-switch-list nil) + +(defun winner-switch (count) + "Step through your buffers without disturbing `winner-mode'. +`winner-switch' does not consider buffers mentioned in the list +`winner-skip-buffers' or matched by `winner-skip-regexps'." + (interactive "p") + (decf count) + (setq this-command t) + (cond + ((eq last-command 'winner-switch) + (if winner-mode (ring-remove (winner-ring (selected-frame)) 0)) + (bury-buffer (current-buffer)) + (mapcar 'bury-buffer winner-switch-list)) + (t (setq winner-switch-list (winner-switch-buffer-list)))) + (setq winner-switch-list (nthcdr count winner-switch-list)) + (or winner-switch-list + (setq winner-switch-list (winner-switch-buffer-list)) + (error "No more buffers")) + (switch-to-buffer (pop winner-switch-list)) + (message (concat "Winner: [%s] " + (mapconcat 'identity winner-switch-list " ")) + (buffer-name)) + (setq this-command 'winner-switch)) + +;;;; To be evaluated when the package is loaded: + +(unless winner-mode-map + (setq winner-mode-map (make-sparse-keymap)) + (define-key winner-mode-map [?\C-x left] 'winner-undo) + (define-key winner-mode-map [?\C-x right] 'winner-redo)) + +(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 -- 2.20.1