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