-
Notifications
You must be signed in to change notification settings - Fork 1
/
Copy pathcycle-buffer.el
390 lines (351 loc) · 17.2 KB
/
cycle-buffer.el
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
;;;
;;; cycle-buffer.el --- select buffer by cycling through
;; Author: Vladimir Alexiev <[email protected]>
;; Maintainer: same
;; Idea by: Kurt Partridge <[email protected]>
;; Created: 05 June 1996
;; Keywords: switch-to-buffer, cycle buffer list
;; LCD Archive Entry:
;; cycle-buffer|Vladimir Alexiev|[email protected]|
;; Select buffers by cycling|
;; ftp://ftp.cs.ualberta.ca/pub/oolog/emacs/cycle-buffer.el|
;; 21-May-97|Version 2.16|
;;; Commentary:
;; Description:
;; ------------
;; cycle-buffer is yet another way of selecting buffers. Instead of prompting
;; you for a buffer name, cycle-buffer switches to the most recently used
;; buffer, and repeated invocations of cycle-buffer-forward switch to less
;; recently visited buffers. If you accidentally overshoot, calling
;; cycle-buffer-backward goes back. You should issue consecutive cycle command
;; pretty quickly: if there is some intervening command between two cycling
;; commands, or if a settable timeout expires, the cycling is reset and the
;; next cycle-buffer will get you to the last buffer.
;;
;; I find this to be the fastest buffer-switching mechanism; it's like C-x
;; b <return> w/out the return, but it's not limited to the most recently
;; accessed buffer. Plus you never have to remember buffer names; you
;; just keep cycling until you recognize the buffer you're searching for. The
;; buffer ring is shown in the echo area centered around the current buffer;
;; if you see the name of the buffer you are looking for a few positions away
;; from the center, you can give an argument to cycle-buffer to get directly
;; to it. Positive arguments move to the right, negative arguments to the
;; left.
;;
;; In addition to cycling forward and backward, there are two versions of the
;; command provided: normal and "permissive". The permissive version allows
;; (as per factory settings) buffers of the form *bufname*, while the normal
;; version does not.
;; Installation:
;; -------------
;; Add these lines in your .emacs:
;; (autoload 'cycle-buffer "cycle-buffer" "Cycle forward." t)
;; (autoload 'cycle-buffer-backward "cycle-buffer" "Cycle backward." t)
;; (autoload 'cycle-buffer-permissive "cycle-buffer" "Cycle forward allowing *buffers*." t)
;; (autoload 'cycle-buffer-backward-permissive "cycle-buffer" "Cycle backward allowing *buffers*." t)
;; (autoload 'cycle-buffer-toggle-interesting "cycle-buffer" "Toggle if this buffer will be considered." t)
;; (global-set-key [(f9)] 'cycle-buffer-backward)
;; (global-set-key [(f10)] 'cycle-buffer)
;; (global-set-key [(shift f9)] 'cycle-buffer-backward-permissive)
;; (global-set-key [(shift f10)] 'cycle-buffer-permissive)
;; You may want to adjust the keyboard bindings to suit your taste. See below
;; for other customisable variables.
;; Todo
;; ----
;; - try not to shift the list in the echo area, move the [ ] only.
;; - in order not to switch to the intermediate buffers, implement an electric
;; minibuffer mode where cycle-buffer and cycle-buffer-backward only scroll
;; the buffer list in the minibuffer, and the buffer is switched only upon
;; exit from that mode (partly suggested by [email protected])
;; SUGGESTIONS ARE WELCOME.
;; ChangeLog
;; ---------
;; Fri Jun 7 11:00:32 1996 [VA]
;; floatp-safe is not defined in emacs, pointed by [email protected]
;;
;; Sat Jun 8 17:27:57 1996 [VA]
;; [email protected] suggested an "inverse" of cycle-buffer-ignore, a
;; variable that would only *allow* certain buffers. I decided to generalise
;; the two to cycle-buffer-filter, a general and-or form.
;;
;; Sat Jun 8 20:11:23 1996 [VA]
;; Doc fix, pointed by [email protected]
;;
;; Mon Jun 10 11:55:25 1996 [VA]
;; Added cycle-buffer-interesting and cycle-buffer-toggle-interesting,
;; suggestion by Josh MacDonald <[email protected]>
;;
;; Mon Mar 24 14:54:37 1997 [Martin Stjernholm <[email protected]>]
;; Added cycle-buffer-next-command to pre-command-hook to discard changes
;; to the buffer list caused by buffers we just fly through.
;;
;; Wed May 21 02:29:18 1997 [VA]
;; cycle-buffer-message: don't log the buffer list onto the message log
;;
;; Mon Dec 1 18:57:31 1997 [VA]
;; cycle-buffer-shorten-name: turn ` ' in buf name to `_', also save a couple
;; of spaces around each name.
(eval-when-compile (require 'cl))
(defvar cycle-buffer-filter
'((not (eq (aref (buffer-name) 0) ? )) ; " buffer"
(not (member (buffer-name) ; uninteresting buffers
'("lispdir.dat" "*reportmail*" ".newsrc-dribble" "info dir"
".infonotes")))
(not (string-match "^\\(TAGS\\|\\*?sent\\)" (buffer-name)))
(or (eq cycle-buffer-allow-visible t) ; visible buffers
(eq (current-buffer) cycle-buffer-current)
(not (get-buffer-window (current-buffer)
(if cycle-buffer-allow-visible nil 'visible)))))
"*A list of forms that determine if a buffer is considered for switching to.
All forms should return non-nil for a buffer to be eligible. The forms are
evaluated in the buffer in question, so they can check its buffer-local
variables (eg major-mode).
You can add more restrictions by consing to the variable from inside
cycle-buffer-load-hook or after (require 'cycle-buffer). For example to
restrict switching from a C++ file only to relevant files, do this:
(setq cycle-buffer-filter (cons
'(or (not (eq major-mode 'c++-mode))
(string-match \"\\\\.\\\\(cc\\\\|hh\\\\)$\\\\|I?[mM]akefile\" (buffer-name)))
cycle-buffer-filter))
Unfortunately, in order to *relax* the restrictions, you will probably need to
copy the variable to your .emacs and make changes in the text.")
(defvar cycle-buffer-filter-extra
'((not (string-match "^\\*.*\\*\\(<[0-9]+>\\)?$" (buffer-name)))
cycle-buffer-interesting)
"*List of forms that are evaluated in addition to cycle-buffer-filter for
the non-permissive versions of the cycle-buffer commands.")
(defvar cycle-buffer-allow-visible 'other
"*Whether to consider visible buffers. nil: ignore them; t: allow them; any
other value: allow buffers visible on other frames, but not on the selected
frame.")
(defvar cycle-buffer-show t
"*Whether to show the buffer names in the echo area when you invoke one of
the cycle-buffer commands. Possible values:
nil never
t always (same as 0)
number after that many successive invocations of a cycle-buffer command
'prefix only when the command was given a DISTANCE prefix argument.")
(defvar cycle-buffer-show-permissive 'maybe
"*Whether to show buffers in the echo area using the permissive version of
the test. nil: use the restricted version; t: use the permissive version; any
other value: use the setting of the invoked cycle command. If you don't intend
to mix cycle-buffer commands of different permissiveness, set this to 'maybe.")
(defvar cycle-buffer-show-length 20
"*Maximum number of chars to show of a buffer name.")
(defvar cycle-buffer-show-format '(" [%s]" . " %s")
"*A cons of two format strings, the car of which is used for the current
buffer, and the cdr for non-current buffers.")
(defvar cycle-buffer-reset-after 4.5
"*Reset the cycle after this many seconds of inactivity. The next
cycle-buffer will return you to the last buffer instead of going forward.
(Any intervening command other than the cycling commands does this reset.)
This option is useful if you sometimes switch between buffers and do not
execute any commands, but stay for some time (eg to read something), and after
that want to return to the previous buffer. Set this to nil if you don't like
this behaviour.")
(defvar cycle-buffer-load-hook nil
"Hook that is run right after cycle-buffer is loaded.")
;; end of user variables
(defconst cycle-buffer-commands
'(cycle-buffer cycle-buffer-backward
cycle-buffer-permissive cycle-buffer-backward-permissive)
"List of all cycle-buffer commands.")
(defvar cycle-buffer-invocations 0
"How many cycle commands were invoked successively.")
(defvar cycle-buffer-last-time nil
"Last time a cycle command was called.")
(defvar cycle-buffer-list nil
"Buffer list as set by the last cycle-buffer command.")
(defvar cycle-buffer-current nil
"The value of (current-buffer) before the command was invoked.")
(defvar cycle-buffer-interesting t
"Whether the current buffer should be considered. Use
cycle-buffer-toggle-interesting to set it interactively.")
(make-variable-buffer-local 'cycle-buffer-interesting)
;;;###autoload
(defun cycle-buffer (&optional distance permissive)
"Switch to the next buffer on the buffer list without prompting.
Successive invocations select buffers further down on the buffer list.
A prefix argument specifies the DISTANCE to skip, negative moves back."
(interactive "p")
(let ((time (current-time)) list last buf)
(if cycle-buffer-reset-after ; avoid float computation if not needed
(setq time (+ (* (nth 0 time) 65536.0)
(nth 1 time)
(/ (nth 2 time) 1e6))))
(if (or (not cycle-buffer-list) ; initialization
(not (memq last-command cycle-buffer-commands)) ; intervening cmd
(and cycle-buffer-reset-after
(or (not (funcall
(if (fboundp 'floatp-safe) 'floatp-safe 'floatp)
cycle-buffer-last-time))
(> (- time cycle-buffer-last-time)
cycle-buffer-reset-after)))) ; elapsed time
(progn
;; Put current buffer on top of Emacs' buffer list
(switch-to-buffer (current-buffer))
;; regenerate the buffer list
(setq cycle-buffer-invocations 0
cycle-buffer-list (cycle-buffer-filter (buffer-list)
cycle-buffer-filter))))
; we use the permissive filter here
; because cycle-buffer-list is shared
; between all cycle functions
(setq cycle-buffer-last-time time)
(setq cycle-buffer-invocations (1+ cycle-buffer-invocations))
(setq list
(if permissive cycle-buffer-list
(cycle-buffer-filter cycle-buffer-list cycle-buffer-filter-extra)))
(if (null list) (error "There is no appropriate buffer to switch to."))
(if (< distance 0)
(setq distance (- distance)
list (reverse list))) ; not nreverse: preserve cycle-buffer-list
(setq distance (% distance (length list)))
(if (and (not (eq (car list) (current-buffer)))
(> distance 0))
(setq distance (1- distance)))
(while (not (zerop distance))
(setq distance (1- distance)
list (cdr list)))
(setq buf (car list))
(if (eq buf (current-buffer))
(error "There's no point in switching to the current buffer."))
;; find the cons before the one containing buf
(setq list cycle-buffer-list)
(while (and list (not (eq (car (cdr list)) buf)))
(setq list (cdr list)))
(or list (setq list cycle-buffer-list))
;; find the last cons
(setq last cycle-buffer-list)
(while (cdr last) (setq last (cdr last)))
;; restructure the list so that buf is in the beginning
(setcdr last cycle-buffer-list)
(setq cycle-buffer-list (cdr list))
(setcdr list nil)
;; and go
;; Switch buffer but do not change Emacs' buffer list. Install a
;; hook that makes that change if the next command isn't a
;; cycle-buffer command.
(switch-to-buffer buf t)
(add-hook 'pre-command-hook 'cycle-buffer-next-command)
(if (cond ((eq nil cycle-buffer-show) nil)
((eq t cycle-buffer-show))
((eq 'prefix cycle-buffer-show)
current-prefix-arg)
((numberp cycle-buffer-show)
(< cycle-buffer-show cycle-buffer-invocations))
((error "Invalid value: cycle-buffer-show, %s" cycle-buffer-show)))
(cycle-buffer-show permissive))))
;;;###autoload
(defun cycle-buffer-backward (&optional distance)
"Switch to the previous buffer in the buffer list."
(interactive "p")
(cycle-buffer (- distance)))
;;;###autoload
(defun cycle-buffer-permissive (&optional distance)
"Switch to the next buffer, allowing more buffers (*bufname* by default)."
(interactive "p")
(cycle-buffer distance t))
;;;###autoload
(defun cycle-buffer-backward-permissive (&optional distance)
"Switch to the previous buffer, allowing more buffers (*bufname* by default)."
(interactive "p")
(cycle-buffer (- distance) t))
(defun cycle-buffer-show (permissive)
;; Show cycle-buffer-list in the echo area like this:
;; n/2 n/2+1 .. n [0] 1 2 .. n/2
;; WARNING: this waits for cycle-buffer-reset-after seconds if there is no
;; interactive command issued sooner.
(let (wid list str s mid current next p n)
(setq wid (window-width (minibuffer-window)))
(setq list
(cond ((eq cycle-buffer-show-permissive t) cycle-buffer-list)
((eq cycle-buffer-show-permissive nil)
(cycle-buffer-filter
cycle-buffer-list cycle-buffer-filter-extra))
(permissive cycle-buffer-list)
((cycle-buffer-filter
cycle-buffer-list cycle-buffer-filter-extra))))
(setq str (if (and list (eq (car list) (current-buffer))) ""
;; selected buffer not in show list
(format (car cycle-buffer-show-format) "")))
(setq mid (/ (length str) 2))
(setq next t)
(while (and list (not (and p n (eq (car p) (car n))))
(< (length str) (* wid 2)))
(cond ((null n) (setq n list) (setq s (car n)))
((null p) (setq p (reverse list)) (setq s (car p)))
(next (setq n (cdr n)) (setq s (car n)))
(t (setq p (cdr p)) (setq s (car p))))
(setq current (eq s (current-buffer)))
(setq s (format
(funcall (if current 'car 'cdr) cycle-buffer-show-format)
(cycle-buffer-shorten-name (buffer-name s))))
(cond (next (if current
(setq mid (/ (length (setq str s)) 2))
(setq str (concat str s))))
(t (setq mid (+ mid (length s)))
(setq str (concat s str))))
(setq next (not next)))
(setq wid (/ wid 2))
(if (> mid wid) (setq str (substring str (- mid wid))))
(if (< mid wid) (setq str (concat (make-string (- wid mid) ? ) str)))
(cycle-buffer-message str)
(if (and cycle-buffer-reset-after
(sit-for cycle-buffer-reset-after))
(cycle-buffer-message ""))))
(defun cycle-buffer-message (str)
"Show STR but don't log it on the message log."
(if (fboundp 'display-message)
;; XEmacs way of preventing log messages.
(display-message 'no-log str)
(let ((message-log-max nil))
(message "%s" str))))
(defun cycle-buffer-shorten-name (s)
"Shorten S to cycle-buffer-show-length. Feel free to customize."
(let (len prefix suffix)
(if (string-match "\\(ftp \\|/\\)\\(anonymous\\|ftp\\)@" s) ; cut off
(setq s (concat (substring s 0 (match-beginning 0))
(substring s (match-end 0))))
(setq s (copy-sequence s))) ; else the loop below is destructive
(loop for i below (length s)
do (if (eq (aref s i) ? ) (aset s i ?_)))
(setq len (length s))
(if (> len cycle-buffer-show-length)
(progn ; shorten s but preserve a numeric suffix
(set-match-data (list len len))
(string-match "<?[0-9]+>?$" s)
(setq suffix (match-beginning 0))
(setq prefix (- cycle-buffer-show-length 2 (- len suffix)))
(setq s (concat (substring s 0 prefix) ".." (substring s suffix))))))
s)
(defun cycle-buffer-filter (list filter)
;; Filter LIST through the variable cycle-buffer-filter
(let (result)
(setq cycle-buffer-current (current-buffer))
(while list
(set-buffer (car list))
(if (eval (cons 'and filter))
(setq result (cons (car list) result)))
(setq list (cdr list)))
(set-buffer cycle-buffer-current)
(nreverse result)))
(defun cycle-buffer-next-command ()
;; Take this buffer to the top if a non-cycle-buffer command was
;; issued.
(if (not (member this-command cycle-buffer-commands))
(switch-to-buffer (current-buffer)))
(remove-hook 'pre-command-hook 'cycle-buffer-next-command))
;;;###autoload
(defun cycle-buffer-toggle-interesting (&optional arg)
"Toggle the value of cycle-buffer-interesting for the current buffer.
With positive arg set it, with non-positive arg reset it. A buffer is only
considered by cycle-buffer when cycle-buffer-interesting is t."
(interactive "P")
(setq cycle-buffer-interesting (if arg (> (prefix-numeric-value arg) 0)
(not cycle-buffer-interesting)))
(message "This buffer will%s be considered by cycle-buffer."
(if cycle-buffer-interesting "" " not")))
(run-hooks 'cycle-buffer-load-hook)
(provide 'cycle-buffer)
;;; end of cycle-buffer.el