(replace_buffer_in_all_windows):
[bpt/emacs.git] / lisp / follow.el
1 ;;; follow.el --- Minor mode, Synchronize windows showing the same buffer.
2
3 ;; Copyright (C) 1995, 1996, 1997 Free Software Foundation, Inc.
4
5 ;; Author: Anders Lindgren <andersl@csd.uu.se>
6 ;; Maintainer: Anders Lindgren <andersl@csd.uu.se>
7 ;; Created: 25 May 1995
8 ;; Version: 1.7
9 ;; Keywords: display, window, minor-mode
10 ;; Date: 4 Jun 1997
11
12 ;; This file is part of GNU Emacs.
13
14 ;; GNU Emacs is free software; you can redistribute it and/or modify
15 ;; it under the terms of the GNU General Public License as published by
16 ;; the Free Software Foundation; either version 2, or (at your option)
17 ;; any later version.
18
19 ;; GNU Emacs is distributed in the hope that it will be useful,
20 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
21 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
22 ;; GNU General Public License for more details.
23
24 ;; You should have received a copy of the GNU General Public License
25 ;; along with GNU Emacs; see the file COPYING. If not, write to the
26 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
27 ;; Boston, MA 02111-1307, USA.
28
29 ;;; Commentary:
30
31 ;;{{{ Documentation
32
33 ;; `Follow mode' is a minor mode for Emacs 19 and XEmacs which
34 ;; combines windows into one tall virtual window.
35 ;;
36 ;; The feeling of a "virtual window" has been accomplished by the use
37 ;; of two major techniques:
38 ;;
39 ;; * The windows always displays adjacent sections of the buffer.
40 ;; This means that whenever one window is moved, all the
41 ;; others will follow. (Hence the name Follow Mode.)
42 ;;
43 ;; * Should the point (cursor) end up outside a window, another
44 ;; window displaying that point is selected, if possible. This
45 ;; makes it possible to walk between windows using normal cursor
46 ;; movement commands.
47 ;;
48 ;; Follow mode comes to its prime when used on a large screen and two
49 ;; side-by-side window are used. The user can, with the help of Follow
50 ;; mode, use two full-height windows as though they would have been
51 ;; one. Imagine yourself editing a large function, or section of text,
52 ;; and being able to use 144 lines instead of the normal 72... (your
53 ;; mileage may vary).
54
55 ;; The latest version, and a demonstration, are avaiable at:
56 ;;
57 ;; ftp://ftp.csd.uu.se/pub/users/andersl/emacs/follow.el
58 ;; http://www.csd.uu.se/~andersl/follow.shtml
59
60 ;; `Follow mode' can be used together with Emacs 19 and XEmacs.
61 ;; It has been tested together with Emacs 19.27, 19.28, 19.29,
62 ;; 19.30, XEmacs 19.12, and 19.13.
63
64
65 ;; To test this package, make sure `follow' is loaded, or will be
66 ;; autoloaded when activated (see below). Then do the following:
67 ;;
68 ;; * Find your favorite file (preferably a long one.)
69 ;;
70 ;; * Resize Emacs so that it will be wide enough for two full sized
71 ;; columns. Delete the other windows and split with the commands
72 ;; `C-x 1 C-x 3'.
73 ;;
74 ;; * Give the command:
75 ;; M-x follow-mode <RETURN>
76 ;;
77 ;; * Now the display should look something like (assuming the text "71"
78 ;; is on line 71):
79 ;;
80 ;; +----------+----------+
81 ;; |1 |73 |
82 ;; |2 |74 |
83 ;; |3 |75 |
84 ;; ... ...
85 ;; |71 |143 |
86 ;; |72 |144 |
87 ;; +----------+----------+
88 ;;
89 ;; As you can see, the right-hand window starts at line 73, the line
90 ;; immediately below the end of the left-hand window. As long as
91 ;; `follow-mode' is active, the two windows will follow eachother!
92 ;;
93 ;; * Play around and enjoy! Scroll one window and watch the other.
94 ;; Jump to the beginning or end. Press `Cursor down' at the last
95 ;; line of the left-hand window. Enter new lines into the
96 ;; text. Enter long lines spanning several lines, or several
97 ;; windows.
98 ;;
99 ;; * Should you find `Follow' mode annoying, just type
100 ;; M-x follow-mode <RETURN>
101 ;; to turn it off.
102
103
104 ;; Installation:
105 ;;
106 ;; To fully install this, add this file to your Emacs Lisp directory and
107 ;; compile it with M-x byte-compile-file. Then add the following to the
108 ;; appropriate init file (normally your `~/.emacs' file):
109 ;;
110 ;; (autoload 'follow-mode "follow"
111 ;; "Synchronize windows showing the same buffer, minor mode." t)
112
113
114 ;; The command `follow-delete-other-windows-and-split' maximises the
115 ;; visible area of the current buffer.
116 ;;
117 ;; I recommend adding it, and `follow-mode', to hotkeys in the global
118 ;; key map. To do so, add the following lines (replacing `[f7]' and
119 ;; `[f8]' with your favorite keys) to the init file:
120 ;;
121 ;; (autoload 'follow-mode "follow"
122 ;; "Synchronize windows showing the same buffer, minor mode." t)
123 ;; (global-set-key [f8] 'follow-mode)
124 ;;
125 ;; (autoload 'follow-delete-other-windows-and-split "follow"
126 ;; "Delete other windows, split the frame in two, and enter Follow Mode." t)
127 ;; (global-set-key [f7] 'follow-delete-other-windows-and-split)
128
129
130 ;; There exists two system variables which controls the appearence of
131 ;; lines which are wider than the window containing them. The default
132 ;; is to truncate long lines whenever a window isn't as wide as the
133 ;; frame.
134 ;;
135 ;; To make sure lines are never truncated, please place the following
136 ;; lines in your init file:
137 ;;
138 ;; (setq truncate-lines nil)
139 ;; (setq truncate-partial-width-windows nil)
140
141
142 ;; Since the display of XEmacs is pixel-oriented, a line could be
143 ;; clipped in half at the bottom of the window.
144 ;;
145 ;; To make XEmacs avoid clipping (normal) lines, please place the
146 ;; following line in your init-file:
147 ;;
148 ;; (setq pixel-vertical-clip-threshold 30)
149
150
151 ;; The correct way to cofigurate Follow mode, or any other mode for
152 ;; that matter, is to create one (or more) function which does
153 ;; whatever you would like to do. The function is then added to
154 ;; a hook.
155 ;;
156 ;; When `Follow' mode is activated, functions stored in the hook
157 ;; `follow-mode-hook' are called. When it is deactivated
158 ;; `follow-mode-off-hook' is runed.
159 ;;
160 ;; The keymap `follow-key-map' contains key bindings activated by
161 ;; `follow-mode'.
162 ;;
163 ;; Example:
164 ;; (add-hook 'follow-mode-hook 'my-follow-mode-hook)
165 ;;
166 ;; (defun my-follow-mode-hook ()
167 ;; (define-key follow-mode-map "\C-ca" 'your-favorite-function)
168 ;; (define-key follow-mode-map "\C-cb" 'another-function))
169
170
171 ;; Usage:
172 ;;
173 ;; To activate give the command: M-x follow-mode
174 ;; and press return. To deactivate, do it again.
175 ;;
176 ;; Some special commands have been developed to make life even easier:
177 ;; follow-scroll-up C-c . C-v
178 ;; Scroll text in a Follow Mode window chain up.
179 ;;
180 ;; follow-scroll-down C-c . v
181 ;; Like `follow-scroll-up', but in the other direction.
182 ;;
183 ;; follow-delete-other-windows-and-split C-c . 1
184 ;; Maximise the visible area of the current buffer,
185 ;; and enter Follow Mode. This is a very convenient
186 ;; way to start Follow Mode, hence it is recomended
187 ;; that this command is added to the global keymap.
188 ;;
189 ;; follow-recenter C-c . C-l
190 ;; Place the point in the center of the middle window,
191 ;; or a specified number of lines from either top or bottom.
192 ;;
193 ;; follow-switch-to-buffer C-c . b
194 ;; Switch buffer in all windows displaying the current buffer
195 ;; in this frame.
196 ;;
197 ;; follow-switch-to-buffer-all C-c . C-b
198 ;; Switch buffer in all windows in the active frame.
199 ;;
200 ;; follow-switch-to-current-buffer-all
201 ;; Show the current buffer in all windows on the current
202 ;; frame and turn on `follow-mode'.
203 ;;
204 ;; follow-first-window C-c . <
205 ;; Select the first window in the frame showing the same buffer.
206 ;;
207 ;; follow-last-window C-c . >
208 ;; Select the last window in the frame showing the same buffer.
209 ;;
210 ;; follow-next-window C-c . n
211 ;; Select the next window in the frame showing the same buffer.
212 ;;
213 ;; follow-previous-window C-c . p
214 ;; Select the previous window showing the same buffer.
215
216
217 ;; Well, it seems ok, but what if I really want to look at two different
218 ;; positions in the text? Here are two simple methods to use:
219 ;;
220 ;; 1) Use multiple frames; `follow' mode only affects windows displayed
221 ;; in the same frame. (My apoligies to you who can't use frames.)
222 ;;
223 ;; 2) Bind `follow-mode' to key so you can turn it off whenever
224 ;; you want to view two locations. Of course, `follow' mode can
225 ;; be reactivated by hitting the same key again.
226 ;;
227 ;; Example from my ~/.emacs:
228 ;; (global-set-key [f8] 'follow-mode)
229
230
231 ;; Implementation:
232 ;;
233 ;; In an ideal world, follow mode would have been implemented in the
234 ;; kernal of the display routines, making sure that the windows (in
235 ;; follow mode) ALWAYS are aligned. On planet earth, however, we must
236 ;; accept a solution where we ALMOST ALWAYS can make sure that the
237 ;; windows are aligned.
238 ;;
239 ;; Follow mode does this in three places:
240 ;; 1) After each user command.
241 ;; 2) After a process output has been perfomed.
242 ;; 3) When a scrollbar has been moved.
243 ;;
244 ;; This will cover most situations. (Let me know if there are other
245 ;; situations which should be covered.)
246 ;;
247 ;; However, only the selected window is checked, for the reason of
248 ;; efficiency and code complexity. (i.e. it is possible to make a
249 ;; non-selected windows unaligned. It will, however, pop right back
250 ;; when it is selected.)
251
252 ;;}}}
253 ;;{{{ Change Log
254
255 ;;; Change log:
256 ;; 25-May-95 andersl * File created.
257 ;; 26-May-95 andersl * It works!
258 ;; 27-May-95 andersl * Avoids hitting the head in the roof.
259 ;; * follow-scroll-up, -scroll-down, and -recenter.
260 ;; * V0.1 Sent to Ohio.
261 ;; 28-May-95 andersl * Scroll-bar support added.
262 ;; 30-May-95 andersl * Code adopted to standard style.
263 ;; * Minor mode keymap.
264 ;; 2-Jun-95 andersl * Processor output.
265 ;; 3-Jun-95 andersl * V0.4
266 ;; 5-Jun-95 andersl * V0.5. Copyright notice corrected.
267 ;; (The old one stated that I had copyright, but
268 ;; that Emacs could be freely distributed ;-) )
269 ;; 6-Jun-95 andersl * Lucid support added. (no longer valid.)
270 ;; 7-Jun-95 andersl * Menu bar added.
271 ;; * Bug fix, (at-window 0 0) => (frame-first-window)
272 ;; 15-Jun-95 andersl * 0.8 Major rework. looong lines and outline mode.
273 ;; 18-Jun-95 andersl * 0.9 Allow a tail window to be selected, but pick
274 ;; a better one when edited.
275 ;; 26-Jun-95 andersl * Inlineing.
276 ;; 02-Jul-95 andersl * compute-motion imitated with a ugly workaround,
277 ;; Works with XEmacs again!
278 ;; 15-Jul-95 andersl * find-file hook.
279 ;; * submit-feedback.
280 ;; * Survives major mode changes.
281 ;; * Region spanning multiple windows looks
282 ;; reasonably good.
283 ;; 19-Jul-95 andersl * New process-filter handling.
284 ;; 1-Aug-95 andersl * XEmacs scrollbar support.
285 ;; * Emacs 19 `window-size-change' support.
286 ;; * `save-window-excursion' removed, it triggered
287 ;; a redraw!
288 ;; 5-Aug-95 andersl * `follow-switch-to-current-buffer-all' added.
289 ;; 16-Nov-95 andersl * V1.0 released!
290 ;; 17-Nov-95 andersl * Byte compiler silencer for XEmacs broken.
291 ;; * fkey-end-of-buffer treated the same way
292 ;; end-of-buffer is.
293 ;; * follow-mode-off-hook added.
294 ;; (Suggested by David Hughes, thanks!)
295 ;; 20-Nov-95 andersl * Bug in menu code corrected.
296 ;; (Reported by Robert E. Brown, thanks!)
297 ;; 5-Dec-95 andersl * `follow-avoid-tail-recenter' added to the
298 ;; post-command-idle-hook to avoid recentering
299 ;; caused by `paren' et. al.
300 ;; 7-Dec-95 andersl * `follow-avoid-tail-recenter' called by
301 ;; `window-scroll-functions'.
302 ;; 18-Dec-95 andersl * All processes intercepted.
303 ;; 20-Dec-95 andersl * `follow-recenter' accepts arguments.
304 ;; * `move-overlay' advices, drag-region works.
305 ;; 2-Jan-96 andersl * XEmacs: isearch fixed.
306 ;; * `follow-calc-win-end' created.
307 ;; 8-Jan-96 andersl * XEmacs: `window-end' with `guarantee'
308 ;; argument used in `follow-calc-win-end'.
309 ;; 9-Jan-96 andersl * `follow-end-of-buffer' added.
310 ;; Code in post hook removed.
311 ;; * XEmacs: Post hook is always executed
312 ;; after a mouse button event.
313 ;; 22-Jan-96 andersl * 1.5 released.
314 ;;
315
316 ;;}}}
317 ;;{{{ LCD Entry
318
319 ;;; LCD Archive Entry:
320 ;; follow|Anders Lindgren|andersl@csd.uu.se|
321 ;; Combines windows into tall virtual window, minor mode.
322 ;; 20-Feb-1996|1.6|~/modes/follow.el.Z|
323
324 ;;}}}
325
326 ;;; Code:
327
328 ;;{{{ Preliminaries
329
330 ;; Make the compiler shut up!
331 ;; There are two strategies:
332 ;; 1) Shut warnings off completely.
333 ;; 2) Handle each warning separately.
334 ;;
335 ;; Since I would like to see real errors, I've selected the latter
336 ;; method.
337 ;;
338 ;; The problem with undefined variables and functions has been solved
339 ;; by using `set', `symbol-value' and `symbol-function' rather than
340 ;; `setq' and direct references to variables and functions.
341 ;;
342 ;; For example:
343 ;; (if (boundp 'foo) ... (symbol-value 'foo) )
344 ;; (set 'foo ...) <-- XEmacs doesn't fall for this one.
345 ;; (funcall (symbol-function 'set) 'bar ...)
346 ;;
347 ;; Note: When this file is interpreted, `eval-when-compile' is
348 ;; evaluted (really smart...) Since it doesn't hurt to evaluate it,
349 ;; but it is a bit annoying, we test if the byte-compiler has been
350 ;; loaded. This can, of course, lead to some occasional unintended
351 ;; evaluation...
352 ;;
353 ;; Should someone come up with a better solution, please let me
354 ;; know.
355
356 (eval-when-compile
357 (if (or (featurep 'bytecomp)
358 (featurep 'byte-compile))
359 (cond ((string-match "XEmacs" emacs-version)
360 ;; Make XEmacs shut up! I'm using standard Emacs
361 ;; functions, they are NOT obsolete!
362 (if (eq (get 'force-mode-line-update 'byte-compile)
363 'byte-compile-obsolete)
364 (put 'force-mode-line-update 'byte-compile 'nil))
365 (if (eq (get 'frame-first-window 'byte-compile)
366 'byte-compile-obsolete)
367 (put 'frame-first-window 'byte-compile 'nil))))))
368
369 ;;}}}
370 ;;{{{ Variables
371
372 (defvar follow-mode nil
373 "Variable indicating if Follow mode is active.")
374
375 (defvar follow-mode-hook nil
376 "*Hooks to run when follow-mode is turned on.")
377
378 (defvar follow-mode-off-hook nil
379 "*Hooks to run when follow-mode is turned off.")
380
381 (defvar follow-mode-version "follow.el (Release 1.6)"
382 "The current version of Follow mode.")
383
384 (defvar follow-mode-map nil
385 "*Minor mode keymap for Follow mode.")
386
387 (defvar follow-mode-line-text " Follow"
388 "*Text shown in the mode line when Follow mode is active.
389 Defaults to \" Follow\". Examples of other values
390 are \" Fw\", or simply \"\".")
391
392 (defvar follow-auto nil
393 "*Non-nil activates Follow mode whenever a file is loaded.")
394
395 (defvar follow-mode-prefix "\C-c."
396 "*Prefix key to use for follow commands in Follow mode.
397 The value of this variable is checked as part of loading Follow mode.
398 After that, changing the prefix key requires manipulating keymaps.")
399
400 (defvar follow-intercept-processes t
401 "*When non-nil, Follow Mode will monitor process output.")
402
403 (defvar follow-emacs-version-xemacs-p
404 (string-match "XEmacs" emacs-version)
405 "Non-nil when running under XEmacs.")
406
407 (defvar follow-avoid-tail-recenter-p
408 (not follow-emacs-version-xemacs-p)
409 "*When non-nil, patch emacs so that tail windows won't be recentered.
410
411 A \"tail window\" is a window which displays only the end of
412 the buffer. Normally it is practical for the user that empty
413 windows are recentered automatically. However, when using
414 Follow Mode it breaks the display when the end is displayed
415 in a window \"above\" the last window. This is for
416 example the case when displaying a short page in info.
417
418 Must be set before Follow Mode is loaded.
419
420 Please note that it is not possible to fully prevent Emacs from
421 recentering empty windows. Please report if you find a repeatable
422 situation in which Emacs recenters empty windows.
423
424 XEmacs, as of 19.12, does not recenter windows, good!")
425
426 (defvar follow-cache-command-list
427 '(next-line previous-line forward-char backward-char)
428 "List of commands which don't require recalculation.
429
430 In order to be able to use the cache, a command should not change the
431 contents of the buffer, nor should it change selected window or current
432 buffer.
433
434 The commands in this list are checked at load time.
435
436 To mark other commands as suitable for caching, set the symbol
437 property `follow-mode-use-cache' to non-nil.")
438
439 (defvar follow-debug nil
440 "*Non-nil when debugging Follow mode.")
441
442
443 ;; Internal variables:
444
445 (defvar follow-internal-force-redisplay nil
446 "True when Follow mode should redisplay the windows.")
447
448 (defvar follow-process-filter-alist '()
449 "The original filters for processes intercepted by Follow mode.")
450
451 (defvar follow-active-menu nil
452 "The menu visible when Follow mode is active.")
453
454 (defvar follow-deactive-menu nil
455 "The menu visible when Follow mode is deactivated.")
456
457 (defvar follow-inside-post-command-hook nil
458 "Non-nil when inside Follow modes `post-command-hook'.
459 Used by `follow-window-size-change'.")
460
461 (defvar follow-windows-start-end-cache nil
462 "Cache used by `follow-window-start-end'.")
463
464 ;;}}}
465 ;;{{{ Bug report
466
467 (eval-when-compile (require 'reporter))
468
469 (defun follow-submit-feedback ()
470 "Submit feedback on Follow mode to the author: andersl@csd.uu.se"
471 (interactive)
472 (require 'reporter)
473 (and (y-or-n-p "Do you really want to submit a report on Follow mode? ")
474 (reporter-submit-bug-report
475 "Anders Lindgren <andersl@csd.uu.se>"
476 follow-mode-version
477 '(post-command-hook
478 post-command-idle-hook
479 pre-command-hook
480 window-size-change-functions
481 window-scroll-functions
482 follow-mode-hook
483 follow-mode-off-hook
484 follow-auto
485 follow-intercept-processes
486 follow-avoid-tail-recenter-p
487 follow-process-filter-alist)
488 nil
489 nil
490 (concat
491 "Hi Anders!\n\n"
492 "(I have read the section on how to report bugs in the "
493 "Emacs manual.)\n\n"
494 "Even though I know you are busy, I thought you might "
495 "want to know...\n\n"))))
496
497 ;;}}}
498 ;;{{{ Debug messages
499
500 ;; This inline function must be as small as possible!
501 ;; Maybe we should define a macro which expands to nil if
502 ;; the variable is not set.
503
504 (defsubst follow-debug-message (&rest args)
505 "Like message, but only active when `follow-debug' is non-nil."
506 (if (and (boundp 'follow-debug) follow-debug)
507 (apply 'message args)))
508
509 ;;}}}
510
511 ;;{{{ Keymap/Menu
512
513 ;;; Define keys for the follow-mode minor mode map and replace some
514 ;;; functions in the global map. All `follow' mode special functions
515 ;;; can be found on (the somewhat cumbersome) "C-c . <key>"
516 ;;; (Control-C dot <key>). (As of Emacs 19.29 the keys
517 ;;; C-c <punctuation character> are reserved for minor modes.)
518 ;;;
519 ;;; To change the prefix, redefine `follow-mode-prefix' before
520 ;;; `follow' is loaded, or see the section on `follow-mode-hook'
521 ;;; above for an example of how to bind the keys the way you like.
522 ;;;
523 ;;; Please note that the keymap is defined the first time this file is
524 ;;; loaded. Also note that the only legal way to manipulate the
525 ;;; keymap is to use `define-key'. Don't change it using `setq' or
526 ;;; similar!
527
528
529 (if follow-mode-map
530 nil
531 (setq follow-mode-map (make-sparse-keymap))
532 (let ((map (make-sparse-keymap)))
533 (define-key map "\C-v" 'follow-scroll-up)
534 (define-key map "\M-v" 'follow-scroll-down)
535 (define-key map "v" 'follow-scroll-down)
536 (define-key map "1" 'follow-delete-other-windows-and-split)
537 (define-key map "b" 'follow-switch-to-buffer)
538 (define-key map "\C-b" 'follow-switch-to-buffer-all)
539 (define-key map "\C-l" 'follow-recenter)
540 (define-key map "<" 'follow-first-window)
541 (define-key map ">" 'follow-last-window)
542 (define-key map "n" 'follow-next-window)
543 (define-key map "p" 'follow-previous-window)
544
545 (define-key follow-mode-map follow-mode-prefix map)
546
547 ;; Replace the standard `end-of-buffer', when in Follow Mode. (I
548 ;; don't see the point in trying to replace every function which
549 ;; could be enhanced in Follow mode. End-of-buffer is a special
550 ;; case since it is very simple to define and it greatly enhances
551 ;; the look and feel of Follow mode.)
552 ;;
553 ;; (The function `substitute-key-definition' does not work
554 ;; in all versions of Emacs.)
555 (mapcar
556 (function
557 (lambda (pair)
558 (let ((old (car pair))
559 (new (cdr pair)))
560 (mapcar (function (lambda (key)
561 (define-key follow-mode-map key new)))
562 (where-is-internal old global-map)))))
563 '((end-of-buffer . follow-end-of-buffer)
564 (fkey-end-of-buffer . follow-end-of-buffer)))
565
566 ;;;
567 ;;; The menu.
568 ;;;
569
570 (if (not follow-emacs-version-xemacs-p)
571
572 ;;
573 ;; Emacs 19
574 ;;
575 (let ((menumap (funcall (symbol-function 'make-sparse-keymap)
576 "Follow"))
577 (count 0)
578 id)
579 (mapcar
580 (function
581 (lambda (item)
582 (setq id
583 (or (cdr item)
584 (progn
585 (setq count (+ count 1))
586 (intern (format "separator-%d" count)))))
587 (define-key menumap (vector id) item)
588 (or (eq id 'follow-mode)
589 (put id 'menu-enable 'follow-mode))))
590 ;; In reverse order:
591 '(("Toggle Follow mode" . follow-mode)
592 ("--")
593 ("Recenter" . follow-recenter)
594 ("--")
595 ("Previous Window" . follow-previous-window)
596 ("Next Windows" . follow-next-window)
597 ("Last Window" . follow-last-window)
598 ("First Window" . follow-first-window)
599 ("--")
600 ("Switch To Buffer (all windows)"
601 . follow-switch-to-buffer-all)
602 ("Switch To Buffer" . follow-switch-to-buffer)
603 ("--")
604 ("Delete Other Windows and Split"
605 . follow-delete-other-windows-and-split)
606 ("--")
607 ("Scroll Down" . follow-scroll-down)
608 ("Scroll Up" . follow-scroll-up)))
609
610 ;; If there is a `tools' meny, we use it. However, we can't add a
611 ;; minor-mode specific item to it (it's broken), so we make the
612 ;; contents ghosted when not in use, and add ourselves to the
613 ;; global map. If no `tools' menu is present, just make a
614 ;; top-level menu visible when the mode is activated.
615
616 (let ((tools-map (lookup-key (current-global-map) [menu-bar tools]))
617 (last nil))
618 (if (sequencep tools-map)
619 (progn
620 ;; Find the last entry in the menu and store it in `last'.
621 (mapcar (function
622 (lambda (x)
623 (setq last (or (cdr-safe
624 (cdr-safe
625 (cdr-safe x)))
626 last))))
627 tools-map)
628 (if last
629 (progn
630 (funcall (symbol-function 'define-key-after)
631 tools-map [separator-follow] '("--") last)
632 (funcall (symbol-function 'define-key-after)
633 tools-map [follow] (cons "Follow" menumap)
634 'separator-follow))
635 ;; Didn't find the last item, Adding to the top of
636 ;; tools. (This will probably never happend...)
637 (define-key (current-global-map) [menu-bar tools follow]
638 (cons "Follow" menumap))))
639 ;; No tools menu, add "Follow" to the menubar.
640 (define-key follow-mode-map [menu-bar follow]
641 (cons "Follow" menumap)))))
642
643 ;;
644 ;; XEmacs.
645 ;;
646
647 ;; place the menu in the `Tools' menu.
648 (let ((menu '("Follow"
649 :filter follow-menu-filter
650 ["Scroll Up" follow-scroll-up t]
651 ["Scroll Down" follow-scroll-down t]
652 ["Delete Other Windows and Split"
653 follow-delete-other-windows-and-split t]
654 ["Switch To Buffer" follow-switch-to-buffer t]
655 ["Switch To Buffer (all windows)"
656 follow-switch-to-buffer-all t]
657 ["First Window" follow-first-window t]
658 ["Last Window" follow-last-window t]
659 ["Next Windows" follow-next-window t]
660 ["Previous Window" follow-previous-window t]
661 ["Recenter" follow-recenter t]
662 ["Deactivate" follow-mode t])))
663
664 ;; Why not just `(set-buffer-menubar current-menubar)'? The
665 ;; question is a very good question. The reason is that under
666 ;; Emacs 19, neither `set-buffer-menubar' nor
667 ;; `current-menubar' is defined, hence the byte-compiler will
668 ;; warn.
669 (funcall (symbol-function 'set-buffer-menubar)
670 (symbol-value 'current-menubar))
671 (funcall (symbol-function 'add-submenu) '("Tools") menu))
672
673 ;; When the mode is not activated, only one item is visible:
674 ;; "Activate".
675 (defun follow-menu-filter (menu)
676 (if follow-mode
677 menu
678 '(["Activate " follow-mode t]))))))
679
680
681 ;;; Register the follow mode keymap.
682 (or (assq 'follow-mode minor-mode-map-alist)
683 (setq minor-mode-map-alist
684 (cons (cons 'follow-mode follow-mode-map) minor-mode-map-alist)))
685
686 ;;}}}
687 ;;{{{ Cache
688
689 (let ((cmds follow-cache-command-list))
690 (while cmds
691 (put (car cmds) 'follow-mode-use-cache t)
692 (setq cmds (cdr cmds))))
693
694 ;;}}}
695
696 ;;{{{ The mode
697
698 ;;;###autoload
699 (defun turn-on-follow-mode ()
700 "Turn on Follow mode. Please see the function `follow-mode'."
701 (interactive)
702 (follow-mode 1))
703
704
705 ;;;###autoload
706 (defun turn-off-follow-mode ()
707 "Turn off Follow mode. Please see the function `follow-mode'."
708 (interactive)
709 (follow-mode -1))
710
711
712 ;;;###autoload
713 (defun follow-mode (arg)
714 "Minor mode which combines windows into one tall virtual window.
715
716 The feeling of a \"virtual window\" has been accomplished by the use
717 of two major techniques:
718
719 * The windows always displays adjacent sections of the buffer.
720 This means that whenever one window is moved, all the
721 others will follow. (Hence the name Follow Mode.)
722
723 * Should the point (cursor) end up outside a window, another
724 window displaying that point is selected, if possible. This
725 makes it possible to walk between windows using normal cursor
726 movement commands.
727
728 Follow mode comes to its prime when used on a large screen and two
729 side-by-side window are used. The user can, with the help of Follow
730 mode, use two full-height windows as though they would have been
731 one. Imagine yourself editing a large function, or section of text,
732 and being able to use 144 lines instead of the normal 72... (your
733 mileage may vary).
734
735 To split one large window into two side-by-side windows, the commands
736 `\\[split-window-horizontally]' or \
737 `M-x follow-delete-other-windows-and-split' can be used.
738
739 Only windows displayed in the same frame follow each-other.
740
741 If the variable `follow-intercept-processes' is non-nil, Follow mode
742 will listen to the output of processes and redisplay accordingly.
743 \(This is the default.)
744
745 When Follow mode is switched on, the hook `follow-mode-hook'
746 is called. When turned off, `follow-mode-off-hook' is called.
747
748 Keys specific to Follow mode:
749 \\{follow-mode-map}"
750 (interactive "P")
751 (make-local-variable 'follow-mode)
752 (put 'follow-mode 'permanent-local t)
753 (let ((follow-mode-orig follow-mode))
754 (setq follow-mode
755 (if (null arg)
756 (not follow-mode)
757 (> (prefix-numeric-value arg) 0)))
758 (if (and follow-mode follow-intercept-processes)
759 (follow-intercept-process-output))
760 (cond ((and follow-mode (not follow-mode-orig)) ; On
761 ;; XEmacs: If this is non-nil, the window will scroll before
762 ;; the point will have a chance to get into the next window.
763 (if (boundp 'scroll-on-clipped-lines)
764 (set 'scroll-on-clipped-lines nil))
765 (force-mode-line-update)
766 (add-hook 'post-command-hook 'follow-post-command-hook t)
767 (if (boundp 'post-command-idle-hook)
768 (add-hook 'post-command-idle-hook
769 'follow-avoid-tail-recenter t))
770 (run-hooks 'follow-mode-hook))
771
772 ((and (not follow-mode) follow-mode-orig) ; Off
773 (force-mode-line-update)
774 (run-hooks 'follow-mode-off-hook)))))
775
776
777 ;; Register follow-mode as a minor mode.
778
779 (if (fboundp 'add-minor-mode)
780 ;; XEmacs
781 (funcall (symbol-function 'add-minor-mode)
782 'follow-mode 'follow-mode-line-text)
783 (or (assq 'follow-mode minor-mode-alist)
784 (setq minor-mode-alist
785 (cons '(follow-mode follow-mode-line-text) minor-mode-alist))))
786
787 ;;}}}
788 ;;{{{ Find file hook
789
790 ;; This will start follow-mode whenever a new file is loaded, if
791 ;; the variable `follow-auto' is non-nil.
792
793 (add-hook 'find-file-hooks 'follow-find-file-hook t)
794
795 (defun follow-find-file-hook ()
796 "Find-file hook for Follow Mode. See the variable `follow-auto'."
797 (if follow-auto (follow-mode t)))
798
799 ;;}}}
800
801 ;;{{{ User functions
802
803 ;;;
804 ;;; User functions usable when in Follow mode.
805 ;;;
806
807 ;;{{{ Scroll
808
809 ;; `scroll-up' and `-down', but for windows in Follow Mode.
810 ;;
811 ;; Almost like the real thing, excpet when the cursor ends up outside
812 ;; the top or bottom... In our case however, we end up outside the
813 ;; window and hence we are recenterd. Should we let `recenter' handle
814 ;; the point position we would never leave the selected window. To do
815 ;; it ourselves we would need to do our own redisplay, which is easier
816 ;; said than done. (Why didn't I do a real display abstraction from
817 ;; the beginning?)
818 ;;
819 ;; We must sometimes set `follow-internal-force-redisplay', otherwise
820 ;; our post-command-hook will move our windows back into the old
821 ;; position... (This would also be corrected if we would have had a
822 ;; good redisplay abstraction.)
823
824 (defun follow-scroll-up (&optional arg)
825 "Scroll text in a Follow Mode window chain up.
826
827 If called with no ARG, the `next-screen-context-lines' last lines of
828 the bottom window in the chain will be visible in the top window.
829
830 If called with an argument, scroll ARG lines up.
831 Negative ARG means scroll downward.
832
833 Works like `scroll-up' when not in Follow Mode."
834 (interactive "P")
835 (cond ((not (and (boundp 'follow-mode) follow-mode))
836 (scroll-up arg))
837 (arg
838 (save-excursion (scroll-up arg))
839 (setq follow-internal-force-redisplay t))
840 (t
841 (let* ((windows (follow-all-followers))
842 (end (window-end (car (reverse windows)))))
843 (if (eq end (point-max))
844 (signal 'end-of-buffer nil)
845 (select-window (car windows))
846 (goto-char end)
847 (vertical-motion (- next-screen-context-lines))
848 (set-window-start (car windows) (point)))))))
849
850
851 (defun follow-scroll-down (&optional arg)
852 "Scroll text in a Follow Mode window chain down.
853
854 If called with no ARG, the `next-screen-context-lines' top lines of
855 the top window in the chain will be visible in the bottom window.
856
857 If called with an argument, scroll ARG lines down.
858 Negative ARG means scroll upward.
859
860 Works like `scroll-up' when not in Follow Mode."
861 (interactive "P")
862 (cond ((not (and (boundp 'follow-mode) follow-mode))
863 (scroll-up arg))
864 (arg
865 (save-excursion (scroll-down arg)))
866 (t
867 (let* ((windows (follow-all-followers))
868 (win (car (reverse windows)))
869 (start (window-start (car windows))))
870 (if (eq start (point-min))
871 (signal 'beginning-of-buffer nil)
872 (select-window win)
873 (goto-char start)
874 (vertical-motion (- (- (window-height win)
875 1
876 next-screen-context-lines)))
877 (set-window-start win (point))
878 (goto-char start)
879 (vertical-motion (- next-screen-context-lines 1))
880 (setq follow-internal-force-redisplay t))))))
881
882 ;;}}}
883 ;;{{{ Buffer
884
885 ;;;###autoload
886 (defun follow-delete-other-windows-and-split (&optional arg)
887 "Create two side by side windows and enter Follow Mode.
888
889 Execute this command to display as much as possible of the text
890 in the selected window. All other windows, in the current
891 frame, are deleted and the selected window is split in two
892 side-by-side windows. Follow Mode is activated, hence the
893 two windows always will display two successive pages.
894 \(If one window is moved, the other one will follow.)
895
896 If ARG is positive, the leftmost window is selected. If it negative,
897 the rightmost is selected. If ARG is nil, the leftmost window is
898 selected if the original window is the first one in the frame.
899
900 To bind this command to a hotkey, place the following line
901 in your `~/.emacs' file, replacing [f7] by your favourite key:
902 (global-set-key [f7] 'follow-delete-other-windows-and-split)"
903 (interactive "P")
904 (let ((other (or (and (null arg)
905 (not (eq (selected-window)
906 (frame-first-window (selected-frame)))))
907 (and arg
908 (< (prefix-numeric-value arg) 0))))
909 (start (window-start)))
910 (delete-other-windows)
911 (split-window-horizontally)
912 (if other
913 (progn
914 (other-window 1)
915 (set-window-start (selected-window) start)
916 (setq follow-internal-force-redisplay t)))
917 (follow-mode 1)))
918
919 (defun follow-switch-to-buffer (buffer)
920 "Show BUFFER in all windows in the current Follow Mode window chain."
921 (interactive "BSwitch to Buffer: ")
922 (let ((orig-window (selected-window))
923 (windows (follow-all-followers)))
924 (while windows
925 (select-window (car windows))
926 (switch-to-buffer buffer)
927 (setq windows (cdr windows)))
928 (select-window orig-window)))
929
930
931 (defun follow-switch-to-buffer-all (&optional buffer)
932 "Show BUFFER in all windows on this frame.
933 Defaults to current buffer."
934 (interactive (list (read-buffer "Switch to Buffer: "
935 (current-buffer))))
936 (or buffer (setq buffer (current-buffer)))
937 (let ((orig-window (selected-window)))
938 (walk-windows
939 (function
940 (lambda (win)
941 (select-window win)
942 (switch-to-buffer buffer))))
943 (select-window orig-window)
944 (follow-redisplay)))
945
946
947 (defun follow-switch-to-current-buffer-all ()
948 "Show current buffer in all windows on this frame, and enter Follow Mode.
949
950 To bind this command to a hotkey place the following line
951 in your `~/.emacs' file:
952 (global-set-key [f7] 'follow-switch-to-current-buffer-all)"
953 (interactive)
954 (or (and (boundp 'follow-mode) follow-mode)
955 (follow-mode 1))
956 (follow-switch-to-buffer-all))
957
958 ;;}}}
959 ;;{{{ Movement
960
961 ;; Note, these functions are not very useful, atleast not unless you
962 ;; rebind the rather cumbersome key sequence `C-c . p'.
963
964 (defun follow-next-window ()
965 "Select the next window showing the same buffer."
966 (interactive)
967 (let ((succ (cdr (follow-split-followers (follow-all-followers)))))
968 (if succ
969 (select-window (car succ))
970 (error "%s" "No more windows"))))
971
972
973 (defun follow-previous-window ()
974 "Select the previous window showing the same buffer."
975 (interactive)
976 (let ((pred (car (follow-split-followers (follow-all-followers)))))
977 (if pred
978 (select-window (car pred))
979 (error "%s" "No more windows"))))
980
981
982 (defun follow-first-window ()
983 "Select the first window in the frame showing the same buffer."
984 (interactive)
985 (select-window (car (follow-all-followers))))
986
987
988 (defun follow-last-window ()
989 "Select the last window in the frame showing the same buffer."
990 (interactive)
991 (select-window (car (reverse (follow-all-followers)))))
992
993 ;;}}}
994 ;;{{{ Redraw
995
996 (defun follow-recenter (&optional arg)
997 "Recenter the middle window around point.
998 Rearrange all other windows around the middle window.
999
1000 With a positive argument, place the current line ARG lines
1001 from the top. With a negative, place it -ARG lines from the
1002 bottom."
1003 (interactive "P")
1004 (if arg
1005 (let ((p (point))
1006 (arg (prefix-numeric-value arg)))
1007 (if (>= arg 0)
1008 ;; Recenter relative to the top.
1009 (progn
1010 (follow-first-window)
1011 (goto-char p)
1012 (recenter arg))
1013 ;; Recenter relative to the bottom.
1014 (follow-last-window)
1015 (goto-char p)
1016 (recenter arg)
1017 ;; Otherwise, our post-command-hook will move the window
1018 ;; right back.
1019 (setq follow-internal-force-redisplay t)))
1020 ;; Recenter in the middle.
1021 (let* ((dest (point))
1022 (windows (follow-all-followers))
1023 (win (nth (/ (- (length windows) 1) 2) windows)))
1024 (select-window win)
1025 (goto-char dest)
1026 (recenter)
1027 ;;(setq follow-internal-force-redisplay t)
1028 )))
1029
1030
1031 (defun follow-redraw ()
1032 "Arrange windows displaying the same buffer in successor order.
1033 This function can be called even if the buffer is not in Follow mode.
1034
1035 Hopefully, there should be no reason to call this function when in
1036 Follow mode since the windows should always be aligned."
1037 (interactive)
1038 (sit-for 0)
1039 (follow-redisplay))
1040
1041 ;;}}}
1042 ;;{{{ End of buffer
1043
1044 (defun follow-end-of-buffer (&optional arg)
1045 "Move point to the end of the buffer, Follow Mode style.
1046
1047 If the end is not visible, it will be displayed in the last possible
1048 window in the Follow Mode window chain.
1049
1050 The mark is left at the previous position. With arg N, put point N/10
1051 of the way from the true end."
1052 (interactive "P")
1053 (let ((followers (follow-all-followers))
1054 (pos (point)))
1055 (cond (arg
1056 (select-window (car (reverse followers))))
1057 ((follow-select-if-end-visible
1058 (follow-windows-start-end followers)))
1059 (t
1060 (select-window (car (reverse followers)))))
1061 (goto-char pos)
1062 (end-of-buffer arg)))
1063
1064 ;;}}}
1065
1066 ;;}}}
1067
1068 ;;{{{ Display
1069
1070 ;;;; The display routines
1071
1072 ;;{{{ Information gathering functions
1073
1074 (defun follow-all-followers (&optional testwin)
1075 "Return all windows displaying the same buffer as the TESTWIN.
1076 The list contains only windows displayed in the same frame as TESTWIN.
1077 If TESTWIN is nil the selected window is used."
1078 (or (and testwin (window-live-p testwin))
1079 (setq testwin (selected-window)))
1080 (let* ((top (frame-first-window (window-frame testwin)))
1081 (win top)
1082 (done nil)
1083 (windows '())
1084 (buffer (window-buffer testwin)))
1085 (while (and (not done) win)
1086 (if (eq (window-buffer win) buffer)
1087 (setq windows (cons win windows)))
1088 (setq win (next-window win 'not))
1089 (if (eq win top)
1090 (setq done t)))
1091 (nreverse windows)))
1092
1093
1094 (defun follow-split-followers (windows &optional win)
1095 "Split the WINDOWS into the sets: predecessors and successors.
1096 Return `(PRED . SUCC)' where `PRED' and `SUCC' are ordered starting
1097 from the selected window."
1098 (or win
1099 (setq win (selected-window)))
1100 (let ((pred '()))
1101 (while (not (eq (car windows) win))
1102 (setq pred (cons (car windows) pred))
1103 (setq windows (cdr windows)))
1104 (cons pred (cdr windows))))
1105
1106
1107 ;; Try to optimize this function for speed!
1108
1109 (defun follow-calc-win-end (&optional win)
1110 "Calculate the presumed window end for WIN.
1111
1112 Actually, the position returned is the start of the next
1113 window, normally is the end plus one.
1114
1115 If WIN is nil, the selected window is used.
1116
1117 Returns (end-pos end-of-buffer-p)"
1118 (if follow-emacs-version-xemacs-p
1119 ;; XEmacs can calculate the end of the window by using
1120 ;; the 'guarantee options. GOOD!
1121 (let ((end (window-end win t)))
1122 (if (= end (funcall (symbol-function 'point-max)
1123 (window-buffer win)))
1124 (list end t)
1125 (list (+ end 1) nil)))
1126 ;; Emacs 19: We have to calculate the end by ourselves.
1127 ;; This code works on both XEmacs and Emacs 19, but now
1128 ;; that XEmacs has got custom-written code, this could
1129 ;; be optimized for Emacs 19.
1130 (let ((orig-win (and win (selected-window)))
1131 height
1132 buffer-end-p)
1133 (if win (select-window win))
1134 (prog1
1135 (save-excursion
1136 (goto-char (window-start))
1137 (setq height (- (window-height) 1))
1138 (setq buffer-end-p
1139 (if (bolp)
1140 (not (= height (vertical-motion height)))
1141 (save-restriction
1142 ;; Fix a mis-feature in `vertical-motion':
1143 ;; The start of the window is assumed to
1144 ;; coinside with the start of a line.
1145 (narrow-to-region (point) (point-max))
1146 (not (= height (vertical-motion height))))))
1147 (list (point) buffer-end-p))
1148 (if orig-win
1149 (select-window orig-win))))))
1150
1151
1152 ;; Can't use `save-window-excursion' since it triggers a redraw.
1153 (defun follow-calc-win-start (windows pos win)
1154 "Calculate where WIN will start if the first in WINDOWS start at POS.
1155
1156 If WIN is nil the point below all windows is returned."
1157 (let (start)
1158 (while (and windows (not (eq (car windows) win)))
1159 (setq start (window-start (car windows)))
1160 (set-window-start (car windows) pos 'noforce)
1161 (setq pos (car (inline (follow-calc-win-end (car windows)))))
1162 (set-window-start (car windows) start 'noforce)
1163 (setq windows (cdr windows)))
1164 pos))
1165
1166
1167 ;; The result from `follow-windows-start-end' is cached when using
1168 ;; a handful simple commands, like cursor movement commands.
1169
1170 (defsubst follow-cache-valid-p (windows)
1171 "Test if the cached value of `follow-windows-start-end' can be used.
1172 Note that this handles the case when the cache has been set to nil."
1173 (let ((res t)
1174 (cache follow-windows-start-end-cache))
1175 (while (and res windows cache)
1176 (setq res (and (eq (car windows)
1177 (car (car cache)))
1178 (eq (window-start (car windows))
1179 (car (cdr (car cache))))))
1180 (setq windows (cdr windows))
1181 (setq cache (cdr cache)))
1182 (and res (null windows) (null cache))))
1183
1184
1185 (defsubst follow-invalidate-cache ()
1186 "Force `follow-windows-start-end' to recalculate the end of the window."
1187 (setq follow-windows-start-end-cache nil))
1188
1189
1190 ;; Build a list of windows and their start and end positions.
1191 ;; Useful to avoid calculating start/end position whenever they are needed.
1192 ;; The list has the format:
1193 ;; ((Win Start End End-of-buffer-visible-p) ...)
1194
1195 ;; Used to have a `save-window-excursion', but it obviously triggered
1196 ;; redraws of the display. Check if I used it for anything.
1197
1198
1199 (defun follow-windows-start-end (windows)
1200 "Builds a list of (WIN START END BUFFER-END-P) for every window in WINDOWS."
1201 (if (follow-cache-valid-p windows)
1202 follow-windows-start-end-cache
1203 (let ((win-start-end '())
1204 (orig-win (selected-window)))
1205 (while windows
1206 (select-window (car windows))
1207 (setq win-start-end
1208 (cons (cons (car windows)
1209 (cons (window-start)
1210 (follow-calc-win-end)))
1211 win-start-end))
1212 (setq windows (cdr windows)))
1213 (select-window orig-win)
1214 (setq follow-windows-start-end-cache (nreverse win-start-end))
1215 follow-windows-start-end-cache)))
1216
1217
1218 (defsubst follow-pos-visible (pos win win-start-end)
1219 "Non-nil when POS is visible in WIN."
1220 (let ((wstart-wend-bend (cdr (assq win win-start-end))))
1221 (and (>= pos (car wstart-wend-bend))
1222 (or (< pos (car (cdr wstart-wend-bend)))
1223 (nth 2 wstart-wend-bend)))))
1224
1225
1226 ;; By `aligned' we mean that for all adjecent windows, the end of the
1227 ;; first is equal with the start of the successor. The first window
1228 ;; should start at a full screen line.
1229
1230 (defsubst follow-windows-aligned-p (win-start-end)
1231 "Non-nil if the follower WINDOWS are aligned."
1232 (let ((res t))
1233 (save-excursion
1234 (goto-char (window-start (car (car win-start-end))))
1235 (if (bolp)
1236 nil
1237 (vertical-motion 0 (car (car win-start-end)))
1238 (setq res (eq (point) (window-start (car (car win-start-end)))))))
1239 (while (and res (cdr win-start-end))
1240 ;; At least two followers left
1241 (setq res (eq (car (cdr (cdr (car win-start-end))))
1242 (car (cdr (car (cdr win-start-end))))))
1243 (setq win-start-end (cdr win-start-end)))
1244 res))
1245
1246
1247 ;; Check if the point is visible in all windows. (So that
1248 ;; no one will be recentered.)
1249
1250 (defun follow-point-visible-all-windows-p (win-start-end)
1251 "Non-nil when the window-point is visible in all windows."
1252 (let ((res t))
1253 (while (and res win-start-end)
1254 (setq res (follow-pos-visible (window-point (car (car win-start-end)))
1255 (car (car win-start-end))
1256 win-start-end))
1257 (setq win-start-end (cdr win-start-end)))
1258 res))
1259
1260
1261 ;; Make sure WIN always starts at the beginning of an whole screen
1262 ;; line. If WIN is not aligned the start is updated which probably
1263 ;; will lead to a redisplay of the screen later on.
1264 ;;
1265 ;; This is used with the first window in a follow chain. The reason
1266 ;; is that we want to detect that the point is outside the window.
1267 ;; (Without the update, the start of the window will move as the
1268 ;; user presses BackSpace, and the other window redisplay routines
1269 ;; will move the start of the window in the wrong direction.)
1270
1271 (defun follow-update-window-start (win)
1272 "Make sure that the start of WIN starts at a full screen line."
1273 (save-excursion
1274 (goto-char (window-start win))
1275 (if (bolp)
1276 nil
1277 (vertical-motion 0 win)
1278 (if (eq (point) (window-start win))
1279 nil
1280 (vertical-motion 1 win)
1281 (set-window-start win (point) 'noforce)))))
1282
1283 ;;}}}
1284 ;;{{{ Selection functions
1285
1286 ;; Make a window in WINDOWS selected if it currently
1287 ;; is displaying the position DEST.
1288 ;;
1289 ;; We don't select a window if it just has been moved.
1290
1291 (defun follow-select-if-visible (dest win-start-end)
1292 "Select and return a window, if DEST is visible in it.
1293 Return the selected window."
1294 (let ((win nil))
1295 (while (and (not win) win-start-end)
1296 ;; Don't select a window which was just moved. This makes it
1297 ;; possible to later select the last window after a `end-of-buffer'
1298 ;; command.
1299 (if (follow-pos-visible dest (car (car win-start-end)) win-start-end)
1300 (progn
1301 (setq win (car (car win-start-end)))
1302 (select-window win)))
1303 (setq win-start-end (cdr win-start-end)))
1304 win))
1305
1306
1307 ;; Lets select a window showing the end. Make sure we only select it if it
1308 ;; it wasn't just moved here. (i.e. M-> shall not unconditionally place
1309 ;; the point in the selected window.)
1310 ;;
1311 ;; (Compability cludge: in Emacs 19 `window-end' is equal to `point-max';
1312 ;; in XEmacs, it is equal to `point-max + 1'. Should I really bother
1313 ;; checking `window-end' now when I check `end-of-buffer' explicitly?)
1314
1315 (defun follow-select-if-end-visible (win-start-end)
1316 "Select and return a window, if end is visible in it."
1317 (let ((win nil))
1318 (while (and (not win) win-start-end)
1319 ;; Don't select a window which was just moved. This makes it
1320 ;; possible to later select the last window after a `end-of-buffer'
1321 ;; command.
1322 (if (and (eq (point-max) (nth 2 (car win-start-end)))
1323 (nth 3 (car win-start-end))
1324 (eq (point-max) (min (point-max)
1325 (window-end (car (car win-start-end))))))
1326 (progn
1327 (setq win (car (car win-start-end)))
1328 (select-window win)))
1329 (setq win-start-end (cdr win-start-end)))
1330 win))
1331
1332
1333 ;; Select a window which will display the point if the windows would
1334 ;; be redisplayed with the first window fixed. This is useful for
1335 ;; example when the user has pressed return at the bottom of a window
1336 ;; as the point is not visible in any window.
1337
1338 (defun follow-select-if-visible-from-first (dest windows)
1339 "Select and return a window with DEST, if WINDOWS are redrawn from top."
1340 (let ((win nil)
1341 end-pos-end-p)
1342 (save-excursion
1343 (goto-char (window-start (car windows)))
1344 ;; Make sure the line start in the beginning of a real screen
1345 ;; line.
1346 (vertical-motion 0 (car windows))
1347 (if (< dest (point))
1348 ;; Above the start, not visible.
1349 nil
1350 ;; At or below the start. Check the windows.
1351 (save-window-excursion
1352 (while (and (not win) windows)
1353 (set-window-start (car windows) (point) 'noforce)
1354 (setq end-pos-end-p (follow-calc-win-end (car windows)))
1355 (goto-char (car end-pos-end-p))
1356 ;; Visible, if dest above end, or if eob is visible inside
1357 ;; the window.
1358 (if (or (car (cdr end-pos-end-p))
1359 (< dest (point)))
1360 (setq win (car windows))
1361 (setq windows (cdr windows)))))))
1362 (if win
1363 (select-window win))
1364 win))
1365
1366
1367 ;;}}}
1368 ;;{{{ Redisplay
1369
1370 ;; Redraw all the windows on the screen, starting with the top window.
1371 ;; The window used as as marker is WIN, or the selcted window if WIN
1372 ;; is nil.
1373
1374 (defun follow-redisplay (&optional windows win)
1375 "Reposition the WINDOWS around WIN.
1376 Should the point be too close to the roof we redisplay everything
1377 from the top. WINDOWS should contain a list of windows to
1378 redisplay, it is assumed that WIN is a member of the list.
1379 Should WINDOWS be nil, the windows displaying the
1380 same buffer as WIN, in the current frame, are used.
1381 Should WIN be nil, the selected window is used."
1382 (or win
1383 (setq win (selected-window)))
1384 (or windows
1385 (setq windows (follow-all-followers win)))
1386 (follow-downward windows (follow-calculate-first-window-start windows win)))
1387
1388
1389 ;; Redisplay a chain of windows. Start every window directly after the
1390 ;; end of the previous window, to make sure long lines are displayed
1391 ;; correctly.
1392
1393 (defun follow-downward (windows pos)
1394 "Redisplay all WINDOWS starting at POS."
1395 (while windows
1396 (set-window-start (car windows) pos)
1397 (setq pos (car (follow-calc-win-end (car windows))))
1398 (setq windows (cdr windows))))
1399
1400
1401 ;;(defun follow-downward (windows pos)
1402 ;; "Redisplay all WINDOWS starting at POS."
1403 ;; (let (p)
1404 ;; (while windows
1405 ;; (setq p (window-point (car windows)))
1406 ;; (set-window-start (car windows) pos)
1407 ;; (set-window-point (car windows) (max p pos))
1408 ;; (setq pos (car (follow-calc-win-end (car windows))))
1409 ;; (setq windows (cdr windows)))))
1410
1411
1412 ;; Return the start of the first window.
1413 ;;
1414 ;; First, estimate the position. It the value is not perfect (i.e. we
1415 ;; have somewhere splited a line between windows) we try to enhance
1416 ;; the value.
1417 ;;
1418 ;; The guess is always perfect if no long lines is split between
1419 ;; windows.
1420 ;;
1421 ;; The worst case peformace of probably very bad, but it is very
1422 ;; unlikely that we ever will miss the correct start by more than one
1423 ;; or two lines.
1424
1425 (defun follow-calculate-first-window-start (windows &optional win start)
1426 "Calculate the start of the first window.
1427
1428 WINDOWS is a chain of windows to work with. WIN is the window
1429 to recenter around. It is assumed that WIN starts at position
1430 START."
1431 (or win
1432 (setq win (selected-window)))
1433 (or start
1434 (setq start (window-start win)))
1435 (let ((guess (follow-estimate-first-window-start windows win start)))
1436 (if (car guess)
1437 (cdr guess)
1438 ;; The guess wasn't exact, try to enhance it.
1439 (let ((win-start (follow-calc-win-start windows (cdr guess) win)))
1440 (cond ((= win-start start)
1441 (follow-debug-message "exact")
1442 (cdr guess))
1443 ((< win-start start)
1444 (follow-debug-message "above")
1445 (follow-calculate-first-window-start-from-above
1446 windows (cdr guess) win start))
1447 (t
1448 (follow-debug-message "below")
1449 (follow-calculate-first-window-start-from-below
1450 windows (cdr guess) win start)))))))
1451
1452
1453 ;; `exact' is disabled due to XEmacs and fonts of variable
1454 ;; height.
1455 (defun follow-estimate-first-window-start (windows win start)
1456 "Estimate the position of the first window.
1457
1458 Returns (EXACT . POS). If EXACT is non-nil, POS is the starting
1459 position of the first window. Otherwise it is a good guess."
1460 (let ((pred (car (follow-split-followers windows win)))
1461 (exact nil))
1462 (save-excursion
1463 (goto-char start)
1464 ;(setq exact (bolp))
1465 (vertical-motion 0 win)
1466 (while pred
1467 (vertical-motion (- 1 (window-height (car pred))) (car pred))
1468 (if (not (bolp))
1469 (setq exact nil))
1470 (setq pred (cdr pred)))
1471 (cons exact (point)))))
1472
1473
1474 ;; Find the starting point, start at GUESS and search downward.
1475 ;; The returned point is always a point below GUESS.
1476
1477 (defun follow-calculate-first-window-start-from-above
1478 (windows guess win start)
1479 (save-excursion
1480 (let ((done nil)
1481 win-start
1482 res)
1483 (goto-char guess)
1484 (while (not done)
1485 (if (not (= (vertical-motion 1 (car windows)) 1))
1486 ;; Hit bottom! (Can we really do this?)
1487 ;; We'll keep it, since it ensures termination.
1488 (progn
1489 (setq done t)
1490 (setq res (point-max)))
1491 (setq win-start (follow-calc-win-start windows (point) win))
1492 (if (>= win-start start)
1493 (progn
1494 (setq done t)
1495 (setq res (point))))))
1496 res)))
1497
1498
1499 ;; Find the starting point, start at GUESS and search upward. Return
1500 ;; a point on the same line as GUESS, or above.
1501 ;;
1502 ;; (Is this ever used? I must make sure it works just in case it is
1503 ;; ever called.)
1504
1505 (defun follow-calculate-first-window-start-from-below
1506 (windows guess &optional win start)
1507 (setq win (or win (selected-window)))
1508 (setq start (or start (window-start win)))
1509 (save-excursion
1510 (let ((done nil)
1511 win-start
1512 res)
1513 ;; Always calculate what happend when no line is displayed in the first
1514 ;; window. (The `previous' res is needed below!)
1515 (goto-char guess)
1516 (vertical-motion 0 (car windows))
1517 (setq res (point))
1518 (while (not done)
1519 (if (not (= (vertical-motion -1 (car windows)) -1))
1520 ;; Hit roof!
1521 (progn
1522 (setq done t)
1523 (setq res (point-min)))
1524 (setq win-start (follow-calc-win-start windows (point) win))
1525 (cond ((= win-start start) ; Perfect match, use this value
1526 (setq done t)
1527 (setq res (point)))
1528 ((< win-start start) ; Walked to far, use preious result
1529 (setq done t))
1530 (t ; Store result for next iteration
1531 (setq res (point))))))
1532 res)))
1533
1534 ;;}}}
1535 ;;{{{ Avoid tail recenter
1536
1537 ;; This sets the window internal flag `force_start'. The effect is that
1538 ;; windows only displaying the tail isn't recentered.
1539 ;; Has to be called before every redisplay... (Great isn't it?)
1540 ;;
1541 ;; XEmacs doesn't recenter the tail, GOOD!
1542 ;;
1543 ;; A window displaying only the tail, is a windows whose
1544 ;; window-start position is equal to (point-max) of the buffer it
1545 ;; displays.
1546 ;;
1547 ;; This function is also added to `post-command-idle-hook', introduced
1548 ;; in Emacs 19.30. This is needed since the vaccine injected by the
1549 ;; call from `post-command-hook' only works until the next redisplay.
1550 ;; It is possible that the functions in the `post-command-idle-hook'
1551 ;; can cause a redisplay, and hence a new vaccine is needed.
1552 ;;
1553 ;; Sometimes, calling this function could actually cause a redisplay,
1554 ;; especially if it is placed in the debug filter section. I must
1555 ;; investigate this further...
1556
1557 (defun follow-avoid-tail-recenter (&rest rest)
1558 "Make sure windows displaying the end of a buffer aren't recentered.
1559
1560 This is done by reading and rewriting the start positon of
1561 non-first windows in Follow Mode."
1562 (if follow-avoid-tail-recenter-p
1563 (let* ((orig-buffer (current-buffer))
1564 (top (frame-first-window (selected-frame)))
1565 (win top)
1566 (who '()) ; list of (buffer . frame)
1567 start
1568 pair) ; (buffer . frame)
1569 ;; If the only window in the frame is a minibuffer
1570 ;; window, `next-window' will never find it again...
1571 (if (window-minibuffer-p top)
1572 nil
1573 (while ;; look, no body!
1574 (progn
1575 (setq start (window-start win))
1576 (set-buffer (window-buffer win))
1577 (setq pair (cons (window-buffer win) (window-frame win)))
1578 (if (member pair who)
1579 (if (and (boundp 'follow-mode) follow-mode
1580 (eq (point-max) start))
1581 ;; Write the same window start back, but don't
1582 ;; set the NOFORCE flag.
1583 (set-window-start win start))
1584 (setq who (cons pair who)))
1585 (setq win (next-window win 'not t))
1586 (not (eq win top)))) ;; Loop while this is true.
1587 (set-buffer orig-buffer)))))
1588
1589 ;;}}}
1590
1591 ;;}}}
1592 ;;{{{ Post Command Hook
1593
1594 ;;; The magic little box. This function is called after every command.
1595
1596 ;; This is not as complicated as it seems. It is simply a list of common
1597 ;; display situations and the actions to take, plus commands for redrawing
1598 ;; the screen if it should be unaligned.
1599 ;;
1600 ;; We divide the check into two parts; whether we are at the end or not.
1601 ;; This is due to the fact that the end can actaually be visible
1602 ;; in several window even though they are aligned.
1603
1604 (defun follow-post-command-hook ()
1605 "Ensure that the windows in Follow mode are adjacent after each command."
1606 (setq follow-inside-post-command-hook t)
1607 (if (or (not (input-pending-p))
1608 ;; Sometimes, in XEmacs, mouse events are not handled
1609 ;; properly by `input-pending-p'. A typical example is
1610 ;; when clicking on a node in `info'.
1611 (and (boundp 'current-mouse-event)
1612 (symbol-value 'current-mouse-event)
1613 (fboundp 'button-event-p)
1614 (funcall (symbol-function 'button-event-p)
1615 (symbol-value 'current-mouse-event))))
1616 ;; Work in the selected window, not in the current buffer.
1617 (let ((orig-buffer (current-buffer))
1618 (win (selected-window)))
1619 (set-buffer (window-buffer win))
1620 (or (and (symbolp this-command)
1621 (get this-command 'follow-mode-use-cache))
1622 (follow-invalidate-cache))
1623 (if (and (boundp 'follow-mode) follow-mode
1624 (not (window-minibuffer-p win)))
1625 ;; The buffer shown in the selected window is in follow
1626 ;; mode, lets find the current state of the display and
1627 ;; cache the result for speed (i.e. `aligned' and `visible'.)
1628 (let* ((windows (inline (follow-all-followers win)))
1629 (dest (point))
1630 (win-start-end (inline
1631 (follow-update-window-start (car windows))
1632 (follow-windows-start-end windows)))
1633 (aligned (follow-windows-aligned-p win-start-end))
1634 (visible (follow-pos-visible dest win win-start-end)))
1635 (if (not (and aligned visible))
1636 (follow-invalidate-cache))
1637 (inline (follow-avoid-tail-recenter))
1638 ;; Select a window to display the point.
1639 (or follow-internal-force-redisplay
1640 (progn
1641 (if (eq dest (point-max))
1642 ;; We're at the end, we have be be careful since
1643 ;; the display can be aligned while `dest' can
1644 ;; be visible in several windows.
1645 (cond
1646 ;; Select the current window, but only when
1647 ;; the display is correct. (When inserting
1648 ;; character in a tail window, the display is
1649 ;; not correct, as they are shown twice.)
1650 ;;
1651 ;; Never stick to the current window after a
1652 ;; deletion. The reason is cosmetic, when
1653 ;; typing `DEL' in a window showing only the
1654 ;; end of the file, character are removed
1655 ;; from the window above, which is very
1656 ;; unintuitive.
1657 ((and visible
1658 aligned
1659 (not (memq this-command
1660 '(backward-delete-char
1661 delete-backward-char
1662 backward-delete-char-untabify
1663 kill-region))))
1664 (follow-debug-message "Max: same"))
1665 ;; If the end is visible, and the window
1666 ;; doesn't seems like it just has been moved,
1667 ;; select it.
1668 ((follow-select-if-end-visible win-start-end)
1669 (follow-debug-message "Max: end visible")
1670 (setq visible t)
1671 (setq aligned nil)
1672 (goto-char dest))
1673 ;; Just show the end...
1674 (t
1675 (follow-debug-message "Max: default")
1676 (select-window (car (reverse windows)))
1677 (goto-char dest)
1678 (setq visible nil)
1679 (setq aligned nil)))
1680
1681 ;; We're not at the end, here life is much simpler.
1682 (cond
1683 ;; This is the normal case!
1684 ;; It should be optimized for speed.
1685 ((and visible aligned)
1686 (follow-debug-message "same"))
1687 ;; Pick a position in any window. If the
1688 ;; display is ok, this will pick the `correct'
1689 ;; window. If the display is wierd do this
1690 ;; anyway, this will be the case after a delete
1691 ;; at the beginning of the window.
1692 ((follow-select-if-visible dest win-start-end)
1693 (follow-debug-message "visible")
1694 (setq visible t)
1695 (goto-char dest))
1696 ;; Not visible anywhere else, lets pick this one.
1697 ;; (Is this case used?)
1698 (visible
1699 (follow-debug-message "visible in selected."))
1700 ;; Far out!
1701 ((eq dest (point-min))
1702 (follow-debug-message "min")
1703 (select-window (car windows))
1704 (goto-char dest)
1705 (set-window-start (selected-window) (point-min))
1706 (setq win-start-end (follow-windows-start-end windows))
1707 (follow-invalidate-cache)
1708 (setq visible t)
1709 (setq aligned nil))
1710 ;; If we can position the cursor without moving the first
1711 ;; window, do it. This is the case which catches `RET'
1712 ;; at the bottom of a window.
1713 ((follow-select-if-visible-from-first dest windows)
1714 (follow-debug-message "Below first")
1715 (setq visible t)
1716 (setq aligned t)
1717 (follow-redisplay windows (car windows))
1718 (goto-char dest))
1719 ;; None of the above. For simplicity, we stick to the
1720 ;; selected window.
1721 (t
1722 (follow-debug-message "None")
1723 (setq visible nil)
1724 (setq aligned nil))))
1725 ;; If a new window has been selected, make sure that the
1726 ;; old is not scrolled when the point is outside the
1727 ;; window.
1728 (or (eq win (selected-window))
1729 (let ((p (window-point win)))
1730 (set-window-start win (window-start win) nil)
1731 (set-window-point win p)))))
1732 ;; Make sure the point is visible in the selected window.
1733 ;; (This could lead to a scroll.)
1734 (if (or visible
1735 (follow-pos-visible dest win win-start-end))
1736 nil
1737 (sit-for 0)
1738 (follow-avoid-tail-recenter)
1739 (setq win-start-end (follow-windows-start-end windows))
1740 (follow-invalidate-cache)
1741 (setq aligned nil))
1742 ;; Redraw the windows whenever needed.
1743 (if (or follow-internal-force-redisplay
1744 (not (or aligned
1745 (follow-windows-aligned-p win-start-end)))
1746 (not (inline (follow-point-visible-all-windows-p
1747 win-start-end))))
1748 (progn
1749 (setq follow-internal-force-redisplay nil)
1750 (follow-redisplay windows (selected-window))
1751 (setq win-start-end (follow-windows-start-end windows))
1752 (follow-invalidate-cache)
1753 ;; When the point ends up in another window. This
1754 ;; happends when dest is in the beginning of the
1755 ;; file and the selected window is not the first.
1756 ;; It can also, in rare situations happend when
1757 ;; long lines are used and there is a big
1758 ;; difference between the width of the windows.
1759 ;; (When scrolling one line in a wide window which
1760 ;; will cause a move larger that an entire small
1761 ;; window.)
1762 (if (follow-pos-visible dest win win-start-end)
1763 nil
1764 (follow-select-if-visible dest win-start-end)
1765 (goto-char dest))))
1766
1767 ;; If the region is visible, make it look good when spanning
1768 ;; multiple windows.
1769 (if (or (and (boundp 'mark-active) (symbol-value 'mark-active))
1770 (and (fboundp 'region-active-p)
1771 (funcall (symbol-function 'region-active-p))))
1772 (follow-maximize-region
1773 (selected-window) windows win-start-end))
1774
1775 (inline (follow-avoid-tail-recenter))
1776 ;; DEBUG
1777 ;;(if (not (follow-windows-aligned-p
1778 ;; (follow-windows-start-end windows)))
1779 ;; (message "follow-mode: windows still unaligend!"))
1780 ;; END OF DEBUG
1781 ) ; Matches (let*
1782 ;; Buffer not in follow mode:
1783 ;; We still must update the windows displaying the tail so that
1784 ;; Emacs won't recenter them.
1785 (follow-avoid-tail-recenter))
1786 (set-buffer orig-buffer)))
1787 (setq follow-inside-post-command-hook nil))
1788
1789 ;;}}}
1790 ;;{{{ The region
1791
1792 ;; Tries to make the highlighted area representing the region look
1793 ;; good when spanning several windows.
1794 ;;
1795 ;; Not perfect, as the point can't be placed at window end, only at
1796 ;; end-1. This will highlight a little bit in windows above
1797 ;; the current.
1798
1799 (defun follow-maximize-region (win windows win-start-end)
1800 "Make a highlighted region stretching multiple windows look good."
1801 (let* ((all (follow-split-followers windows win))
1802 (pred (car all))
1803 (succ (cdr all))
1804 data)
1805 (while pred
1806 (setq data (assq (car pred) win-start-end))
1807 (set-window-point (car pred) (max (nth 1 data) (- (nth 2 data) 1)))
1808 (setq pred (cdr pred)))
1809 (while succ
1810 (set-window-point (car succ) (nth 1 (assq (car succ) win-start-end)))
1811 (setq succ (cdr succ)))))
1812
1813 ;;}}}
1814 ;;{{{ Scroll bar
1815
1816 ;;;; Scroll-bar support code.
1817
1818 ;;; Why is it needed? Well, if the selected window is in follow mode,
1819 ;;; all its follower stick to it blindly. If one of them is scrolled,
1820 ;;; it immediately returns to the original position when the mouse is
1821 ;;; released. If the selected window is not a follower of the dragged
1822 ;;; window the windows will be unaligned.
1823
1824 ;;; The advices doesn't get compiled. Aestetically, this might be a
1825 ;;; problem but in practical life it isn't.
1826
1827 ;;; Discussion: Now when the other windows in the chain follow the
1828 ;;; dragged, should we really select it?
1829
1830 (cond ((fboundp 'scroll-bar-drag)
1831 ;;;
1832 ;;; Emacs 19 style scrollbars.
1833 ;;;
1834
1835 ;; Select the dragged window if it is a follower of the
1836 ;; selected window.
1837 ;;
1838 ;; Generate advices of the form:
1839 ;; (defadvice scroll-bar-drag (after follow-scroll-bar-drag activate)
1840 ;; "Adviced by `follow-mode'."
1841 ;; (follow-redraw-after-event (ad-get-arg 0)))
1842 (let ((cmds '(scroll-bar-drag
1843 scroll-bar-drag-1 ; Executed at every move.
1844 scroll-bar-scroll-down
1845 scroll-bar-scroll-up
1846 scroll-bar-set-window-start)))
1847 (while cmds
1848 (eval
1849 (` (defadvice (, (intern (symbol-name (car cmds))))
1850 (after
1851 (, (intern (concat "follow-" (symbol-name (car cmds)))))
1852 activate)
1853 "Adviced by Follow Mode."
1854 (follow-redraw-after-event (ad-get-arg 0)))))
1855 (setq cmds (cdr cmds))))
1856
1857
1858 (defun follow-redraw-after-event (event)
1859 "Adviced by Follow mode."
1860 (condition-case nil
1861 (let* ((orig-win (selected-window))
1862 (win (nth 0 (funcall
1863 (symbol-function 'event-start) event)))
1864 (fmode (assq 'follow-mode
1865 (buffer-local-variables
1866 (window-buffer win)))))
1867 (if (and fmode (cdr fmode))
1868 ;; The selected window is in follow-mode
1869 (progn
1870 ;; Recenter around the dragged window.
1871 (select-window win)
1872 (follow-redisplay)
1873 (select-window orig-win))))
1874 (error nil))))
1875
1876
1877 ((fboundp 'scrollbar-vertical-drag)
1878 ;;;
1879 ;;; XEmacs style scrollbars.
1880 ;;;
1881
1882 ;; Advice all scrollbar functions on the form:
1883 ;;
1884 ;; (defadvice scrollbar-line-down
1885 ;; (after follow-scrollbar-line-down activate)
1886 ;; (follow-xemacs-scrollbar-support (ad-get-arg 0)))
1887
1888 (let ((cmds '(scrollbar-line-down ; Window
1889 scrollbar-line-up
1890 scrollbar-page-down ; Object
1891 scrollbar-page-up
1892 scrollbar-to-bottom ; Window
1893 scrollbar-to-top
1894 scrollbar-vertical-drag ; Object
1895 )))
1896
1897 (while cmds
1898 (eval
1899 (` (defadvice (, (intern (symbol-name (car cmds))))
1900 (after
1901 (, (intern (concat "follow-" (symbol-name (car cmds)))))
1902 activate)
1903 "Adviced by `follow-mode'."
1904 (follow-xemacs-scrollbar-support (ad-get-arg 0)))))
1905 (setq cmds (cdr cmds))))
1906
1907
1908 (defun follow-xemacs-scrollbar-support (window)
1909 "Redraw windows showing the same buffer as shown in WINDOW.
1910 WINDOW is either the dragged window, or a cons containing the
1911 window as its first element. This is called while the user drags
1912 the scrollbar.
1913
1914 WINDOW can be an object or a window."
1915 (condition-case nil
1916 (progn
1917 (if (consp window)
1918 (setq window (car window)))
1919 (let ((fmode (assq 'follow-mode
1920 (buffer-local-variables
1921 (window-buffer window))))
1922 (orig-win (selected-window)))
1923 (if (and fmode (cdr fmode))
1924 (progn
1925 ;; Recenter around the dragged window.
1926 (select-window window)
1927 (follow-redisplay)
1928 (select-window orig-win)))))
1929 (error nil)))))
1930
1931 ;;}}}
1932 ;;{{{ Process output
1933
1934 ;;; The following sections installs a spy which listens to process
1935 ;;; output and tries to reposition the windows whose buffers are in
1936 ;;; Follow mode. We play safe as much as possible...
1937 ;;;
1938 ;;; When follow-mode is activated all active processes are
1939 ;;; intercepted. All new processes which change their filter function
1940 ;;; using `set-process-filter' are also intercepted. The reason is
1941 ;;; that a process can cause a redisplay recentering "tail" windows.
1942 ;;; Note that it doesn't hurt to spy on more processes than needed.
1943 ;;;
1944 ;;; Technically, we set the process filter to `follow-generic-filter'.
1945 ;;; The original filter is stored in `follow-process-filter-alist'.
1946 ;;; Our generic filter calls the original filter, or inserts the
1947 ;;; output into the buffer, if the buffer originally didn't have an
1948 ;;; output filter. It also makes sure that the windows connected to
1949 ;;; the buffer are aligned.
1950 ;;;
1951 ;;; Discussion: How do we find processes which don't call
1952 ;;; `set-process-filter'? (How often are processes created in a
1953 ;;; buffer after Follow mode are activated?)
1954 ;;;
1955 ;;; Discussion: Should we also advice `process-filter' to make our
1956 ;;; filter invisible to others?
1957
1958 ;;{{{ Advice for `set-process-filter'
1959
1960 ;; Do not call this with 'follow-generic-filter as the name of the
1961 ;; filter...
1962
1963 (defadvice set-process-filter (before follow-set-process-filter activate)
1964 "Ensure process output will be displayed correctly in Follow Mode buffers.
1965
1966 Follow Mode inserts its own process filter to do its
1967 magic stuff before the real process filter is called."
1968 (if follow-intercept-processes
1969 (progn
1970 (setq follow-process-filter-alist
1971 (delq (assq (ad-get-arg 0) follow-process-filter-alist)
1972 follow-process-filter-alist))
1973 (follow-tidy-process-filter-alist)
1974 (cond ((eq (ad-get-arg 1) t))
1975 ((eq (ad-get-arg 1) nil)
1976 (ad-set-arg 1 'follow-generic-filter))
1977 (t
1978 (setq follow-process-filter-alist
1979 (cons (cons (ad-get-arg 0) (ad-get-arg 1))
1980 follow-process-filter-alist))
1981 (ad-set-arg 1 'follow-generic-filter))))))
1982
1983
1984 (defun follow-call-set-process-filter (proc filter)
1985 "Call original `set-process-filter' without the Follow mode advice."
1986 (ad-disable-advice 'set-process-filter 'before
1987 'follow-set-process-filter)
1988 (ad-activate 'set-process-filter)
1989 (prog1
1990 (set-process-filter proc filter)
1991 (ad-enable-advice 'set-process-filter 'before
1992 'follow-set-process-filter)
1993 (ad-activate 'set-process-filter)))
1994
1995
1996 (defadvice process-filter (after follow-process-filter activate)
1997 "Return the original process filter, not `follow-generic-filter'."
1998 (cond ((eq ad-return-value 'follow-generic-filter)
1999 (setq ad-return-value
2000 (cdr-safe (assq (ad-get-arg 0)
2001 follow-process-filter-alist))))))
2002
2003
2004 (defun follow-call-process-filter (proc)
2005 "Call original `process-filter' without the Follow mode advice."
2006 (ad-disable-advice 'process-filter 'after
2007 'follow-process-filter)
2008 (ad-activate 'process-filter)
2009 (prog1
2010 (process-filter proc)
2011 (ad-enable-advice 'process-filter 'after
2012 'follow-process-filter)
2013 (ad-activate 'process-filter)))
2014
2015
2016 (defun follow-tidy-process-filter-alist ()
2017 "Remove old processes from `follow-process-filter-alist'."
2018 (let ((alist follow-process-filter-alist)
2019 (ps (process-list))
2020 (new ()))
2021 (while alist
2022 (if (and (not (memq (process-status (car (car alist)))
2023 '(exit signal closed nil)))
2024 (memq (car (car alist)) ps))
2025 (setq new (cons (car alist) new)))
2026 (setq alist (cdr alist)))
2027 (setq follow-process-filter-alist new)))
2028
2029 ;;}}}
2030 ;;{{{ Start/stop interception of processes.
2031
2032 ;; Normally, all new processed are intercepted by our `set-process-filter'.
2033 ;; This is needed to intercept old processed which were started before we were
2034 ;; loaded, and processes we have forgotten by calling
2035 ;; `follow-stop-intercept-process-output'.
2036
2037 (defun follow-intercept-process-output ()
2038 "Intercept all active processes.
2039
2040 This is needed so that Follow Mode can track all display events in the
2041 system. (See `follow-mode')"
2042 (interactive)
2043 (let ((list (process-list)))
2044 (while list
2045 (if (eq (process-filter (car list)) 'follow-generic-filter)
2046 nil
2047 ;; The custom `set-process-filter' defined above.
2048 (set-process-filter (car list) (process-filter (car list))))
2049 (setq list (cdr list))))
2050 (setq follow-intercept-processes t))
2051
2052
2053 (defun follow-stop-intercept-process-output ()
2054 "Stop Follow Mode from spying on processes.
2055
2056 All current spypoints are removed and no new will be added.
2057
2058 The effect is that Follow mode won't be able to handle buffers
2059 connected to processes.
2060
2061 The only reason to call this function is if the Follow mode spy filter
2062 would interfere with some other package. If this happens, please
2063 report this using the `follow-submit-feedback' function."
2064 (interactive)
2065 (follow-tidy-process-filter-alist)
2066 (let ((list (process-list)))
2067 (while list
2068 (if (eq (process-filter (car list)) 'follow-generic-filter)
2069 (progn
2070 (follow-call-set-process-filter
2071 (car list)
2072 (cdr-safe (assq (car list) follow-process-filter-alist)))
2073 (setq follow-process-filter-alist
2074 (delq (assq (car list) follow-process-filter-alist)
2075 follow-process-filter-alist))))
2076 (setq list (cdr list))))
2077 (setq follow-intercept-processes nil))
2078
2079 ;;}}}
2080 ;;{{{ The filter
2081
2082 ;;; The following section is a naive method to make buffers with
2083 ;;; process output to work with Follow mode. Whenever the start of the
2084 ;;; window displaying the buffer is moved, we moves it back to its
2085 ;;; original position and try to select a new window. (If we fail,
2086 ;;; the normal redisplay functions of Emacs will scroll it right
2087 ;;; back!)
2088
2089 (defun follow-generic-filter (proc output)
2090 "Process output filter for process connected to buffers in Follow mode."
2091 (let* ((old-buffer (current-buffer))
2092 (orig-win (selected-window))
2093 (buf (process-buffer proc))
2094 (win (and buf (if (eq buf (window-buffer orig-win))
2095 orig-win
2096 (get-buffer-window buf t))))
2097 (return-to-orig-win (and win (not (eq win orig-win))))
2098 (orig-window-start (and win (window-start win))))
2099
2100 ;; If input is pending, the `sit-for' below won't redraw the
2101 ;; display. In that case, calling `follow-avoid-tail-recenter' may
2102 ;; provoke the process hadnling code to sceduling a redisplay.
2103 ;(or (input-pending-p)
2104 ; (follow-avoid-tail-recenter))
2105
2106 ;; Output the `output'.
2107 (let ((filter (cdr-safe (assq proc follow-process-filter-alist))))
2108 (cond
2109 ;; Call the original filter function
2110 (filter
2111 (funcall filter proc output))
2112
2113 ;; No filter, but we've got a buffer. Just output into it.
2114 (buf
2115 (set-buffer buf)
2116 (if (not (marker-buffer (process-mark proc)))
2117 (set-marker (process-mark proc) (point-max)))
2118 (let ((moving (= (point) (process-mark proc)))
2119 (odeactivate (and (boundp 'deactivate-mark)
2120 (symbol-value 'deactivate-mark)))
2121 (old-buffer-read-only buffer-read-only))
2122 (setq buffer-read-only nil)
2123 (save-excursion
2124 (goto-char (process-mark proc))
2125 ;; `insert-before-markers' just in case the users next
2126 ;; command is M-y.
2127 (insert-before-markers output)
2128 (set-marker (process-mark proc) (point)))
2129 (if moving (goto-char (process-mark proc)))
2130 (if (boundp 'deactivate-mark)
2131 ;; This could really be
2132 ;; (setq deactivate-mark odeactivate)
2133 ;; but this raises an error when compiling on XEmacs.
2134 (funcall (symbol-function 'set)
2135 'deactivate-mark odeactivate))
2136 (setq buffer-read-only old-buffer-read-only)))))
2137
2138 ;; If we're in follow mode, do our stuff. Select a new window and
2139 ;; redisplay. (Actually, it is redundant to check `buf', but I
2140 ;; feel it's more correct.)
2141 (if (and buf win (window-live-p win))
2142 (progn
2143 (set-buffer buf)
2144 (if (and (boundp 'follow-mode) follow-mode)
2145 (progn
2146 (select-window win)
2147 (let* ((windows (follow-all-followers win))
2148 (win-start-end (follow-windows-start-end windows))
2149 (new-window-start (window-start win))
2150 (new-window-point (window-point win)))
2151 (cond
2152 ;; The window was moved. Move it back and
2153 ;; select a new. If no better could be found,
2154 ;; we stick the the new start position. This
2155 ;; is used when the original process filter
2156 ;; tries to position the cursor at the bottom
2157 ;; of the window. Example: `lyskom'.
2158 ((not (eq orig-window-start new-window-start))
2159 (follow-debug-message "filter: Moved")
2160 (set-window-start win orig-window-start)
2161 (follow-redisplay windows win)
2162 (setq win-start-end (follow-windows-start-end windows))
2163 (follow-select-if-visible new-window-point
2164 win-start-end)
2165 (goto-char new-window-point)
2166 (if (eq win (selected-window))
2167 (set-window-start win new-window-start))
2168 (setq win-start-end (follow-windows-start-end windows)))
2169 ;; Stick to this window, if point is visible in it.
2170 ((pos-visible-in-window-p new-window-point)
2171 (follow-debug-message "filter: Visible in window"))
2172 ;; Avoid redisplaying the first window. If the
2173 ;; point is visible at a window below,
2174 ;; redisplay and select it.
2175 ((follow-select-if-visible-from-first
2176 new-window-point windows)
2177 (follow-debug-message "filter: Seen from first")
2178 (follow-redisplay windows (car windows))
2179 (goto-char new-window-point)
2180 (setq win-start-end
2181 (follow-windows-start-end windows)))
2182 ;; None of the above. We stick to the current window.
2183 (t
2184 (follow-debug-message "filter: nothing")))
2185
2186 ;; Here we have slected a window. Make sure the
2187 ;; windows are aligned and the point is visible
2188 ;; in the selected window.
2189 (if (and (not (follow-pos-visible
2190 (point) (selected-window) win-start-end))
2191 (not return-to-orig-win))
2192 (progn
2193 (sit-for 0)
2194 (setq win-start-end
2195 (follow-windows-start-end windows))))
2196
2197 (if (or follow-internal-force-redisplay
2198 (not (follow-windows-aligned-p win-start-end)))
2199 (follow-redisplay windows)))))))
2200
2201 ;; return to the original window.
2202 (if return-to-orig-win
2203 (select-window orig-win))
2204 ;; Restore the orignal buffer, unless the filter explicitly
2205 ;; changed buffer or killed the old buffer.
2206 (if (and (eq buf (current-buffer))
2207 (buffer-name old-buffer))
2208 (set-buffer old-buffer)))
2209
2210 (follow-invalidate-cache)
2211
2212 ;; Normally, if the display has been changed, it is redrawn. All
2213 ;; windows showing only the end of a buffer is unconditionally
2214 ;; recentered, we can't prevent it by calling
2215 ;; `follow-avoid-tail-recenter'.
2216 ;;
2217 ;; By performing a redisplay on our own, Emacs need not perform
2218 ;; the above described redisplay. (However, bu performing it when
2219 ;; there are input available just seems to make things worse.)
2220 (if (and follow-avoid-tail-recenter-p
2221 (not (input-pending-p)))
2222 (sit-for 0)))
2223
2224 ;;}}}
2225
2226 ;;}}}
2227 ;;{{{ Window size change
2228
2229 ;; In Emacs 19.29, the functions in `window-size-change-functions' are
2230 ;; called every time a window in a frame changes size. Most notably, it
2231 ;; is called after the frame has been resized.
2232 ;;
2233 ;; We basically call our post-command-hook for every buffer which is
2234 ;; visible in any window in the resized frame, which is in follow-mode.
2235 ;;
2236 ;; Since this function can be called indirectly from
2237 ;; `follow-post-command-hook' we have a potential infinite loop. We
2238 ;; handle this problem by simply not doing anything at all in this
2239 ;; situation. The variable `follow-inside-post-command-hook' contains
2240 ;; information about whether the execution actually is inside the
2241 ;; post-command-hook or not.
2242
2243 (if (boundp 'window-size-change-functions)
2244 (add-hook 'window-size-change-functions 'follow-window-size-change))
2245
2246
2247 (defun follow-window-size-change (frame)
2248 "Redraw all windows in FRAME, when in Follow mode."
2249 ;; Below, we call `post-command-hook'. This makes sure that we
2250 ;; doesn't start a mutally recursive endless loop.
2251 (if follow-inside-post-command-hook
2252 nil
2253 (let ((buffers '())
2254 (orig-window (selected-window))
2255 (orig-buffer (current-buffer))
2256 (orig-frame (selected-frame))
2257 windows
2258 buf)
2259 (select-frame frame)
2260 (unwind-protect
2261 (walk-windows
2262 (function
2263 (lambda (win)
2264 (setq buf (window-buffer win))
2265 (if (memq buf buffers)
2266 nil
2267 (set-buffer buf)
2268 (if (and (boundp 'follow-mode)
2269 follow-mode)
2270 (progn
2271 (setq windows (follow-all-followers win))
2272 (if (memq orig-window windows)
2273 (progn
2274 ;; Make sure we're redrawing around the
2275 ;; selected window.
2276 ;;
2277 ;; We must be really careful not to do this
2278 ;; when we are (indirectly) called by
2279 ;; `post-command-hook'.
2280 (select-window orig-window)
2281 (follow-post-command-hook)
2282 (setq orig-window (selected-window)))
2283 (follow-redisplay windows win))
2284 (setq buffers (cons buf buffers))))))))
2285 (select-frame orig-frame)
2286 (set-buffer orig-buffer)
2287 (select-window orig-window)))))
2288
2289 ;;}}}
2290
2291 ;;{{{ XEmacs isearch
2292
2293 ;; In XEmacs, isearch often finds matches in other windows than the
2294 ;; currently selected. However, when exiting the old window
2295 ;; configuration is restored, with the exception of the beginning of
2296 ;; the start of the window for the selected window. This is not much
2297 ;; help for us.
2298 ;;
2299 ;; We overwrite the stored window configuration with the current,
2300 ;; unless we are in `slow-search-mode', i.e. only a few lines
2301 ;; of text is visible.
2302
2303 (if follow-emacs-version-xemacs-p
2304 (defadvice isearch-done (before follow-isearch-done activate)
2305 (if (and (boundp 'follow-mode)
2306 follow-mode
2307 (boundp 'isearch-window-configuration)
2308 isearch-window-configuration
2309 (boundp 'isearch-slow-terminal-mode)
2310 (not isearch-slow-terminal-mode))
2311 (let ((buf (current-buffer)))
2312 (setq isearch-window-configuration
2313 (current-window-configuration))
2314 (set-buffer buf)))))
2315
2316 ;;}}}
2317 ;;{{{ Tail window handling
2318
2319 ;;; In Emacs (not XEmacs) windows showing nothing are sometimes
2320 ;;; recentered. When in Follow Mode, this is not desireable for
2321 ;;; non-first windows in the window chain. This section tries to
2322 ;;; make the windows stay where they should be.
2323 ;;;
2324 ;;; If the display is updated, all windows starting at (point-max) are
2325 ;;; going to be recentered at the next redisplay, unless we do a
2326 ;;; read-and-write cycle to update the `force' flag inside the windows.
2327 ;;;
2328 ;;; In 19.30, a new varible `window-scroll-functions' is called every
2329 ;;; time a window is recentered. It is not perfect for our situation,
2330 ;;; since when it is called for a tail window, it is to late. However,
2331 ;;; if it is called for another window, we can try to update our
2332 ;;; windows.
2333 ;;;
2334 ;;; By patching `sit-for' we can make sure that to catch all explicit
2335 ;;; updates initiated by lisp programs. Internal calls, on the other
2336 ;;; hand, are not handled.
2337 ;;;
2338 ;;; Please note that the function `follow-avoid-tail-recenter' is also
2339 ;;; called from other places, e.g. `post-command-hook' and
2340 ;;; `post-command-idle-hook'.
2341
2342 ;; If this function is called it is too late for this window, but
2343 ;; we might save other windows from being recentered.
2344
2345 (if (and follow-avoid-tail-recenter-p (boundp 'window-scroll-functions))
2346 (add-hook 'window-scroll-functions 'follow-avoid-tail-recenter t))
2347
2348
2349 ;; This prevents all packages which calls `sit-for' directly
2350 ;; to recenter tail windows.
2351
2352 (if follow-avoid-tail-recenter-p
2353 (defadvice sit-for (before follow-sit-for activate)
2354 "Adviced by Follow Mode.
2355
2356 Avoid to recenter windows displaying only the end of a file as when
2357 displaying a short file in two windows, using Follow Mode."
2358 (follow-avoid-tail-recenter)))
2359
2360
2361 ;; Without this advice, `mouse-drag-region' would start to recenter
2362 ;; tail windows.
2363
2364 (if (and follow-avoid-tail-recenter-p
2365 (fboundp 'move-overlay))
2366 (defadvice move-overlay (before follow-move-overlay activate)
2367 "Adviced by Follow Mode.
2368 Don't recenter windows showing only the end of a buffer.
2369 This prevents `mouse-drag-region' from messing things up."
2370 (follow-avoid-tail-recenter)))
2371
2372 ;;}}}
2373 ;;{{{ profile support
2374
2375 ;; The following (non-evaluated) section can be used to
2376 ;; profile this package using `elp'.
2377 ;;
2378 ;; Invalid indentation on purpose!
2379
2380 (cond (nil
2381 (setq elp-function-list
2382 '(window-end
2383 vertical-motion
2384 ; sit-for ;; elp can't handle advices...
2385 follow-mode
2386 follow-all-followers
2387 follow-split-followers
2388 follow-redisplay
2389 follow-downward
2390 follow-calculate-first-window-start
2391 follow-estimate-first-window-start
2392 follow-calculate-first-window-start-from-above
2393 follow-calculate-first-window-start-from-below
2394 follow-calc-win-end
2395 follow-calc-win-start
2396 follow-pos-visible
2397 follow-windows-start-end
2398 follow-cache-valid-p
2399 follow-select-if-visible
2400 follow-select-if-visible-from-first
2401 follow-windows-aligned-p
2402 follow-point-visible-all-windows-p
2403 follow-avoid-tail-recenter
2404 follow-update-window-start
2405 follow-post-command-hook
2406 ))))
2407
2408 ;;}}}
2409
2410 ;;{{{ The end
2411
2412 ;;;
2413 ;;; We're done!
2414 ;;;
2415
2416 (provide 'follow)
2417
2418 ;;}}}
2419
2420 ;; /------------------------------------------------------------------------\
2421 ;; | "I [..] am rarely happier then when spending an entire day programming |
2422 ;; | my computer to perform automatically a task that it would otherwise |
2423 ;; | take me a good ten seconds to do by hand. Ten seconds, I tell myself, |
2424 ;; | is ten seconds. Time is valuable and ten seconds' worth of it is well |
2425 ;; | worth the investment of a day's happy activity working out a way to |
2426 ;; | save it". -- Douglas Adams, "Last Chance to See" |
2427 ;; \------------------------------------------------------------------------/
2428
2429 ;;; follow.el ends here