annotate lisp/winner.el @ 19161:248ec4d8a5e6

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