Mercurial > emacs
annotate lisp/winner.el @ 18398:3c18aa006200
(LD_SWITCH_SYSTEM) [__mips__]: Alternate definition.
author | Richard M. Stallman <rms@gnu.org> |
---|---|
date | Mon, 23 Jun 1997 01:54:03 +0000 |
parents | c4cd2317fe60 |
children | f6f245a3714b |
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 | |
172 | |
173 ;; A stack of window configurations with some additional information. | |
174 (defstruct (winner-stack | |
175 (:constructor winner-stack-new | |
176 (config &aux | |
177 (data (list config)) | |
178 (place data)))) | |
179 data place (count 1)) | |
180 | |
181 | |
182 ;; Return the stack of this frame | |
183 (defun winner-stack (frame) | |
184 (let ((stack (cdr (assq frame winner-stacks)))) | |
185 (if stack (winner-stack-data stack) | |
186 ;; Else make new stack | |
187 (letf (((selected-frame) frame)) | |
188 (let ((config (current-window-configuration))) | |
189 (push (cons frame (winner-stack-new config)) | |
190 winner-stacks) | |
191 (list config)))))) | |
192 | |
193 | |
194 | |
195 | |
196 ;; Push this window configuration on the right stack, | |
197 ;; but make sure the stack doesn't get too large etc... | |
198 (defun winner-push (config frame) | |
199 (let ((this (cdr (assq frame winner-stacks)))) | |
200 (if (not this) (push (cons frame (winner-stack-new config)) | |
201 winner-stacks) | |
202 (push config (winner-stack-data this)) | |
203 (when (> (incf (winner-stack-count this)) winner-limit) | |
204 ;; No more than 2*winner-limit configs | |
205 (setcdr (winner-stack-place this) nil) | |
206 (setf (winner-stack-place this) | |
207 (winner-stack-data this)) | |
208 (setf (winner-stack-count this) 1))))) | |
209 | |
210 | |
211 | |
212 | |
213 | |
214 | |
215 | |
216 | |
217 ;;;; Selecting a window configuration | |
218 | |
219 | |
220 ;; Return list of names of other buffers, excluding the current buffer | |
221 ;; and buffers specified by the user. | |
222 (defun winner-other-buffers () | |
223 (loop for buf in (buffer-list) | |
224 for name = (buffer-name buf) | |
225 unless (or (eq (current-buffer) buf) | |
226 (member name winner-skip-buffers) | |
227 (loop for regexp in winner-skip-regexps | |
228 if (string-match regexp name) return t | |
229 finally return nil)) | |
230 collect name)) | |
231 | |
232 | |
233 | |
234 (defun winner-select (&optional arg) | |
235 | |
236 "Change to previous or new window configuration. | |
237 With arg start at position 1 if arg is positive, and | |
238 at -1 if arg is negative; else start at position 0. | |
239 \(For Winner to record changes in window configurations, | |
240 Winner mode must be turned on.\)" | |
241 (interactive "P") | |
242 | |
243 (setq arg | |
244 (cond | |
245 ((not arg) nil) | |
246 ((> (prefix-numeric-value arg) 0) winner-next-event) | |
247 ((< (prefix-numeric-value arg) 0) winner-prev-event) | |
248 (t nil))) | |
249 (if arg (push arg unread-command-events)) | |
250 | |
251 (let ((stack (winner-stack (selected-frame))) | |
252 (store nil) | |
253 (buffers (winner-other-buffers)) | |
254 (passed nil) | |
255 (config (current-window-configuration)) | |
256 (pos 0) event) | |
257 ;; `stack' and `store' are stacks of window configuration while | |
258 ;; `buffers' and `passed' are stacks of buffer names. | |
259 | |
260 (condition-case nil | |
261 | |
262 (loop | |
263 (setq event (read-event)) | |
264 (cond | |
265 | |
266 ((eq event winner-prev-event) | |
267 (cond (passed (push (pop passed) buffers)(decf pos)) | |
268 ((cdr stack)(push (pop stack) store) (decf pos)) | |
269 (t (setq stack (append (nreverse store) stack)) | |
270 (setq store nil) | |
271 (setq pos 0)))) | |
272 | |
273 ((eq event winner-next-event) | |
274 (cond (store (push (pop store) stack) (incf pos)) | |
275 (buffers (push (pop buffers) passed) (incf pos)) | |
276 (t (setq buffers (nreverse passed)) | |
277 (setq passed nil) | |
278 (setq pos 0)))) | |
279 | |
280 ((eq event winner-max-event) | |
281 ;; Delete other windows and leave. | |
282 (delete-other-windows) | |
283 ;; Let this change be saved. | |
284 (setq pos -1) | |
285 ;; Perform other actions of this event. | |
286 (push event unread-command-events) | |
287 (return)) | |
288 (t (push event unread-command-events) (return))) | |
289 | |
290 (cond | |
291 ;; Display | |
292 (passed (set-window-buffer (selected-window) (car passed)) | |
293 (message (concat "Winner\(%d\): [%s] " | |
294 (mapconcat 'identity buffers " ")) | |
295 pos (car passed))) | |
296 | |
297 (t (set-window-configuration (car stack)) | |
298 (if (window-minibuffer-p (selected-window)) | |
299 (other-window 1)) | |
300 (message "Winner\(%d\)" pos)))) | |
301 | |
302 (quit (set-window-configuration config) | |
303 (setq pos 0))) | |
304 (if (zerop pos) | |
305 ;; Do not record these changes. | |
306 (remove-hook 'post-command-hook 'winner-do-save) | |
307 ;; Else update the buffer list and make sure that the displayed | |
308 ;; buffer is the same as the current buffer. | |
309 (switch-to-buffer (window-buffer))))) | |
310 | |
311 | |
312 | |
313 | |
314 | |
315 (defun winner-previous () | |
316 "Change to previous window configuration." | |
317 (interactive) | |
318 (winner-select -1)) | |
319 | |
320 (defun winner-next () | |
321 "Change to new window configuration." | |
322 (interactive) | |
323 (winner-select 1)) | |
324 | |
325 | |
326 | |
327 | |
328 ;;;; To be evaluated when the package is loaded: | |
329 | |
330 (unless winner-mode-map | |
331 (setq winner-mode-map (make-sparse-keymap)) | |
332 (define-key winner-mode-map (vector winner-prev-event) 'winner-previous) | |
333 (define-key winner-mode-map (vector winner-next-event) 'winner-next)) | |
334 | |
335 (unless (or (assq 'winner-mode minor-mode-map-alist) | |
336 winner-dont-bind-my-keys) | |
337 (push (cons 'winner-mode winner-mode-map) | |
338 minor-mode-map-alist)) | |
339 | |
340 (unless (assq 'winner-mode minor-mode-alist) | |
341 (push '(winner-mode " Win") minor-mode-alist)) | |
342 | |
343 (provide 'winner) | |
344 | |
17470
c4cd2317fe60
Clean up comments, etc.
Richard M. Stallman <rms@gnu.org>
parents:
17469
diff
changeset
|
345 ;;; winner.el ends here |