Fixed up initial line
[bpt/emacs.git] / lisp / follow.el
1 ;;; follow.el --- Minor mode, Synchronize windows showing the same buffer.
2
3 ;; Copyright (C) 1995, 1996 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.6
9 ;; Keywords: display, window, minor-mode
10 ;; Date: 20 Feb 1996
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 beeing 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 ;; resonabely 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 "Sumbit 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 varible 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 beeing 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 the point,
998 and 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 alinged."
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' explicitylt?)
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 adjecent 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. Whis 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 when in Follow mode."
1802 (let* ((all (follow-split-followers windows win))
1803 (pred (car all))
1804 (succ (cdr all))
1805 data)
1806 (while pred
1807 (setq data (assq (car pred) win-start-end))
1808 (set-window-point (car pred) (max (nth 1 data) (- (nth 2 data) 1)))
1809 (setq pred (cdr pred)))
1810 (while succ
1811 (set-window-point (car succ) (nth 1 (assq (car succ) win-start-end)))
1812 (setq succ (cdr succ)))))
1813
1814 ;;}}}
1815 ;;{{{ Scroll bar
1816
1817 ;;;; Scroll-bar support code.
1818
1819 ;;; Why is it needed? Well, if the selected window is in follow mode,
1820 ;;; all its follower stick to it blindly. If one of them is scrolled,
1821 ;;; it immediately returns to the original position when the mouse is
1822 ;;; released. If the selected window is not a follower of the dragged
1823 ;;; window the windows will be unaligned.
1824
1825 ;;; The advices doesn't get compiled. Aestetically, this might be a
1826 ;;; problem but in practical life it isn't.
1827
1828 ;;; Discussion: Now when the other windows in the chain follow the
1829 ;;; dragged, should we really select it?
1830
1831 (cond ((fboundp 'scroll-bar-drag)
1832 ;;;
1833 ;;; Emacs 19 style scrollbars.
1834 ;;;
1835
1836 ;; Select the dragged window if it is a follower of the
1837 ;; selected window.
1838 ;;
1839 ;; Generate advices of the form:
1840 ;; (defadvice scroll-bar-drag (after follow-scroll-bar-drag activate)
1841 ;; "Adviced by `follow-mode'."
1842 ;; (follow-redraw-after-event (ad-get-arg 0)))
1843 (let ((cmds '(scroll-bar-drag
1844 scroll-bar-drag-1 ; Executed at every move.
1845 scroll-bar-scroll-down
1846 scroll-bar-scroll-up
1847 scroll-bar-set-window-start)))
1848 (while cmds
1849 (eval
1850 (` (defadvice (, (intern (symbol-name (car cmds))))
1851 (after
1852 (, (intern (concat "follow-" (symbol-name (car cmds)))))
1853 activate)
1854 "Adviced by Follow Mode."
1855 (follow-redraw-after-event (ad-get-arg 0)))))
1856 (setq cmds (cdr cmds))))
1857
1858
1859 (defun follow-redraw-after-event (event)
1860 "Adviced by Follow mode."
1861 (condition-case nil
1862 (let* ((orig-win (selected-window))
1863 (win (nth 0 (funcall
1864 (symbol-function 'event-start) event)))
1865 (fmode (assq 'follow-mode
1866 (buffer-local-variables
1867 (window-buffer win)))))
1868 (if (and fmode (cdr fmode))
1869 ;; The selected window is in follow-mode
1870 (progn
1871 ;; Recenter around the dragged window.
1872 (select-window win)
1873 (follow-redisplay)
1874 (select-window orig-win))))
1875 (error nil))))
1876
1877
1878 ((fboundp 'scrollbar-vertical-drag)
1879 ;;;
1880 ;;; XEmacs style scrollbars.
1881 ;;;
1882
1883 ;; Advice all scrollbar functions on the form:
1884 ;;
1885 ;; (defadvice scrollbar-line-down
1886 ;; (after follow-scrollbar-line-down activate)
1887 ;; (follow-xemacs-scrollbar-support (ad-get-arg 0)))
1888
1889 (let ((cmds '(scrollbar-line-down ; Window
1890 scrollbar-line-up
1891 scrollbar-page-down ; Object
1892 scrollbar-page-up
1893 scrollbar-to-bottom ; Window
1894 scrollbar-to-top
1895 scrollbar-vertical-drag ; Object
1896 )))
1897
1898 (while cmds
1899 (eval
1900 (` (defadvice (, (intern (symbol-name (car cmds))))
1901 (after
1902 (, (intern (concat "follow-" (symbol-name (car cmds)))))
1903 activate)
1904 "Adviced by `follow-mode'."
1905 (follow-xemacs-scrollbar-support (ad-get-arg 0)))))
1906 (setq cmds (cdr cmds))))
1907
1908
1909 (defun follow-xemacs-scrollbar-support (window)
1910 "Redraw windows showing the same buffer as shown in WINDOW.
1911 WINDOW is either the dragged window, or a cons containing the
1912 window as its first element. This is called while the user drags
1913 the scrollbar.
1914
1915 WINDOW can be an object or a window."
1916 (condition-case nil
1917 (progn
1918 (if (consp window)
1919 (setq window (car window)))
1920 (let ((fmode (assq 'follow-mode
1921 (buffer-local-variables
1922 (window-buffer window))))
1923 (orig-win (selected-window)))
1924 (if (and fmode (cdr fmode))
1925 (progn
1926 ;; Recenter around the dragged window.
1927 (select-window window)
1928 (follow-redisplay)
1929 (select-window orig-win)))))
1930 (error nil)))))
1931
1932 ;;}}}
1933 ;;{{{ Process output
1934
1935 ;;; The following sections installs a spy which listens to process
1936 ;;; output and tries to reposition the windows whose buffers are in
1937 ;;; Follow mode. We play safe as much as possible...
1938 ;;;
1939 ;;; When follow-mode is activated all active processes are
1940 ;;; intercepted. All new processes which change their filter function
1941 ;;; using `set-process-filter' are also intercepted. The reason is
1942 ;;; that a process can cause a redisplay recentering "tail" windows.
1943 ;;; Note that it doesn't hurt to spy on more processes than needed.
1944 ;;;
1945 ;;; Technically, we set the process filter to `follow-generic-filter'.
1946 ;;; The original filter is stored in `follow-process-filter-alist'.
1947 ;;; Our generic filter calls the original filter, or inserts the
1948 ;;; output into the buffer, if the buffer originally didn't have an
1949 ;;; output filter. It also makes sure that the windows connected to
1950 ;;; the buffer are aligned.
1951 ;;;
1952 ;;; Discussion: How to we find processes which doesn't call
1953 ;;; `set-process-filter'? (How often are processes created in a
1954 ;;; buffer after Follow mode are activated?)
1955 ;;;
1956 ;;; Discussion: Should we also advice `process-filter' to make our
1957 ;;; filter invisible to others?
1958
1959 ;;{{{ Advice for `set-process-filter'
1960
1961 ;; Do not call this with 'follow-generic-filter as the name of the
1962 ;; filter...
1963
1964 (defadvice set-process-filter (before follow-set-process-filter activate)
1965 "Follow Mode listens to calls to this function to make
1966 sure process output will be displayed correctly in buffers
1967 in which the mode is activated.
1968
1969 Follow Mode inserts it's own process filter to do it's
1970 magic stuff before the real process filter is called."
1971 (if follow-intercept-processes
1972 (progn
1973 (setq follow-process-filter-alist
1974 (delq (assq (ad-get-arg 0) follow-process-filter-alist)
1975 follow-process-filter-alist))
1976 (follow-tidy-process-filter-alist)
1977 (cond ((eq (ad-get-arg 1) t))
1978 ((eq (ad-get-arg 1) nil)
1979 (ad-set-arg 1 'follow-generic-filter))
1980 (t
1981 (setq follow-process-filter-alist
1982 (cons (cons (ad-get-arg 0) (ad-get-arg 1))
1983 follow-process-filter-alist))
1984 (ad-set-arg 1 'follow-generic-filter))))))
1985
1986
1987 (defun follow-call-set-process-filter (proc filter)
1988 "Call original `set-process-filter' without the Follow mode advice."
1989 (ad-disable-advice 'set-process-filter 'before
1990 'follow-set-process-filter)
1991 (ad-activate 'set-process-filter)
1992 (prog1
1993 (set-process-filter proc filter)
1994 (ad-enable-advice 'set-process-filter 'before
1995 'follow-set-process-filter)
1996 (ad-activate 'set-process-filter)))
1997
1998
1999 (defadvice process-filter (after follow-process-filter activate)
2000 "Normally when Follow mode is activated all processes has the
2001 process filter set to `follow-generic-filter'. With this advice,
2002 the original process filter is returned."
2003 (cond ((eq ad-return-value 'follow-generic-filter)
2004 (setq ad-return-value
2005 (cdr-safe (assq (ad-get-arg 0)
2006 follow-process-filter-alist))))))
2007
2008
2009 (defun follow-call-process-filter (proc)
2010 "Call original `process-filter' without the Follow mode advice."
2011 (ad-disable-advice 'process-filter 'after
2012 'follow-process-filter)
2013 (ad-activate 'process-filter)
2014 (prog1
2015 (process-filter proc)
2016 (ad-enable-advice 'process-filter 'after
2017 'follow-process-filter)
2018 (ad-activate 'process-filter)))
2019
2020
2021 (defun follow-tidy-process-filter-alist ()
2022 "Remove old processes from `follow-process-filter-alist'."
2023 (let ((alist follow-process-filter-alist)
2024 (ps (process-list))
2025 (new ()))
2026 (while alist
2027 (if (and (not (memq (process-status (car (car alist)))
2028 '(exit signal closed nil)))
2029 (memq (car (car alist)) ps))
2030 (setq new (cons (car alist) new)))
2031 (setq alist (cdr alist)))
2032 (setq follow-process-filter-alist new)))
2033
2034 ;;}}}
2035 ;;{{{ Start/stop interception of processes.
2036
2037 ;; Normally, all new processed are intercepted by our `set-process-filter'.
2038 ;; This is needed to intercept old processed which were started before we were
2039 ;; loaded, and processes we have forgotten by calling
2040 ;; `follow-stop-intercept-process-output'.
2041
2042 (defun follow-intercept-process-output ()
2043 "Intercept all active processes.
2044
2045 This is needed so that Follow Mode can track all display events in the
2046 system. (See `follow-mode')"
2047 (interactive)
2048 (let ((list (process-list)))
2049 (while list
2050 (if (eq (process-filter (car list)) 'follow-generic-filter)
2051 nil
2052 ;; The custom `set-process-filter' defined above.
2053 (set-process-filter (car list) (process-filter (car list))))
2054 (setq list (cdr list))))
2055 (setq follow-intercept-processes t))
2056
2057
2058 (defun follow-stop-intercept-process-output ()
2059 "Stop Follow Mode from spying on processes.
2060
2061 All current spypoints are removed and no new will be added.
2062
2063 The effect is that Follow mode won't be able to handle buffers
2064 connected to processes.
2065
2066 The only reason to call this function is if the Follow mode spy filter
2067 would interfere with some other package. If this happens, please
2068 report this using the `follow-submit-feedback' function."
2069 (interactive)
2070 (follow-tidy-process-filter-alist)
2071 (let ((list (process-list)))
2072 (while list
2073 (if (eq (process-filter (car list)) 'follow-generic-filter)
2074 (progn
2075 (follow-call-set-process-filter
2076 (car list)
2077 (cdr-safe (assq (car list) follow-process-filter-alist)))
2078 (setq follow-process-filter-alist
2079 (delq (assq (car list) follow-process-filter-alist)
2080 follow-process-filter-alist))))
2081 (setq list (cdr list))))
2082 (setq follow-intercept-processes nil))
2083
2084 ;;}}}
2085 ;;{{{ The filter
2086
2087 ;;; The following section is a naive method to make buffers with
2088 ;;; process output to work with Follow mode. Whenever the start of the
2089 ;;; window displaying the buffer is moved, we moves it back to it's
2090 ;;; original position and try to select a new window. (If we fail,
2091 ;;; the normal redisplay functions of Emacs will scroll it right
2092 ;;; back!)
2093
2094 (defun follow-generic-filter (proc output)
2095 "Process output filter for process connected to buffers in Follow mode."
2096 (let* ((old-buffer (current-buffer))
2097 (orig-win (selected-window))
2098 (buf (process-buffer proc))
2099 (win (and buf (if (eq buf (window-buffer orig-win))
2100 orig-win
2101 (get-buffer-window buf t))))
2102 (return-to-orig-win (and win (not (eq win orig-win))))
2103 (orig-window-start (and win (window-start win))))
2104
2105 ;; If input is pending, the `sit-for' below won't redraw the
2106 ;; display. In that case, calling `follow-avoid-tail-recenter' may
2107 ;; provoke the process hadnling code to sceduling a redisplay.
2108 ;(or (input-pending-p)
2109 ; (follow-avoid-tail-recenter))
2110
2111 ;; Output the `output'.
2112 (let ((filter (cdr-safe (assq proc follow-process-filter-alist))))
2113 (cond
2114 ;; Call the original filter function
2115 (filter
2116 (funcall filter proc output))
2117
2118 ;; No filter, but we've got a buffer. Just output into it.
2119 (buf
2120 (set-buffer buf)
2121 (if (not (marker-buffer (process-mark proc)))
2122 (set-marker (process-mark proc) (point-max)))
2123 (let ((moving (= (point) (process-mark proc)))
2124 (odeactivate (and (boundp 'deactivate-mark)
2125 (symbol-value 'deactivate-mark)))
2126 (old-buffer-read-only buffer-read-only))
2127 (setq buffer-read-only nil)
2128 (save-excursion
2129 (goto-char (process-mark proc))
2130 ;; `insert-before-markers' just in case the users next
2131 ;; command is M-y.
2132 (insert-before-markers output)
2133 (set-marker (process-mark proc) (point)))
2134 (if moving (goto-char (process-mark proc)))
2135 (if (boundp 'deactivate-mark)
2136 ;; This could really be
2137 ;; (setq deactivate-mark odeactivate)
2138 ;; but this raises an error when compiling on XEmacs.
2139 (funcall (symbol-function 'set)
2140 'deactivate-mark odeactivate))
2141 (setq buffer-read-only old-buffer-read-only)))))
2142
2143 ;; If we're in follow mode, do our stuff. Select a new window and
2144 ;; redisplay. (Actually, it is redundant to check `buf', but I
2145 ;; feel it's more correct.)
2146 (if (and buf win (window-live-p win))
2147 (progn
2148 (set-buffer buf)
2149 (if (and (boundp 'follow-mode) follow-mode)
2150 (progn
2151 (select-window win)
2152 (let* ((windows (follow-all-followers win))
2153 (win-start-end (follow-windows-start-end windows))
2154 (new-window-start (window-start win))
2155 (new-window-point (window-point win)))
2156 (cond
2157 ;; The window was moved. Move it back and
2158 ;; select a new. If no better could be found,
2159 ;; we stick the the new start position. This
2160 ;; is used when the original process filter
2161 ;; tries to position the cursor at the bottom
2162 ;; of the window. Example: `lyskom'.
2163 ((not (eq orig-window-start new-window-start))
2164 (follow-debug-message "filter: Moved")
2165 (set-window-start win orig-window-start)
2166 (follow-redisplay windows win)
2167 (setq win-start-end (follow-windows-start-end windows))
2168 (follow-select-if-visible new-window-point
2169 win-start-end)
2170 (goto-char new-window-point)
2171 (if (eq win (selected-window))
2172 (set-window-start win new-window-start))
2173 (setq win-start-end (follow-windows-start-end windows)))
2174 ;; Stick to this window, if point is visible in it.
2175 ((pos-visible-in-window-p new-window-point)
2176 (follow-debug-message "filter: Visible in window"))
2177 ;; Avoid redisplaying the first window. If the
2178 ;; point is visible at a window below,
2179 ;; redisplay and select it.
2180 ((follow-select-if-visible-from-first
2181 new-window-point windows)
2182 (follow-debug-message "filter: Seen from first")
2183 (follow-redisplay windows (car windows))
2184 (goto-char new-window-point)
2185 (setq win-start-end
2186 (follow-windows-start-end windows)))
2187 ;; None of the above. We stick to the current window.
2188 (t
2189 (follow-debug-message "filter: nothing")))
2190
2191 ;; Here we have slected a window. Make sure the
2192 ;; windows are aligned and the point is visible
2193 ;; in the selected window.
2194 (if (and (not (follow-pos-visible
2195 (point) (selected-window) win-start-end))
2196 (not return-to-orig-win))
2197 (progn
2198 (sit-for 0)
2199 (setq win-start-end
2200 (follow-windows-start-end windows))))
2201
2202 (if (or follow-internal-force-redisplay
2203 (not (follow-windows-aligned-p win-start-end)))
2204 (follow-redisplay windows)))))))
2205
2206 ;; return to the original window.
2207 (if return-to-orig-win
2208 (select-window orig-win))
2209 (set-buffer old-buffer))
2210
2211 (follow-invalidate-cache)
2212
2213 ;; Normally, if the display has been changed, it is redrawn. All
2214 ;; windows showing only the end of a buffer is unconditionally
2215 ;; recentered, we can't prevent it by calling
2216 ;; `follow-avoid-tail-recenter'.
2217 ;;
2218 ;; By performing a redisplay on our own, Emacs need not perform
2219 ;; the above described redisplay. (However, bu performing it when
2220 ;; there are input available just seems to make things worse.)
2221 (if (and follow-avoid-tail-recenter-p
2222 (not (input-pending-p)))
2223 (sit-for 0)))
2224
2225 ;;}}}
2226
2227 ;;}}}
2228 ;;{{{ Window size change
2229
2230 ;; In Emacs 19.29, the functions in `window-size-change-functions' are
2231 ;; called every time a window in a frame changes size. Most notably, it
2232 ;; is called after the frame has been resized.
2233 ;;
2234 ;; We basically call our post-command-hook for every buffer which is
2235 ;; visible in any window in the resized frame, which is in follow-mode.
2236 ;;
2237 ;; Since this function can be called indirectly from
2238 ;; `follow-post-command-hook' we have a potential infinite loop. We
2239 ;; handle this problem by simply not doing anything at all in this
2240 ;; situation. The variable `follow-inside-post-command-hook' contains
2241 ;; information about whether the execution actually is inside the
2242 ;; post-command-hook or not.
2243
2244 (if (boundp 'window-size-change-functions)
2245 (add-hook 'window-size-change-functions 'follow-window-size-change))
2246
2247
2248 (defun follow-window-size-change (frame)
2249 "Redraw all windows in FRAME, when in Follow mode."
2250 ;; Below, we call `post-command-hook'. This makes sure that we
2251 ;; doesn't start a mutally recursive endless loop.
2252 (if follow-inside-post-command-hook
2253 nil
2254 (let ((buffers '())
2255 (orig-window (selected-window))
2256 (orig-buffer (current-buffer))
2257 (orig-frame (selected-frame))
2258 windows
2259 buf)
2260 (select-frame frame)
2261 (unwind-protect
2262 (walk-windows
2263 (function
2264 (lambda (win)
2265 (setq buf (window-buffer win))
2266 (if (memq buf buffers)
2267 nil
2268 (set-buffer buf)
2269 (if (and (boundp 'follow-mode)
2270 follow-mode)
2271 (progn
2272 (setq windows (follow-all-followers win))
2273 (if (memq orig-window windows)
2274 (progn
2275 ;; Make sure we're redrawing around the
2276 ;; selected window.
2277 ;;
2278 ;; We must be really careful not to do this
2279 ;; when we are (indirectly) called by
2280 ;; `post-command-hook'.
2281 (select-window orig-window)
2282 (follow-post-command-hook)
2283 (setq orig-window (selected-window)))
2284 (follow-redisplay windows win))
2285 (setq buffers (cons buf buffers))))))))
2286 (select-frame orig-frame)
2287 (set-buffer orig-buffer)
2288 (select-window orig-window)))))
2289
2290 ;;}}}
2291
2292 ;;{{{ XEmacs isearch
2293
2294 ;; In XEmacs, isearch often finds matches in other windows than the
2295 ;; currently selected. However, when exiting the old window
2296 ;; configuration is restored, with the exception of the beginning of
2297 ;; the start of the window for the selected window. This is not much
2298 ;; help for us.
2299 ;;
2300 ;; We overwrite the stored window configuration with the current,
2301 ;; unless we are in `slow-search-mode', i.e. only a few lines
2302 ;; of text is visible.
2303
2304 (if follow-emacs-version-xemacs-p
2305 (defadvice isearch-done (before follow-isearch-done activate)
2306 (if (and (boundp 'follow-mode)
2307 follow-mode
2308 (boundp 'isearch-window-configuration)
2309 isearch-window-configuration
2310 (boundp 'isearch-slow-terminal-mode)
2311 (not isearch-slow-terminal-mode))
2312 (let ((buf (current-buffer)))
2313 (setq isearch-window-configuration
2314 (current-window-configuration))
2315 (set-buffer buf)))))
2316
2317 ;;}}}
2318 ;;{{{ Tail window handling
2319
2320 ;;; In Emacs (not XEmacs) windows showing nothing are sometimes
2321 ;;; recentered. When in Follow Mode, this is not desireable for
2322 ;;; non-first windows in the window chain. This section tries to
2323 ;;; make the windows stay where they should be.
2324 ;;;
2325 ;;; If the display is updated, all windows starting at (point-max) are
2326 ;;; going to be recentered at the next redisplay, unless we do a
2327 ;;; read-and-write cycle to update the `force' flag inside the windows.
2328 ;;;
2329 ;;; In 19.30, a new varible `window-scroll-functions' is called every
2330 ;;; time a window is recentered. It is not perfect for our situation,
2331 ;;; since when it is called for a tail window, it is to late. However,
2332 ;;; if it is called for another window, we can try to update our
2333 ;;; windows.
2334 ;;;
2335 ;;; By patching `sit-for' we can make sure that to catch all explicit
2336 ;;; updates initiated by lisp programs. Internal calls, on the other
2337 ;;; hand, are not handled.
2338 ;;;
2339 ;;; Please note that the function `follow-avoid-tail-recenter' is also
2340 ;;; called from other places, e.g. `post-command-hook' and
2341 ;;; `post-command-idle-hook'.
2342
2343 ;; If this function is called it is to late for this window, but
2344 ;; we might save other windows from beeing recentered.
2345
2346 (if (and follow-avoid-tail-recenter-p (boundp 'window-scroll-functions))
2347 (add-hook 'window-scroll-functions 'follow-avoid-tail-recenter t))
2348
2349
2350 ;; This prevents all packages which calls `sit-for' directly
2351 ;; to recenter tail windows.
2352
2353 (if follow-avoid-tail-recenter-p
2354 (defadvice sit-for (before follow-sit-for activate)
2355 "Adviced by Follow Mode.
2356
2357 Avoid to recenter windows displaying only the end of a file as when
2358 displaying a short file in two windows, using Follow Mode."
2359 (follow-avoid-tail-recenter)))
2360
2361
2362 ;; Without this advice, `mouse-drag-region' would start to recenter
2363 ;; tail windows.
2364
2365 (if (and follow-avoid-tail-recenter-p
2366 (fboundp 'move-overlay))
2367 (defadvice move-overlay (before follow-move-overlay activate)
2368 "Adviced by Follow Mode. Don't recenter windows showing only
2369 the end of a buffer. This prevents `mouse-drag-region' from
2370 messing things up."
2371 (follow-avoid-tail-recenter)))
2372
2373 ;;}}}
2374 ;;{{{ profile support
2375
2376 ;; The following (non-evaluated) section can be used to
2377 ;; profile this package using `elp'.
2378 ;;
2379 ;; Invalid indentation on purpose!
2380
2381 (cond (nil
2382 (setq elp-function-list
2383 '(window-end
2384 vertical-motion
2385 ; sit-for ;; elp can't handle advices...
2386 follow-mode
2387 follow-all-followers
2388 follow-split-followers
2389 follow-redisplay
2390 follow-downward
2391 follow-calculate-first-window-start
2392 follow-estimate-first-window-start
2393 follow-calculate-first-window-start-from-above
2394 follow-calculate-first-window-start-from-below
2395 follow-calc-win-end
2396 follow-calc-win-start
2397 follow-pos-visible
2398 follow-windows-start-end
2399 follow-cache-valid-p
2400 follow-select-if-visible
2401 follow-select-if-visible-from-first
2402 follow-windows-aligned-p
2403 follow-point-visible-all-windows-p
2404 follow-avoid-tail-recenter
2405 follow-update-window-start
2406 follow-post-command-hook
2407 ))))
2408
2409 ;;}}}
2410
2411 ;;{{{ The end
2412
2413 ;;;
2414 ;;; We're done!
2415 ;;;
2416
2417 (provide 'follow)
2418
2419 ;;}}}
2420
2421 ;; /------------------------------------------------------------------------\
2422 ;; | "I [..] am rarely happier then when spending an entire day programming |
2423 ;; | my computer to perform automatically a task that it would otherwise |
2424 ;; | take me a good ten seconds to do by hand. Ten seconds, I tell myself, |
2425 ;; | is ten seconds. Time is valuable and ten seconds' worth of it is well |
2426 ;; | worth the investment of a day's happy activity working out a way to |
2427 ;; | save it". -- Douglas Adams, "Last Chance to See" |
2428 ;; \------------------------------------------------------------------------/
2429
2430 ;;; follow.el ends here