Commit | Line | Data |
---|---|---|
a14fb2b1 RS |
1 | ;;; winner.el --- Restore window configuration or change buffer |
2 | ||
21f3d1d3 | 3 | ;; Copyright (C) 1997 Free Software Foundation. Inc. |
a14fb2b1 RS |
4 | |
5 | ;; Author: Ivar Rummelhoff <ivarr@ifi.uio.no> | |
6 | ;; Maintainer: Ivar Rummelhoff <ivarr@ifi.uio.no> | |
7 | ;; Created: 27 Feb 1997 | |
a14fb2b1 | 8 | ;; Keywords: extensions,windows |
a14fb2b1 | 9 | |
21f3d1d3 RS |
10 | ;; This file is part of GNU Emacs. |
11 | ||
12 | ;; GNU Emacs is free software; you can redistribute it and/or modify | |
a14fb2b1 RS |
13 | ;; it under the terms of the GNU General Public License as published by |
14 | ;; the Free Software Foundation; either version 2, or (at your option) | |
15 | ;; any later version. | |
16 | ||
21f3d1d3 | 17 | ;; GNU Emacs is distributed in the hope that it will be useful, |
a14fb2b1 RS |
18 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
19 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
20 | ;; GNU General Public License for more details. | |
21 | ||
22 | ;; You should have received a copy of the GNU General Public License | |
23 | ;; along with GNU Emacs; see the file COPYING. If not, write to the | |
24 | ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
25 | ;; Boston, MA 02111-1307, USA. | |
26 | ||
27 | ;;; Commentary: | |
28 | ;; | |
21f3d1d3 | 29 | ;; winner.el provides a minor mode (`winner-mode') that does |
a14fb2b1 RS |
30 | ;; essentially two things: |
31 | ;; | |
32 | ;; 1) It keeps track of changing window configurations, so that | |
33 | ;; when you wish to go back to a previous view, all you have | |
34 | ;; to do is to press C-left a couple of times. | |
35 | ;; | |
36 | ;; 2) It lets you switch to other buffers by pressing C-right. | |
37 | ;; | |
21f3d1d3 | 38 | ;; To use Winner mode, put this line in your .emacs file: |
a14fb2b1 | 39 | ;; |
a14fb2b1 | 40 | ;; (add-hook 'after-init-hook (lambda () (winner-mode 1))) |
a14fb2b1 RS |
41 | \f |
42 | ;; Details: | |
43 | ;; | |
44 | ;; 1. You may of course decide to use other bindings than those | |
45 | ;; mentioned above. Just set these variables in your .emacs: | |
46 | ;; | |
47 | ;; `winner-prev-event' | |
48 | ;; `winner-next-event' | |
49 | ;; | |
50 | ;; 2. When you have found the view of your choice | |
51 | ;; (using your favourite keys), you may press ctrl-space | |
52 | ;; (`winner-max-event') to `delete-other-windows'. | |
53 | ;; | |
54 | ;; 3. Winner now keeps one configuration stack for each frame. | |
55 | ;; | |
56 | ;; | |
57 | ;; | |
58 | ;; Yours sincerely, Ivar Rummelhoff | |
59 | ;; | |
60 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
61 | ||
62 | ;;; Code: | |
63 | ||
64 | ||
65 | ||
66 | ;;;; Variables you may want to change | |
67 | ||
68 | (defvar winner-prev-event 'C-left | |
69 | "Winner mode binds this event to the command `winner-previous'.") | |
70 | ||
71 | (defvar winner-next-event 'C-right | |
72 | "Winner mode binds this event to the command `winner-next'.") | |
73 | ||
74 | (defvar winner-max-event 67108896 ; CTRL-space | |
75 | "Event for deleting other windows | |
76 | after having selected a view with Winner. | |
77 | ||
78 | The normal functions of this event will also be performed. | |
79 | In the default case (CTRL-SPACE) the mark will be set.") | |
80 | ||
81 | (defvar winner-skip-buffers | |
82 | '("*Messages*", | |
83 | "*Compile-Log*", | |
84 | ".newsrc-dribble", | |
85 | "*Completions*", | |
86 | "*Buffer list*") | |
79fd9b2f | 87 | "Exclude these buffer names from any \(Winner mode\) list of buffers.") |
a14fb2b1 RS |
88 | |
89 | (defvar winner-skip-regexps '("^ ") | |
79fd9b2f RS |
90 | "Winner excludes buffers with names matching any of these regexps. |
91 | They are not included in any Winner mode list of buffers. | |
a14fb2b1 RS |
92 | |
93 | By default `winner-skip-regexps' is set to \(\"^ \"\), | |
94 | which excludes \"invisible buffers\".") | |
95 | ||
96 | \f | |
97 | (defvar winner-limit 50 | |
98 | "Winner will save no more than 2 * `winner-limit' window configurations. | |
99 | \(.. and no less than `winner-limit'.\)") | |
100 | ||
101 | (defvar winner-mode-hook nil | |
102 | "Functions to run whenever Winner mode is turned on.") | |
103 | ||
104 | (defvar winner-mode-leave-hook nil | |
105 | "Functions to run whenever Winner mode is turned off.") | |
106 | ||
107 | (defvar winner-dont-bind-my-keys nil | |
108 | "If non-nil: Do not use `winner-mode-map' in Winner mode.") | |
109 | ||
110 | ||
111 | ||
112 | ;;;; Winner mode | |
113 | ||
114 | (eval-when-compile (require 'cl)) | |
115 | ||
116 | ||
117 | (defvar winner-mode nil) ; For the modeline. | |
118 | (defvar winner-mode-map nil "Keymap for Winner mode.") | |
21f3d1d3 RS |
119 | |
120 | ;;;###autoload | |
a14fb2b1 RS |
121 | (defun winner-mode (&optional arg) |
122 | "Toggle Winner mode. | |
123 | With arg, turn Winner mode on if and only if arg is positive." | |
124 | (interactive "P") | |
125 | (let ((on-p (if arg (> (prefix-numeric-value arg) 0) | |
126 | (not winner-mode)))) | |
127 | (cond | |
128 | (on-p (let ((winner-frames-changed (frame-list))) | |
129 | (winner-do-save)) ; Save current configurations | |
130 | (add-hook 'window-configuration-change-hook 'winner-save-configuration) | |
131 | (setq winner-mode t) | |
132 | (run-hooks 'winner-mode-hook)) | |
133 | (t (remove-hook 'window-configuration-change-hook 'winner-save-configuration) | |
134 | (when winner-mode | |
135 | (setq winner-mode nil) | |
136 | (run-hooks 'winner-mode-leave-hook)))) | |
137 | (force-mode-line-update))) | |
138 | ||
139 | ||
140 | ;; List of frames which have changed | |
141 | (defvar winner-frames-changed nil) | |
142 | ||
143 | ;; Time to save the window configuration. | |
144 | (defun winner-save-configuration () | |
145 | (push (selected-frame) winner-frames-changed) | |
146 | (add-hook 'post-command-hook 'winner-do-save)) | |
147 | ||
148 | \f | |
149 | (defun winner-do-save () | |
150 | (let ((current (selected-frame))) | |
151 | (unwind-protect | |
152 | (do ((frames winner-frames-changed (cdr frames))) | |
153 | ((null frames)) | |
154 | (unless (memq (car frames) (cdr frames)) | |
155 | ;; Process each frame once. | |
156 | (select-frame (car frames)) | |
157 | (winner-push (current-window-configuration) (car frames)))) | |
158 | (setq winner-frames-changed nil) | |
159 | (select-frame current) | |
160 | (remove-hook 'post-command-hook 'winner-do-save)))) | |
161 | ||
162 | ||
163 | ||
164 | ||
165 | ||
166 | ;;;; Configuration stacks (one for each frame) | |
167 | ||
168 | ||
169 | (defvar winner-stacks nil) ; ------ " ------ | |
170 | ||
b34a78db RS |
171 | ;; This works around a bug in defstruct. |
172 | (defvar custom-print-functions nil) | |
a14fb2b1 RS |
173 | |
174 | ;; A stack of window configurations with some additional information. | |
175 | (defstruct (winner-stack | |
176 | (:constructor winner-stack-new | |
177 | (config &aux | |
178 | (data (list config)) | |
179 | (place data)))) | |
180 | data place (count 1)) | |
181 | ||
182 | ||
183 | ;; Return the stack of this frame | |
184 | (defun winner-stack (frame) | |
185 | (let ((stack (cdr (assq frame winner-stacks)))) | |
186 | (if stack (winner-stack-data stack) | |
187 | ;; Else make new stack | |
188 | (letf (((selected-frame) frame)) | |
189 | (let ((config (current-window-configuration))) | |
190 | (push (cons frame (winner-stack-new config)) | |
191 | winner-stacks) | |
192 | (list config)))))) | |
193 | ||
a14fb2b1 RS |
194 | ;; Push this window configuration on the right stack, |
195 | ;; but make sure the stack doesn't get too large etc... | |
196 | (defun winner-push (config frame) | |
197 | (let ((this (cdr (assq frame winner-stacks)))) | |
198 | (if (not this) (push (cons frame (winner-stack-new config)) | |
199 | winner-stacks) | |
200 | (push config (winner-stack-data this)) | |
201 | (when (> (incf (winner-stack-count this)) winner-limit) | |
202 | ;; No more than 2*winner-limit configs | |
203 | (setcdr (winner-stack-place this) nil) | |
204 | (setf (winner-stack-place this) | |
205 | (winner-stack-data this)) | |
206 | (setf (winner-stack-count this) 1))))) | |
79fd9b2f | 207 | \f |
a14fb2b1 RS |
208 | ;;;; Selecting a window configuration |
209 | ||
a14fb2b1 RS |
210 | ;; Return list of names of other buffers, excluding the current buffer |
211 | ;; and buffers specified by the user. | |
212 | (defun winner-other-buffers () | |
213 | (loop for buf in (buffer-list) | |
214 | for name = (buffer-name buf) | |
215 | unless (or (eq (current-buffer) buf) | |
216 | (member name winner-skip-buffers) | |
217 | (loop for regexp in winner-skip-regexps | |
218 | if (string-match regexp name) return t | |
219 | finally return nil)) | |
220 | collect name)) | |
221 | ||
a14fb2b1 | 222 | (defun winner-select (&optional arg) |
a14fb2b1 RS |
223 | "Change to previous or new window configuration. |
224 | With arg start at position 1 if arg is positive, and | |
225 | at -1 if arg is negative; else start at position 0. | |
226 | \(For Winner to record changes in window configurations, | |
227 | Winner mode must be turned on.\)" | |
228 | (interactive "P") | |
229 | ||
230 | (setq arg | |
231 | (cond | |
232 | ((not arg) nil) | |
233 | ((> (prefix-numeric-value arg) 0) winner-next-event) | |
234 | ((< (prefix-numeric-value arg) 0) winner-prev-event) | |
235 | (t nil))) | |
236 | (if arg (push arg unread-command-events)) | |
79fd9b2f | 237 | |
a14fb2b1 RS |
238 | (let ((stack (winner-stack (selected-frame))) |
239 | (store nil) | |
240 | (buffers (winner-other-buffers)) | |
241 | (passed nil) | |
242 | (config (current-window-configuration)) | |
243 | (pos 0) event) | |
244 | ;; `stack' and `store' are stacks of window configuration while | |
245 | ;; `buffers' and `passed' are stacks of buffer names. | |
246 | ||
247 | (condition-case nil | |
248 | ||
249 | (loop | |
250 | (setq event (read-event)) | |
251 | (cond | |
252 | ||
253 | ((eq event winner-prev-event) | |
254 | (cond (passed (push (pop passed) buffers)(decf pos)) | |
255 | ((cdr stack)(push (pop stack) store) (decf pos)) | |
256 | (t (setq stack (append (nreverse store) stack)) | |
257 | (setq store nil) | |
258 | (setq pos 0)))) | |
259 | ||
260 | ((eq event winner-next-event) | |
261 | (cond (store (push (pop store) stack) (incf pos)) | |
262 | (buffers (push (pop buffers) passed) (incf pos)) | |
263 | (t (setq buffers (nreverse passed)) | |
264 | (setq passed nil) | |
265 | (setq pos 0)))) | |
266 | ||
267 | ((eq event winner-max-event) | |
268 | ;; Delete other windows and leave. | |
269 | (delete-other-windows) | |
270 | ;; Let this change be saved. | |
271 | (setq pos -1) | |
272 | ;; Perform other actions of this event. | |
273 | (push event unread-command-events) | |
274 | (return)) | |
275 | (t (push event unread-command-events) (return))) | |
276 | ||
277 | (cond | |
278 | ;; Display | |
279 | (passed (set-window-buffer (selected-window) (car passed)) | |
280 | (message (concat "Winner\(%d\): [%s] " | |
281 | (mapconcat 'identity buffers " ")) | |
282 | pos (car passed))) | |
283 | ||
284 | (t (set-window-configuration (car stack)) | |
285 | (if (window-minibuffer-p (selected-window)) | |
286 | (other-window 1)) | |
287 | (message "Winner\(%d\)" pos)))) | |
288 | ||
289 | (quit (set-window-configuration config) | |
290 | (setq pos 0))) | |
291 | (if (zerop pos) | |
292 | ;; Do not record these changes. | |
293 | (remove-hook 'post-command-hook 'winner-do-save) | |
294 | ;; Else update the buffer list and make sure that the displayed | |
295 | ;; buffer is the same as the current buffer. | |
296 | (switch-to-buffer (window-buffer))))) | |
a14fb2b1 RS |
297 | |
298 | (defun winner-previous () | |
299 | "Change to previous window configuration." | |
300 | (interactive) | |
301 | (winner-select -1)) | |
302 | ||
303 | (defun winner-next () | |
304 | "Change to new window configuration." | |
305 | (interactive) | |
306 | (winner-select 1)) | |
79fd9b2f | 307 | \f |
a14fb2b1 RS |
308 | ;;;; To be evaluated when the package is loaded: |
309 | ||
310 | (unless winner-mode-map | |
311 | (setq winner-mode-map (make-sparse-keymap)) | |
312 | (define-key winner-mode-map (vector winner-prev-event) 'winner-previous) | |
313 | (define-key winner-mode-map (vector winner-next-event) 'winner-next)) | |
314 | ||
315 | (unless (or (assq 'winner-mode minor-mode-map-alist) | |
316 | winner-dont-bind-my-keys) | |
317 | (push (cons 'winner-mode winner-mode-map) | |
318 | minor-mode-map-alist)) | |
319 | ||
320 | (unless (assq 'winner-mode minor-mode-alist) | |
321 | (push '(winner-mode " Win") minor-mode-alist)) | |
322 | ||
323 | (provide 'winner) | |
324 | ||
21f3d1d3 | 325 | ;;; winner.el ends here |