Mercurial > emacs
annotate lisp/winner.el @ 19029:9ccea8ddd344 libc-970729 libc-970730 libc-970731 libc-970801
update from main archive 970728
author | Ulrich Drepper <drepper@redhat.com> |
---|---|
date | Mon, 28 Jul 1997 23:37:45 +0000 |
parents | f6f245a3714b |
children | 95f1938d0296 |
rev | line source |
---|---|
17469 | 1 ;;; winner.el --- Restore window configuration or change buffer |
2 | |
17470
c4cd2317fe60
Clean up comments, etc.
Richard M. Stallman <rms@gnu.org>
parents:
17469
diff
changeset
|
3 ;; Copyright (C) 1997 Free Software Foundation. Inc. |
17469 | 4 |
5 ;; Author: Ivar Rummelhoff <ivarr@ifi.uio.no> | |
6 ;; Maintainer: Ivar Rummelhoff <ivarr@ifi.uio.no> | |
7 ;; Created: 27 Feb 1997 | |
8 ;; Keywords: extensions,windows | |
9 | |
17470
c4cd2317fe60
Clean up comments, etc.
Richard M. Stallman <rms@gnu.org>
parents:
17469
diff
changeset
|
10 ;; This file is part of GNU Emacs. |
c4cd2317fe60
Clean up comments, etc.
Richard M. Stallman <rms@gnu.org>
parents:
17469
diff
changeset
|
11 |
c4cd2317fe60
Clean up comments, etc.
Richard M. Stallman <rms@gnu.org>
parents:
17469
diff
changeset
|
12 ;; GNU Emacs is free software; you can redistribute it and/or modify |
17469 | 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 | |
17470
c4cd2317fe60
Clean up comments, etc.
Richard M. Stallman <rms@gnu.org>
parents:
17469
diff
changeset
|
17 ;; GNU Emacs is distributed in the hope that it will be useful, |
17469 | 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 ;; | |
17470
c4cd2317fe60
Clean up comments, etc.
Richard M. Stallman <rms@gnu.org>
parents:
17469
diff
changeset
|
29 ;; winner.el provides a minor mode (`winner-mode') that does |
17469 | 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 ;; | |
17470
c4cd2317fe60
Clean up comments, etc.
Richard M. Stallman <rms@gnu.org>
parents:
17469
diff
changeset
|
38 ;; To use Winner mode, put this line in your .emacs file: |
17469 | 39 ;; |
40 ;; (add-hook 'after-init-hook (lambda () (winner-mode 1))) | |
41 | |
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*") | |
87 "Exclude these buffer names | |
88 from any \(Winner mode\) list of buffers.") | |
89 | |
90 (defvar winner-skip-regexps '("^ ") | |
91 "Exclude buffers with names matching any of these regexps. | |
92 ..from any \(Winner mode\) list of buffers. | |
93 | |
94 By default `winner-skip-regexps' is set to \(\"^ \"\), | |
95 which excludes \"invisible buffers\".") | |
96 | |
97 | |
98 (defvar winner-limit 50 | |
99 "Winner will save no more than 2 * `winner-limit' window configurations. | |
100 \(.. and no less than `winner-limit'.\)") | |
101 | |
102 (defvar winner-mode-hook nil | |
103 "Functions to run whenever Winner mode is turned on.") | |
104 | |
105 (defvar winner-mode-leave-hook nil | |
106 "Functions to run whenever Winner mode is turned off.") | |
107 | |
108 (defvar winner-dont-bind-my-keys nil | |
109 "If non-nil: Do not use `winner-mode-map' in Winner mode.") | |
110 | |
111 | |
112 | |
113 ;;;; Winner mode | |
114 | |
115 (eval-when-compile (require 'cl)) | |
116 | |
117 | |
118 (defvar winner-mode nil) ; For the modeline. | |
119 (defvar winner-mode-map nil "Keymap for Winner mode.") | |
17470
c4cd2317fe60
Clean up comments, etc.
Richard M. Stallman <rms@gnu.org>
parents:
17469
diff
changeset
|
120 |
c4cd2317fe60
Clean up comments, etc.
Richard M. Stallman <rms@gnu.org>
parents:
17469
diff
changeset
|
121 ;;;###autoload |
17469 | 122 (defun winner-mode (&optional arg) |
123 "Toggle Winner mode. | |
124 With arg, turn Winner mode on if and only if arg is positive." | |
125 (interactive "P") | |
126 (let ((on-p (if arg (> (prefix-numeric-value arg) 0) | |
127 (not winner-mode)))) | |
128 (cond | |
129 (on-p (let ((winner-frames-changed (frame-list))) | |
130 (winner-do-save)) ; Save current configurations | |
131 (add-hook 'window-configuration-change-hook 'winner-save-configuration) | |
132 (setq winner-mode t) | |
133 (run-hooks 'winner-mode-hook)) | |
134 (t (remove-hook 'window-configuration-change-hook 'winner-save-configuration) | |
135 (when winner-mode | |
136 (setq winner-mode nil) | |
137 (run-hooks 'winner-mode-leave-hook)))) | |
138 (force-mode-line-update))) | |
139 | |
140 | |
141 ;; List of frames which have changed | |
142 (defvar winner-frames-changed nil) | |
143 | |
144 ;; Time to save the window configuration. | |
145 (defun winner-save-configuration () | |
146 (push (selected-frame) winner-frames-changed) | |
147 (add-hook 'post-command-hook 'winner-do-save)) | |
148 | |
149 | |
150 (defun winner-do-save () | |
151 (let ((current (selected-frame))) | |
152 (unwind-protect | |
153 (do ((frames winner-frames-changed (cdr frames))) | |
154 ((null frames)) | |
155 (unless (memq (car frames) (cdr frames)) | |
156 ;; Process each frame once. | |
157 (select-frame (car frames)) | |
158 (winner-push (current-window-configuration) (car frames)))) | |
159 (setq winner-frames-changed nil) | |
160 (select-frame current) | |
161 (remove-hook 'post-command-hook 'winner-do-save)))) | |
162 | |
163 | |
164 | |
165 | |
166 | |
167 ;;;; Configuration stacks (one for each frame) | |
168 | |
169 | |
170 (defvar winner-stacks nil) ; ------ " ------ | |
171 | |
18959
f6f245a3714b
(custom-print-functions): Add defvar.
Richard M. Stallman <rms@gnu.org>
parents:
17470
diff
changeset
|
172 ;; This works around a bug in defstruct. |
f6f245a3714b
(custom-print-functions): Add defvar.
Richard M. Stallman <rms@gnu.org>
parents:
17470
diff
changeset
|
173 (defvar custom-print-functions nil) |
17469 | 174 |
175 ;; A stack of window configurations with some additional information. | |
176 (defstruct (winner-stack | |
177 (:constructor winner-stack-new | |
178 (config &aux | |
179 (data (list config)) | |
180 (place data)))) | |
181 data place (count 1)) | |
182 | |
183 | |
184 ;; Return the stack of this frame | |
185 (defun winner-stack (frame) | |
186 (let ((stack (cdr (assq frame winner-stacks)))) | |
187 (if stack (winner-stack-data stack) | |
188 ;; Else make new stack | |
189 (letf (((selected-frame) frame)) | |
190 (let ((config (current-window-configuration))) | |
191 (push (cons frame (winner-stack-new config)) | |
192 winner-stacks) | |
193 (list config)))))) | |
194 | |
195 | |
196 | |
197 | |
198 ;; Push this window configuration on the right stack, | |
199 ;; but make sure the stack doesn't get too large etc... | |
200 (defun winner-push (config frame) | |
201 (let ((this (cdr (assq frame winner-stacks)))) | |
202 (if (not this) (push (cons frame (winner-stack-new config)) | |
203 winner-stacks) | |
204 (push config (winner-stack-data this)) | |
205 (when (> (incf (winner-stack-count this)) winner-limit) | |
206 ;; No more than 2*winner-limit configs | |
207 (setcdr (winner-stack-place this) nil) | |
208 (setf (winner-stack-place this) | |
209 (winner-stack-data this)) | |
210 (setf (winner-stack-count this) 1))))) | |
211 | |
212 | |
213 | |
214 | |
215 | |
216 | |
217 | |
218 | |
219 ;;;; Selecting a window configuration | |
220 | |
221 | |
222 ;; Return list of names of other buffers, excluding the current buffer | |
223 ;; and buffers specified by the user. | |
224 (defun winner-other-buffers () | |
225 (loop for buf in (buffer-list) | |
226 for name = (buffer-name buf) | |
227 unless (or (eq (current-buffer) buf) | |
228 (member name winner-skip-buffers) | |
229 (loop for regexp in winner-skip-regexps | |
230 if (string-match regexp name) return t | |
231 finally return nil)) | |
232 collect name)) | |
233 | |
234 | |
235 | |
236 (defun winner-select (&optional arg) | |
237 | |
238 "Change to previous or new window configuration. | |
239 With arg start at position 1 if arg is positive, and | |
240 at -1 if arg is negative; else start at position 0. | |
241 \(For Winner to record changes in window configurations, | |
242 Winner mode must be turned on.\)" | |
243 (interactive "P") | |
244 | |
245 (setq arg | |
246 (cond | |
247 ((not arg) nil) | |
248 ((> (prefix-numeric-value arg) 0) winner-next-event) | |
249 ((< (prefix-numeric-value arg) 0) winner-prev-event) | |
250 (t nil))) | |
251 (if arg (push arg unread-command-events)) | |
252 | |
253 (let ((stack (winner-stack (selected-frame))) | |
254 (store nil) | |
255 (buffers (winner-other-buffers)) | |
256 (passed nil) | |
257 (config (current-window-configuration)) | |
258 (pos 0) event) | |
259 ;; `stack' and `store' are stacks of window configuration while | |
260 ;; `buffers' and `passed' are stacks of buffer names. | |
261 | |
262 (condition-case nil | |
263 | |
264 (loop | |
265 (setq event (read-event)) | |
266 (cond | |
267 | |
268 ((eq event winner-prev-event) | |
269 (cond (passed (push (pop passed) buffers)(decf pos)) | |
270 ((cdr stack)(push (pop stack) store) (decf pos)) | |
271 (t (setq stack (append (nreverse store) stack)) | |
272 (setq store nil) | |
273 (setq pos 0)))) | |
274 | |
275 ((eq event winner-next-event) | |
276 (cond (store (push (pop store) stack) (incf pos)) | |
277 (buffers (push (pop buffers) passed) (incf pos)) | |
278 (t (setq buffers (nreverse passed)) | |
279 (setq passed nil) | |
280 (setq pos 0)))) | |
281 | |
282 ((eq event winner-max-event) | |
283 ;; Delete other windows and leave. | |
284 (delete-other-windows) | |
285 ;; Let this change be saved. | |
286 (setq pos -1) | |
287 ;; Perform other actions of this event. | |
288 (push event unread-command-events) | |
289 (return)) | |
290 (t (push event unread-command-events) (return))) | |
291 | |
292 (cond | |
293 ;; Display | |
294 (passed (set-window-buffer (selected-window) (car passed)) | |
295 (message (concat "Winner\(%d\): [%s] " | |
296 (mapconcat 'identity buffers " ")) | |
297 pos (car passed))) | |
298 | |
299 (t (set-window-configuration (car stack)) | |
300 (if (window-minibuffer-p (selected-window)) | |
301 (other-window 1)) | |
302 (message "Winner\(%d\)" pos)))) | |
303 | |
304 (quit (set-window-configuration config) | |
305 (setq pos 0))) | |
306 (if (zerop pos) | |
307 ;; Do not record these changes. | |
308 (remove-hook 'post-command-hook 'winner-do-save) | |
309 ;; Else update the buffer list and make sure that the displayed | |
310 ;; buffer is the same as the current buffer. | |
311 (switch-to-buffer (window-buffer))))) | |
312 | |
313 | |
314 | |
315 | |
316 | |
317 (defun winner-previous () | |
318 "Change to previous window configuration." | |
319 (interactive) | |
320 (winner-select -1)) | |
321 | |
322 (defun winner-next () | |
323 "Change to new window configuration." | |
324 (interactive) | |
325 (winner-select 1)) | |
326 | |
327 | |
328 | |
329 | |
330 ;;;; To be evaluated when the package is loaded: | |
331 | |
332 (unless winner-mode-map | |
333 (setq winner-mode-map (make-sparse-keymap)) | |
334 (define-key winner-mode-map (vector winner-prev-event) 'winner-previous) | |
335 (define-key winner-mode-map (vector winner-next-event) 'winner-next)) | |
336 | |
337 (unless (or (assq 'winner-mode minor-mode-map-alist) | |
338 winner-dont-bind-my-keys) | |
339 (push (cons 'winner-mode winner-mode-map) | |
340 minor-mode-map-alist)) | |
341 | |
342 (unless (assq 'winner-mode minor-mode-alist) | |
343 (push '(winner-mode " Win") minor-mode-alist)) | |
344 | |
345 (provide 'winner) | |
346 | |
17470
c4cd2317fe60
Clean up comments, etc.
Richard M. Stallman <rms@gnu.org>
parents:
17469
diff
changeset
|
347 ;;; winner.el ends here |