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