mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2024-11-22 07:09:54 +00:00
Initial revision
This commit is contained in:
Richard M. Stallman
parent
815eae1d27
commit
a14fb2b1d2
356
lisp/winner.el
Normal file
356
lisp/winner.el
Normal file
@ -0,0 +1,356 @@
|
||||
;;; winner.el --- Restore window configuration or change buffer
|
||||
|
||||
;; (C) 1997 Ivar Rummelhoff
|
||||
|
||||
;; Author: Ivar Rummelhoff <ivarr@ifi.uio.no>
|
||||
;; Maintainer: Ivar Rummelhoff <ivarr@ifi.uio.no>
|
||||
;; 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
|
||||
Loading…
Reference in New Issue
Block a user