comparison lisp/modes/follow.el @ 0:376386a54a3c r19-14

Import from CVS: tag r19-14
author cvs
date Mon, 13 Aug 2007 08:45:50 +0200
parents
children ac2d302a0011
comparison
equal deleted inserted replaced
-1:000000000000 0:376386a54a3c
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 ;; XEmacs: need this for the change in add-minor-mode
530 (fset 'follow-mode-map follow-mode-map)
531 (let ((map (make-sparse-keymap)))
532 (define-key map "\C-v" 'follow-scroll-up)
533 (define-key map "\M-v" 'follow-scroll-down)
534 (define-key map "v" 'follow-scroll-down)
535 (define-key map "1" 'follow-delete-other-windows-and-split)
536 (define-key map "b" 'follow-switch-to-buffer)
537 (define-key map "\C-b" 'follow-switch-to-buffer-all)
538 (define-key map "\C-l" 'follow-recenter)
539 (define-key map "<" 'follow-first-window)
540 (define-key map ">" 'follow-last-window)
541 (define-key map "n" 'follow-next-window)
542 (define-key map "p" 'follow-previous-window)
543
544 (define-key follow-mode-map follow-mode-prefix map)
545
546 ;; Replace the standard `end-of-buffer', when in Follow Mode. (I
547 ;; don't see the point in trying to replace every function which
548 ;; could be enhanced in Follow mode. End-of-buffer is a special
549 ;; case since it is very simple to define and it greatly enhances
550 ;; the look and feel of Follow mode.)
551 ;;
552 ;; (The function `substitute-key-definition' does not work
553 ;; in all versions of Emacs.)
554 (mapcar
555 (function
556 (lambda (pair)
557 (let ((old (car pair))
558 (new (cdr pair)))
559 (mapcar (function (lambda (key)
560 (define-key follow-mode-map key new)))
561 (where-is-internal old global-map)))))
562 '((end-of-buffer . follow-end-of-buffer)
563 (fkey-end-of-buffer . follow-end-of-buffer)))
564
565 ;;;
566 ;;; The menu.
567 ;;;
568
569 (if (not follow-emacs-version-xemacs-p)
570
571 ;;
572 ;; Emacs 19
573 ;;
574 (let ((menumap (funcall (symbol-function 'make-sparse-keymap)
575 "Follow"))
576 (count 0)
577 id)
578 (mapcar
579 (function
580 (lambda (item)
581 (setq id
582 (or (cdr item)
583 (progn
584 (setq count (+ count 1))
585 (intern (format "separator-%d" count)))))
586 (define-key menumap (vector id) item)
587 (or (eq id 'follow-mode)
588 (put id 'menu-enable 'follow-mode))))
589 ;; In reverse order:
590 '(("Toggle Follow mode" . follow-mode)
591 ("--")
592 ("Recenter" . follow-recenter)
593 ("--")
594 ("Previous Window" . follow-previous-window)
595 ("Next Windows" . follow-next-window)
596 ("Last Window" . follow-last-window)
597 ("First Window" . follow-first-window)
598 ("--")
599 ("Switch To Buffer (all windows)"
600 . follow-switch-to-buffer-all)
601 ("Switch To Buffer" . follow-switch-to-buffer)
602 ("--")
603 ("Delete Other Windows and Split"
604 . follow-delete-other-windows-and-split)
605 ("--")
606 ("Scroll Down" . follow-scroll-down)
607 ("Scroll Up" . follow-scroll-up)))
608
609 ;; If there is a `tools' meny, we use it. However, we can't add a
610 ;; minor-mode specific item to it (it's broken), so we make the
611 ;; contents ghosted when not in use, and add ourselves to the
612 ;; global map. If no `tools' menu is present, just make a
613 ;; top-level menu visible when the mode is activated.
614
615 (let ((tools-map (lookup-key (current-global-map) [menu-bar tools]))
616 (last nil))
617 (if (sequencep tools-map)
618 (progn
619 ;; Find the last entry in the menu and store it in `last'.
620 (mapcar (function
621 (lambda (x)
622 (setq last (or (cdr-safe
623 (cdr-safe
624 (cdr-safe x)))
625 last))))
626 tools-map)
627 (if last
628 (progn
629 (funcall (symbol-function 'define-key-after)
630 tools-map [separator-follow] '("--") last)
631 (funcall (symbol-function 'define-key-after)
632 tools-map [follow] (cons "Follow" menumap)
633 'separator-follow))
634 ;; Didn't find the last item, Adding to the top of
635 ;; tools. (This will probably never happend...)
636 (define-key (current-global-map) [menu-bar tools follow]
637 (cons "Follow" menumap))))
638 ;; No tools menu, add "Follow" to the menubar.
639 (define-key follow-mode-map [menu-bar follow]
640 (cons "Follow" menumap)))))
641
642 ;;
643 ;; XEmacs.
644 ;;
645
646 ;; place the menu in the `Tools' menu.
647 (let ((menu '("Follow"
648 :filter follow-menu-filter
649 ["Scroll Up" follow-scroll-up t]
650 ["Scroll Down" follow-scroll-down t]
651 ["Delete Other Windows and Split"
652 follow-delete-other-windows-and-split t]
653 ["Switch To Buffer" follow-switch-to-buffer t]
654 ["Switch To Buffer (all windows)"
655 follow-switch-to-buffer-all t]
656 ["First Window" follow-first-window t]
657 ["Last Window" follow-last-window t]
658 ["Next Windows" follow-next-window t]
659 ["Previous Window" follow-previous-window t]
660 ["Recenter" follow-recenter t]
661 ["Deactivate" follow-mode t])))
662
663 ;; Why not just `(set-buffer-menubar current-menubar)'? The
664 ;; question is a very good question. The reason is that under
665 ;; Emacs 19, neither `set-buffer-menubar' nor
666 ;; `current-menubar' is defined, hence the byte-compiler will
667 ;; warn.
668 (funcall (symbol-function 'set-buffer-menubar)
669 (symbol-value 'current-menubar))
670 (funcall (symbol-function 'add-submenu) '("Tools") menu))
671
672 ;; When the mode is not activated, only one item is visible:
673 ;; "Activate".
674 (defun follow-menu-filter (menu)
675 (if follow-mode
676 menu
677 '(["Activate " follow-mode t]))))))
678
679
680 ;;; Register the follow mode keymap.
681 ;(or (assq 'follow-mode minor-mode-map-alist)
682 ; (setq minor-mode-map-alist
683 ; (cons (cons 'follow-mode follow-mode-map) minor-mode-map-alist)))
684 ;; XEmacs: do it right. Author has been notified.
685 ;;;###autoload
686 (add-minor-mode 'follow-mode nil 'follow-mode-map)
687
688 ;;}}}
689 ;;{{{ Cache
690
691 (let ((cmds follow-cache-command-list))
692 (while cmds
693 (put (car cmds) 'follow-mode-use-cache t)
694 (setq cmds (cdr cmds))))
695
696 ;;}}}
697
698 ;;{{{ The mode
699
700 ;;;###autoload
701 (defun turn-on-follow-mode ()
702 "Turn on Follow mode. Please see the function `follow-mode'."
703 (interactive)
704 (follow-mode 1))
705
706
707 ;;;###autoload
708 (defun turn-off-follow-mode ()
709 "Turn off Follow mode. Please see the function `follow-mode'."
710 (interactive)
711 (follow-mode -1))
712
713
714 ;;;###autoload
715 (defun follow-mode (arg)
716 "Minor mode which combines windows into one tall virtual window.
717
718 The feeling of a \"virtual window\" has been accomplished by the use
719 of two major techniques:
720
721 * The windows always displays adjacent sections of the buffer.
722 This means that whenever one window is moved, all the
723 others will follow. (Hence the name Follow Mode.)
724
725 * Should the point (cursor) end up outside a window, another
726 window displaying that point is selected, if possible. This
727 makes it possible to walk between windows using normal cursor
728 movement commands.
729
730 Follow mode comes to its prime when used on a large screen and two
731 side-by-side window are used. The user can, with the help of Follow
732 mode, use two full-height windows as though they would have been
733 one. Imagine yourself editing a large function, or section of text,
734 and beeing able to use 144 lines instead of the normal 72... (your
735 mileage may vary).
736
737 To split one large window into two side-by-side windows, the commands
738 `\\[split-window-horizontally]' or \
739 `M-x follow-delete-other-windows-and-split' can be used.
740
741 Only windows displayed in the same frame follow each-other.
742
743 If the variable `follow-intercept-processes' is non-nil, Follow mode
744 will listen to the output of processes and redisplay accordingly.
745 \(This is the default.)
746
747 When Follow mode is switched on, the hook `follow-mode-hook'
748 is called. When turned off, `follow-mode-off-hook' is called.
749
750 Keys specific to Follow mode:
751 \\{follow-mode-map}"
752 (interactive "P")
753 (make-local-variable 'follow-mode)
754 (put 'follow-mode 'permanent-local t)
755 (let ((follow-mode-orig follow-mode))
756 (setq follow-mode
757 (if (null arg)
758 (not follow-mode)
759 (> (prefix-numeric-value arg) 0)))
760 (if (and follow-mode follow-intercept-processes)
761 (follow-intercept-process-output))
762 (cond ((and follow-mode (not follow-mode-orig)) ; On
763 ;; XEmacs: If this is non-nil, the window will scroll before
764 ;; the point will have a chance to get into the next window.
765 (if (boundp 'scroll-on-clipped-lines)
766 (set 'scroll-on-clipped-lines nil))
767 (force-mode-line-update)
768 (add-hook 'post-command-hook 'follow-post-command-hook t)
769 (if (boundp 'post-command-idle-hook)
770 (add-hook 'post-command-idle-hook
771 'follow-avoid-tail-recenter t))
772 (run-hooks 'follow-mode-hook))
773
774 ((and (not follow-mode) follow-mode-orig) ; Off
775 (force-mode-line-update)
776 (run-hooks 'follow-mode-off-hook)))))
777
778
779 ;; Register follow-mode as a minor mode.
780
781 (if (fboundp 'add-minor-mode)
782 ;; XEmacs
783 (funcall (symbol-function 'add-minor-mode)
784 'follow-mode 'follow-mode-line-text)
785 (or (assq 'follow-mode minor-mode-alist)
786 (setq minor-mode-alist
787 (cons '(follow-mode follow-mode-line-text) minor-mode-alist))))
788
789 ;;}}}
790 ;;{{{ Find file hook
791
792 ;; This will start follow-mode whenever a new file is loaded, if
793 ;; the variable `follow-auto' is non-nil.
794
795 (add-hook 'find-file-hooks 'follow-find-file-hook t)
796
797 (defun follow-find-file-hook ()
798 "Find-file hook for Follow Mode. See the variable `follow-auto'."
799 (if follow-auto (follow-mode t)))
800
801 ;;}}}
802
803 ;;{{{ User functions
804
805 ;;;
806 ;;; User functions usable when in Follow mode.
807 ;;;
808
809 ;;{{{ Scroll
810
811 ;; `scroll-up' and `-down', but for windows in Follow Mode.
812 ;;
813 ;; Almost like the real thing, excpet when the cursor ends up outside
814 ;; the top or bottom... In our case however, we end up outside the
815 ;; window and hence we are recenterd. Should we let `recenter' handle
816 ;; the point position we would never leave the selected window. To do
817 ;; it ourselves we would need to do our own redisplay, which is easier
818 ;; said than done. (Why didn't I do a real display abstraction from
819 ;; the beginning?)
820 ;;
821 ;; We must sometimes set `follow-internal-force-redisplay', otherwise
822 ;; our post-command-hook will move our windows back into the old
823 ;; position... (This would also be corrected if we would have had a
824 ;; good redisplay abstraction.)
825
826 (defun follow-scroll-up (&optional arg)
827 "Scroll text in a Follow Mode window chain up.
828
829 If called with no ARG, the `next-screen-context-lines' last lines of
830 the bottom window in the chain will be visible in the top window.
831
832 If called with an argument, scroll ARG lines up.
833 Negative ARG means scroll downward.
834
835 Works like `scroll-up' when not in Follow Mode."
836 (interactive "P")
837 (cond ((not (and (boundp 'follow-mode) follow-mode))
838 (scroll-up arg))
839 (arg
840 (save-excursion (scroll-up arg))
841 (setq follow-internal-force-redisplay t))
842 (t
843 (let* ((windows (follow-all-followers))
844 (end (window-end (car (reverse windows)))))
845 (if (eq end (point-max))
846 (signal 'end-of-buffer nil)
847 (select-window (car windows))
848 (goto-char end)
849 (vertical-motion (- next-screen-context-lines))
850 (set-window-start (car windows) (point)))))))
851
852
853 (defun follow-scroll-down (&optional arg)
854 "Scroll text in a Follow Mode window chain down.
855
856 If called with no ARG, the `next-screen-context-lines' top lines of
857 the top window in the chain will be visible in the bottom window.
858
859 If called with an argument, scroll ARG lines down.
860 Negative ARG means scroll upward.
861
862 Works like `scroll-up' when not in Follow Mode."
863 (interactive "P")
864 (cond ((not (and (boundp 'follow-mode) follow-mode))
865 (scroll-up arg))
866 (arg
867 (save-excursion (scroll-down arg)))
868 (t
869 (let* ((windows (follow-all-followers))
870 (win (car (reverse windows)))
871 (start (window-start (car windows))))
872 (if (eq start (point-min))
873 (signal 'beginning-of-buffer nil)
874 (select-window win)
875 (goto-char start)
876 (vertical-motion (- (- (window-height win)
877 1
878 next-screen-context-lines)))
879 (set-window-start win (point))
880 (goto-char start)
881 (vertical-motion (- next-screen-context-lines 1))
882 (setq follow-internal-force-redisplay t))))))
883
884 ;;}}}
885 ;;{{{ Buffer
886
887 ;;;###autoload
888 (defun follow-delete-other-windows-and-split (&optional arg)
889 "Create two side by side windows and enter Follow Mode.
890
891 Execute this command to display as much as possible of the text
892 in the selected window. All other windows, in the current
893 frame, are deleted and the selected window is split in two
894 side-by-side windows. Follow Mode is activated, hence the
895 two windows always will display two successive pages.
896 \(If one window is moved, the other one will follow.)
897
898 If ARG is positive, the leftmost window is selected. If it negative,
899 the rightmost is selected. If ARG is nil, the leftmost window is
900 selected if the original window is the first one in the frame.
901
902 To bind this command to a hotkey, place the following line
903 in your `~/.emacs' file, replacing [f7] by your favourite key:
904 (global-set-key [f7] 'follow-delete-other-windows-and-split)"
905 (interactive "P")
906 (let ((other (or (and (null arg)
907 (not (eq (selected-window)
908 (frame-first-window (selected-frame)))))
909 (and arg
910 (< (prefix-numeric-value arg) 0))))
911 (start (window-start)))
912 (delete-other-windows)
913 (split-window-horizontally)
914 (if other
915 (progn
916 (other-window 1)
917 (set-window-start (selected-window) start)
918 (setq follow-internal-force-redisplay t)))
919 (follow-mode 1)))
920
921 (defun follow-switch-to-buffer (buffer)
922 "Show BUFFER in all windows in the current Follow Mode window chain."
923 (interactive "BSwitch to Buffer: ")
924 (let ((orig-window (selected-window))
925 (windows (follow-all-followers)))
926 (while windows
927 (select-window (car windows))
928 (switch-to-buffer buffer)
929 (setq windows (cdr windows)))
930 (select-window orig-window)))
931
932
933 (defun follow-switch-to-buffer-all (&optional buffer)
934 "Show BUFFER in all windows on this frame.
935 Defaults to current buffer."
936 (interactive (list (read-buffer "Switch to Buffer: "
937 (current-buffer))))
938 (or buffer (setq buffer (current-buffer)))
939 (let ((orig-window (selected-window)))
940 (walk-windows
941 (function
942 (lambda (win)
943 (select-window win)
944 (switch-to-buffer buffer))))
945 (select-window orig-window)
946 (follow-redisplay)))
947
948
949 (defun follow-switch-to-current-buffer-all ()
950 "Show current buffer in all windows on this frame, and enter Follow Mode.
951
952 To bind this command to a hotkey place the following line
953 in your `~/.emacs' file:
954 (global-set-key [f7] 'follow-switch-to-current-buffer-all)"
955 (interactive)
956 (or (and (boundp 'follow-mode) follow-mode)
957 (follow-mode 1))
958 (follow-switch-to-buffer-all))
959
960 ;;}}}
961 ;;{{{ Movement
962
963 ;; Note, these functions are not very useful, atleast not unless you
964 ;; rebind the rather cumbersome key sequence `C-c . p'.
965
966 (defun follow-next-window ()
967 "Select the next window showing the same buffer."
968 (interactive)
969 (let ((succ (cdr (follow-split-followers (follow-all-followers)))))
970 (if succ
971 (select-window (car succ))
972 (error "%s" "No more windows"))))
973
974
975 (defun follow-previous-window ()
976 "Select the previous window showing the same buffer."
977 (interactive)
978 (let ((pred (car (follow-split-followers (follow-all-followers)))))
979 (if pred
980 (select-window (car pred))
981 (error "%s" "No more windows"))))
982
983
984 (defun follow-first-window ()
985 "Select the first window in the frame showing the same buffer."
986 (interactive)
987 (select-window (car (follow-all-followers))))
988
989
990 (defun follow-last-window ()
991 "Select the last window in the frame showing the same buffer."
992 (interactive)
993 (select-window (car (reverse (follow-all-followers)))))
994
995 ;;}}}
996 ;;{{{ Redraw
997
998 (defun follow-recenter (&optional arg)
999 "Recenter the middle window around the point,
1000 and rearrange all other windows around the middle window.
1001
1002 With a positive argument, place the current line ARG lines
1003 from the top. With a negative, place it -ARG lines from the
1004 bottom."
1005 (interactive "P")
1006 (if arg
1007 (let ((p (point))
1008 (arg (prefix-numeric-value arg)))
1009 (if (>= arg 0)
1010 ;; Recenter relative to the top.
1011 (progn
1012 (follow-first-window)
1013 (goto-char p)
1014 (recenter arg))
1015 ;; Recenter relative to the bottom.
1016 (follow-last-window)
1017 (goto-char p)
1018 (recenter arg)
1019 ;; Otherwise, our post-command-hook will move the window
1020 ;; right back.
1021 (setq follow-internal-force-redisplay t)))
1022 ;; Recenter in the middle.
1023 (let* ((dest (point))
1024 (windows (follow-all-followers))
1025 (win (nth (/ (- (length windows) 1) 2) windows)))
1026 (select-window win)
1027 (goto-char dest)
1028 (recenter)
1029 ;;(setq follow-internal-force-redisplay t)
1030 )))
1031
1032
1033 (defun follow-redraw ()
1034 "Arrange windows displaying the same buffer in successor order.
1035 This function can be called even if the buffer is not in Follow mode.
1036
1037 Hopefully, there should be no reason to call this function when in
1038 Follow mode since the windows should always be aligned."
1039 (interactive)
1040 (sit-for 0)
1041 (follow-redisplay))
1042
1043 ;;}}}
1044 ;;{{{ End of buffer
1045
1046 (defun follow-end-of-buffer (&optional arg)
1047 "Move point to the end of the buffer. Follow Mode style.
1048
1049 If the end is not visible, it will be displayed in the last possible
1050 window in the Follow Mode window chain.
1051
1052 The mark is left at the previous position. With arg N, put point N/10
1053 of the way from the true end."
1054 (interactive "P")
1055 (let ((followers (follow-all-followers))
1056 (pos (point)))
1057 (cond (arg
1058 (select-window (car (reverse followers))))
1059 ((follow-select-if-end-visible
1060 (follow-windows-start-end followers)))
1061 (t
1062 (select-window (car (reverse followers)))))
1063 (goto-char pos)
1064 (end-of-buffer arg)))
1065
1066 ;;}}}
1067
1068 ;;}}}
1069
1070 ;;{{{ Display
1071
1072 ;;;; The display routines
1073
1074 ;;{{{ Information gathering functions
1075
1076 (defun follow-all-followers (&optional testwin)
1077 "Return all windows displaying the same buffer as the TESTWIN.
1078 The list contains only windows displayed in the same frame as TESTWIN.
1079 If TESTWIN is nil the selected window is used."
1080 (or (and testwin (window-live-p testwin))
1081 (setq testwin (selected-window)))
1082 (let* ((top (frame-first-window (window-frame testwin)))
1083 (win top)
1084 (done nil)
1085 (windows '())
1086 (buffer (window-buffer testwin)))
1087 (while (and (not done) win)
1088 (if (eq (window-buffer win) buffer)
1089 (setq windows (cons win windows)))
1090 (setq win (next-window win 'not))
1091 (if (eq win top)
1092 (setq done t)))
1093 (nreverse windows)))
1094
1095
1096 (defun follow-split-followers (windows &optional win)
1097 "Split the WINDOWS into the sets: predecessors and successors.
1098 Return `(PRED . SUCC)' where `PRED' and `SUCC' are ordered starting
1099 from the selected window."
1100 (or win
1101 (setq win (selected-window)))
1102 (let ((pred '()))
1103 (while (not (eq (car windows) win))
1104 (setq pred (cons (car windows) pred))
1105 (setq windows (cdr windows)))
1106 (cons pred (cdr windows))))
1107
1108
1109 ;; Try to optimize this function for speed!
1110
1111 (defun follow-calc-win-end (&optional win)
1112 "Calculate the presumed window end for WIN.
1113
1114 Actually, the position returned is the start of the next
1115 window, normally is the end plus one.
1116
1117 If WIN is nil, the selected window is used.
1118
1119 Returns (end-pos end-of-buffer-p)"
1120 (if follow-emacs-version-xemacs-p
1121 ;; XEmacs can calculate the end of the window by using
1122 ;; the 'guarantee options. GOOD!
1123 (let ((end (window-end win t)))
1124 (if (= end (funcall (symbol-function 'point-max)
1125 (window-buffer win)))
1126 (list end t)
1127 (list (+ end 1) nil)))
1128 ;; Emacs 19: We have to calculate the end by ourselves.
1129 ;; This code works on both XEmacs and Emacs 19, but now
1130 ;; that XEmacs has got custom-written code, this could
1131 ;; be optimized for Emacs 19.
1132 (let ((orig-win (and win (selected-window)))
1133 height
1134 buffer-end-p)
1135 (if win (select-window win))
1136 (prog1
1137 (save-excursion
1138 (goto-char (window-start))
1139 (setq height (- (window-height) 1))
1140 (setq buffer-end-p
1141 (if (bolp)
1142 (not (= height (vertical-motion height)))
1143 (save-restriction
1144 ;; Fix a mis-feature in `vertical-motion':
1145 ;; The start of the window is assumed to
1146 ;; coinside with the start of a line.
1147 (narrow-to-region (point) (point-max))
1148 (not (= height (vertical-motion height))))))
1149 (list (point) buffer-end-p))
1150 (if orig-win
1151 (select-window orig-win))))))
1152
1153
1154 ;; Can't use `save-window-excursion' since it triggers a redraw.
1155 (defun follow-calc-win-start (windows pos win)
1156 "Calculate where WIN will start if the first in WINDOWS start at POS.
1157
1158 If WIN is nil the point below all windows is returned."
1159 (let (start)
1160 (while (and windows (not (eq (car windows) win)))
1161 (setq start (window-start (car windows)))
1162 (set-window-start (car windows) pos 'noforce)
1163 (setq pos (car (inline (follow-calc-win-end (car windows)))))
1164 (set-window-start (car windows) start 'noforce)
1165 (setq windows (cdr windows)))
1166 pos))
1167
1168
1169 ;; The result from `follow-windows-start-end' is cached when using
1170 ;; a handful simple commands, like cursor movement commands.
1171
1172 (defsubst follow-cache-valid-p (windows)
1173 "Test if the cached value of `follow-windows-start-end' can be used.
1174 Note that this handles the case when the cache has been set to nil."
1175 (let ((res t)
1176 (cache follow-windows-start-end-cache))
1177 (while (and res windows cache)
1178 (setq res (and (eq (car windows)
1179 (car (car cache)))
1180 (eq (window-start (car windows))
1181 (car (cdr (car cache))))))
1182 (setq windows (cdr windows))
1183 (setq cache (cdr cache)))
1184 (and res (null windows) (null cache))))
1185
1186
1187 (defsubst follow-invalidate-cache ()
1188 "Force `follow-windows-start-end' to recalculate the end of the window."
1189 (setq follow-windows-start-end-cache nil))
1190
1191
1192 ;; Build a list of windows and their start and end positions.
1193 ;; Useful to avoid calculating start/end position whenever they are needed.
1194 ;; The list has the format:
1195 ;; ((Win Start End End-of-buffer-visible-p) ...)
1196
1197 ;; Used to have a `save-window-excursion', but it obviously triggered
1198 ;; redraws of the display. Check if I used it for anything.
1199
1200
1201 (defun follow-windows-start-end (windows)
1202 "Builds a list of (WIN START END BUFFER-END-P) for every window in WINDOWS."
1203 (if (follow-cache-valid-p windows)
1204 follow-windows-start-end-cache
1205 (let ((win-start-end '())
1206 (orig-win (selected-window)))
1207 (while windows
1208 (select-window (car windows))
1209 (setq win-start-end
1210 (cons (cons (car windows)
1211 (cons (window-start)
1212 (follow-calc-win-end)))
1213 win-start-end))
1214 (setq windows (cdr windows)))
1215 (select-window orig-win)
1216 (setq follow-windows-start-end-cache (nreverse win-start-end))
1217 follow-windows-start-end-cache)))
1218
1219
1220 (defun follow-pos-visible (pos win win-start-end)
1221 "Non-nil when POS is visible in WIN."
1222 (let ((wstart-wend-bend (cdr (assq win win-start-end))))
1223 (and (>= pos (car wstart-wend-bend))
1224 (or (< pos (car (cdr wstart-wend-bend)))
1225 (nth 2 wstart-wend-bend)))))
1226
1227
1228 ;; By `aligned' we mean that for all adjecent windows, the end of the
1229 ;; first is equal with the start of the successor. The first window
1230 ;; should start at a full screen line.
1231
1232 (defun follow-windows-aligned-p (win-start-end)
1233 "Non-nil if the follower WINDOWS are alinged."
1234 (let ((res t))
1235 (save-excursion
1236 (goto-char (window-start (car (car win-start-end))))
1237 (if (bolp)
1238 nil
1239 (vertical-motion 0 (car (car win-start-end)))
1240 (setq res (eq (point) (window-start (car (car win-start-end)))))))
1241 (while (and res (cdr win-start-end))
1242 ;; At least two followers left
1243 (setq res (eq (car (cdr (cdr (car win-start-end))))
1244 (car (cdr (car (cdr win-start-end))))))
1245 (setq win-start-end (cdr win-start-end)))
1246 res))
1247
1248
1249 ;; Check if the point is visible in all windows. (So that
1250 ;; no one will be recentered.)
1251
1252 (defun follow-point-visible-all-windows-p (win-start-end)
1253 "Non-nil when the window-point is visible in all windows."
1254 (let ((res t))
1255 (while (and res win-start-end)
1256 (setq res (follow-pos-visible (window-point (car (car win-start-end)))
1257 (car (car win-start-end))
1258 win-start-end))
1259 (setq win-start-end (cdr win-start-end)))
1260 res))
1261
1262
1263 ;; Make sure WIN always starts at the beginning of an whole screen
1264 ;; line. If WIN is not aligned the start is updated which probably
1265 ;; will lead to a redisplay of the screen later on.
1266 ;;
1267 ;; This is used with the first window in a follow chain. The reason
1268 ;; is that we want to detect that the point is outside the window.
1269 ;; (Without the update, the start of the window will move as the
1270 ;; user presses BackSpace, and the other window redisplay routines
1271 ;; will move the start of the window in the wrong direction.)
1272
1273 (defun follow-update-window-start (win)
1274 "Make sure that the start of WIN starts at a full screen line."
1275 (save-excursion
1276 (goto-char (window-start win))
1277 (if (bolp)
1278 nil
1279 (vertical-motion 0 win)
1280 (if (eq (point) (window-start win))
1281 nil
1282 (vertical-motion 1 win)
1283 (set-window-start win (point) 'noforce)))))
1284
1285 ;;}}}
1286 ;;{{{ Selection functions
1287
1288 ;; Make a window in WINDOWS selected if it currently
1289 ;; is displaying the position DEST.
1290 ;;
1291 ;; We don't select a window if it just has been moved.
1292
1293 (defun follow-select-if-visible (dest win-start-end)
1294 "Select and return a window, if DEST is visible in it.
1295 Return the selected window."
1296 (let ((win nil))
1297 (while (and (not win) win-start-end)
1298 ;; Don't select a window which was just moved. This makes it
1299 ;; possible to later select the last window after a `end-of-buffer'
1300 ;; command.
1301 (if (follow-pos-visible dest (car (car win-start-end)) win-start-end)
1302 (progn
1303 (setq win (car (car win-start-end)))
1304 (select-window win)))
1305 (setq win-start-end (cdr win-start-end)))
1306 win))
1307
1308
1309 ;; Lets select a window showing the end. Make sure we only select it if it
1310 ;; it wasn't just moved here. (i.e. M-> shall not unconditionally place
1311 ;; the point in the selected window.)
1312 ;;
1313 ;; (Compability cludge: in Emacs 19 `window-end' is equal to `point-max';
1314 ;; in XEmacs, it is equal to `point-max + 1'. Should I really bother
1315 ;; checking `window-end' now when I check `end-of-buffer' explicitylt?)
1316
1317 (defun follow-select-if-end-visible (win-start-end)
1318 "Select and return a window, if end is visible in it."
1319 (let ((win nil))
1320 (while (and (not win) win-start-end)
1321 ;; Don't select a window which was just moved. This makes it
1322 ;; possible to later select the last window after a `end-of-buffer'
1323 ;; command.
1324 (if (and (eq (point-max) (nth 2 (car win-start-end)))
1325 (nth 3 (car win-start-end))
1326 (eq (point-max) (min (point-max)
1327 (window-end (car (car win-start-end))))))
1328 (progn
1329 (setq win (car (car win-start-end)))
1330 (select-window win)))
1331 (setq win-start-end (cdr win-start-end)))
1332 win))
1333
1334
1335 ;; Select a window which will display the point if the windows would
1336 ;; be redisplayed with the first window fixed. This is useful for
1337 ;; example when the user has pressed return at the bottom of a window
1338 ;; as the point is not visible in any window.
1339
1340 (defun follow-select-if-visible-from-first (dest windows)
1341 "Select and return a window with DEST, if WINDOWS are redrawn from top."
1342 (let ((win nil)
1343 end-pos-end-p)
1344 (save-excursion
1345 (goto-char (window-start (car windows)))
1346 ;; Make sure the line start in the beginning of a real screen
1347 ;; line.
1348 (vertical-motion 0 (car windows))
1349 (if (< dest (point))
1350 ;; Above the start, not visible.
1351 nil
1352 ;; At or below the start. Check the windows.
1353 (save-window-excursion
1354 (while (and (not win) windows)
1355 (set-window-start (car windows) (point) 'noforce)
1356 (setq end-pos-end-p (follow-calc-win-end (car windows)))
1357 (goto-char (car end-pos-end-p))
1358 ;; Visible, if dest above end, or if eob is visible inside
1359 ;; the window.
1360 (if (or (car (cdr end-pos-end-p))
1361 (< dest (point)))
1362 (setq win (car windows))
1363 (setq windows (cdr windows)))))))
1364 (if win
1365 (select-window win))
1366 win))
1367
1368
1369 ;;}}}
1370 ;;{{{ Redisplay
1371
1372 ;; Redraw all the windows on the screen, starting with the top window.
1373 ;; The window used as as marker is WIN, or the selcted window if WIN
1374 ;; is nil.
1375
1376 (defun follow-redisplay (&optional windows win)
1377 "Reposition the WINDOWS around WIN.
1378 Should the point be too close to the roof we redisplay everything
1379 from the top. WINDOWS should contain a list of windows to
1380 redisplay, it is assumed that WIN is a member of the list.
1381 Should WINDOWS be nil, the windows displaying the
1382 same buffer as WIN, in the current frame, are used.
1383 Should WIN be nil, the selected window is used."
1384 (or win
1385 (setq win (selected-window)))
1386 (or windows
1387 (setq windows (follow-all-followers win)))
1388 (follow-downward windows (follow-calculate-first-window-start windows win)))
1389
1390
1391 ;; Redisplay a chain of windows. Start every window directly after the
1392 ;; end of the previous window, to make sure long lines are displayed
1393 ;; correctly.
1394
1395 (defun follow-downward (windows pos)
1396 "Redisplay all WINDOWS starting at POS."
1397 (while windows
1398 (set-window-start (car windows) pos)
1399 (setq pos (car (follow-calc-win-end (car windows))))
1400 (setq windows (cdr windows))))
1401
1402
1403 ;;(defun follow-downward (windows pos)
1404 ;; "Redisplay all WINDOWS starting at POS."
1405 ;; (let (p)
1406 ;; (while windows
1407 ;; (setq p (window-point (car windows)))
1408 ;; (set-window-start (car windows) pos)
1409 ;; (set-window-point (car windows) (max p pos))
1410 ;; (setq pos (car (follow-calc-win-end (car windows))))
1411 ;; (setq windows (cdr windows)))))
1412
1413
1414 ;; Return the start of the first window.
1415 ;;
1416 ;; First, estimate the position. It the value is not perfect (i.e. we
1417 ;; have somewhere splited a line between windows) we try to enhance
1418 ;; the value.
1419 ;;
1420 ;; The guess is always perfect if no long lines is split between
1421 ;; windows.
1422 ;;
1423 ;; The worst case peformace of probably very bad, but it is very
1424 ;; unlikely that we ever will miss the correct start by more than one
1425 ;; or two lines.
1426
1427 (defun follow-calculate-first-window-start (windows &optional win start)
1428 "Calculate the start of the first window.
1429
1430 WINDOWS is a chain of windows to work with. WIN is the window
1431 to recenter around. It is assumed that WIN starts at position
1432 START."
1433 (or win
1434 (setq win (selected-window)))
1435 (or start
1436 (setq start (window-start win)))
1437 (let ((guess (follow-estimate-first-window-start windows win start)))
1438 (if (car guess)
1439 (cdr guess)
1440 ;; The guess wasn't exact, try to enhance it.
1441 (let ((win-start (follow-calc-win-start windows (cdr guess) win)))
1442 (cond ((= win-start start)
1443 (follow-debug-message "exact")
1444 (cdr guess))
1445 ((< win-start start)
1446 (follow-debug-message "above")
1447 (follow-calculate-first-window-start-from-above
1448 windows (cdr guess) win start))
1449 (t
1450 (follow-debug-message "below")
1451 (follow-calculate-first-window-start-from-below
1452 windows (cdr guess) win start)))))))
1453
1454
1455 ;; `exact' is disabled due to XEmacs and fonts of variable
1456 ;; height.
1457 (defun follow-estimate-first-window-start (windows win start)
1458 "Estimate the position of the first window.
1459
1460 Returns (EXACT . POS). If EXACT is non-nil, POS is the starting
1461 position of the first window. Otherwise it is a good guess."
1462 (let ((pred (car (follow-split-followers windows win)))
1463 (exact nil))
1464 (save-excursion
1465 (goto-char start)
1466 ;(setq exact (bolp))
1467 (vertical-motion 0 win)
1468 (while pred
1469 (vertical-motion (- 1 (window-height (car pred))) (car pred))
1470 (if (not (bolp))
1471 (setq exact nil))
1472 (setq pred (cdr pred)))
1473 (cons exact (point)))))
1474
1475
1476 ;; Find the starting point, start at GUESS and search downward.
1477 ;; The returned point is always a point below GUESS.
1478
1479 (defun follow-calculate-first-window-start-from-above
1480 (windows guess win start)
1481 (save-excursion
1482 (let ((done nil)
1483 win-start
1484 res)
1485 (goto-char guess)
1486 (while (not done)
1487 (if (not (= (vertical-motion 1 (car windows)) 1))
1488 ;; Hit bottom! (Can we really do this?)
1489 ;; We'll keep it, since it ensures termination.
1490 (progn
1491 (setq done t)
1492 (setq res (point-max)))
1493 (setq win-start (follow-calc-win-start windows (point) win))
1494 (if (>= win-start start)
1495 (progn
1496 (setq done t)
1497 (setq res (point))))))
1498 res)))
1499
1500
1501 ;; Find the starting point, start at GUESS and search upward. Return
1502 ;; a point on the same line as GUESS, or above.
1503 ;;
1504 ;; (Is this ever used? I must make sure it works just in case it is
1505 ;; ever called.)
1506
1507 (defun follow-calculate-first-window-start-from-below
1508 (windows guess &optional win start)
1509 (setq win (or win (selected-window)))
1510 (setq start (or start (window-start win)))
1511 (save-excursion
1512 (let ((done nil)
1513 win-start
1514 res)
1515 ;; Always calculate what happend when no line is displayed in the first
1516 ;; window. (The `previous' res is needed below!)
1517 (goto-char guess)
1518 (vertical-motion 0 (car windows))
1519 (setq res (point))
1520 (while (not done)
1521 (if (not (= (vertical-motion -1 (car windows)) -1))
1522 ;; Hit roof!
1523 (progn
1524 (setq done t)
1525 (setq res (point-min)))
1526 (setq win-start (follow-calc-win-start windows (point) win))
1527 (cond ((= win-start start) ; Perfect match, use this value
1528 (setq done t)
1529 (setq res (point)))
1530 ((< win-start start) ; Walked to far, use preious result
1531 (setq done t))
1532 (t ; Store result for next iteration
1533 (setq res (point))))))
1534 res)))
1535
1536 ;;}}}
1537 ;;{{{ Avoid tail recenter
1538
1539 ;; This sets the window internal flag `force_start'. The effect is that
1540 ;; windows only displaying the tail isn't recentered.
1541 ;; Has to be called before every redisplay... (Great isn't it?)
1542 ;;
1543 ;; XEmacs doesn't recenter the tail, GOOD!
1544 ;;
1545 ;; A window displaying only the tail, is a windows whose
1546 ;; window-start position is equal to (point-max) of the buffer it
1547 ;; displays.
1548 ;;
1549 ;; This function is also added to `post-command-idle-hook', introduced
1550 ;; in Emacs 19.30. This is needed since the vaccine injected by the
1551 ;; call from `post-command-hook' only works until the next redisplay.
1552 ;; It is possible that the functions in the `post-command-idle-hook'
1553 ;; can cause a redisplay, and hence a new vaccine is needed.
1554 ;;
1555 ;; Sometimes, calling this function could actually cause a redisplay,
1556 ;; especially if it is placed in the debug filter section. I must
1557 ;; investigate this further...
1558
1559 (defun follow-avoid-tail-recenter (&rest rest)
1560 "Make sure windows displaying the end of a buffer aren't recentered.
1561
1562 This is done by reading and rewriting the start positon of
1563 non-first windows in Follow Mode."
1564 (if follow-avoid-tail-recenter-p
1565 (let* ((orig-buffer (current-buffer))
1566 (top (frame-first-window (selected-frame)))
1567 (win top)
1568 (who '()) ; list of (buffer . frame)
1569 start
1570 pair) ; (buffer . frame)
1571 ;; If the only window in the frame is a minibuffer
1572 ;; window, `next-window' will never find it again...
1573 (if (window-minibuffer-p top)
1574 nil
1575 (while ;; look, no body!
1576 (progn
1577 (setq start (window-start win))
1578 (set-buffer (window-buffer win))
1579 (setq pair (cons (window-buffer win) (window-frame win)))
1580 (if (member pair who)
1581 (if (and (boundp 'follow-mode) follow-mode
1582 (eq (point-max) start))
1583 ;; Write the same window start back, but don't
1584 ;; set the NOFORCE flag.
1585 (set-window-start win start))
1586 (setq who (cons pair who)))
1587 (setq win (next-window win 'not t))
1588 (not (eq win top)))) ;; Loop while this is true.
1589 (set-buffer orig-buffer)))))
1590
1591 ;;}}}
1592
1593 ;;}}}
1594 ;;{{{ Post Command Hook
1595
1596 ;;; The magic little box. This function is called after every command.
1597
1598 ;; This is not as complicated as it seems. It is simply a list of common
1599 ;; display situations and the actions to take, plus commands for redrawing
1600 ;; the screen if it should be unaligned.
1601 ;;
1602 ;; We divide the check into two parts; whether we are at the end or not.
1603 ;; This is due to the fact that the end can actaually be visible
1604 ;; in several window even though they are aligned.
1605
1606 (defun follow-post-command-hook ()
1607 "Ensure that the windows in Follow mode are adjecent after each command."
1608 (setq follow-inside-post-command-hook t)
1609 (if (or (not (input-pending-p))
1610 ;; Sometimes, in XEmacs, mouse events are not handled
1611 ;; properly by `input-pending-p'. A typical example is
1612 ;; when clicking on a node in `info'.
1613 (and (boundp 'current-mouse-event)
1614 (symbol-value 'current-mouse-event)
1615 (fboundp 'button-event-p)
1616 (funcall (symbol-function 'button-event-p)
1617 (symbol-value 'current-mouse-event))))
1618 ;; Work in the selected window, not in the current buffer.
1619 (let ((orig-buffer (current-buffer))
1620 (win (selected-window)))
1621 (set-buffer (window-buffer win))
1622 (or (and (symbolp this-command)
1623 (get this-command 'follow-mode-use-cache))
1624 (follow-invalidate-cache))
1625 (if (and (boundp 'follow-mode) follow-mode
1626 (not (window-minibuffer-p win)))
1627 ;; The buffer shown in the selected window is in follow
1628 ;; mode, lets find the current state of the display and
1629 ;; cache the result for speed (i.e. `aligned' and `visible'.)
1630 (let* ((windows (inline (follow-all-followers win)))
1631 (dest (point))
1632 (win-start-end (inline
1633 (follow-update-window-start (car windows))
1634 (follow-windows-start-end windows)))
1635 (aligned (follow-windows-aligned-p win-start-end))
1636 (visible (follow-pos-visible dest win win-start-end)))
1637 (if (not (and aligned visible))
1638 (follow-invalidate-cache))
1639 (inline (follow-avoid-tail-recenter))
1640 ;; Select a window to display the point.
1641 (or follow-internal-force-redisplay
1642 (progn
1643 (if (eq dest (point-max))
1644 ;; We're at the end, we have be be careful since
1645 ;; the display can be aligned while `dest' can
1646 ;; be visible in several windows.
1647 (cond
1648 ;; Select the current window, but only when
1649 ;; the display is correct. (When inserting
1650 ;; character in a tail window, the display is
1651 ;; not correct, as they are shown twice.)
1652 ;;
1653 ;; Never stick to the current window after a
1654 ;; deletion. The reason is cosmetic, when
1655 ;; typing `DEL' in a window showing only the
1656 ;; end of the file, character are removed
1657 ;; from the window above, which is very
1658 ;; unintuitive.
1659 ((and visible
1660 aligned
1661 (not (memq this-command
1662 '(backward-delete-char
1663 delete-backward-char
1664 backward-delete-char-untabify
1665 kill-region))))
1666 (follow-debug-message "Max: same"))
1667 ;; If the end is visible, and the window
1668 ;; doesn't seems like it just has been moved,
1669 ;; select it.
1670 ((follow-select-if-end-visible win-start-end)
1671 (follow-debug-message "Max: end visible")
1672 (setq visible t)
1673 (setq aligned nil)
1674 (goto-char dest))
1675 ;; Just show the end...
1676 (t
1677 (follow-debug-message "Max: default")
1678 (select-window (car (reverse windows)))
1679 (goto-char dest)
1680 (setq visible nil)
1681 (setq aligned nil)))
1682
1683 ;; We're not at the end, here life is much simpler.
1684 (cond
1685 ;; This is the normal case!
1686 ;; It should be optimized for speed.
1687 ((and visible aligned)
1688 (follow-debug-message "same"))
1689 ;; Pick a position in any window. If the
1690 ;; display is ok, this will pick the `correct'
1691 ;; window. If the display is wierd do this
1692 ;; anyway, this will be the case after a delete
1693 ;; at the beginning of the window.
1694 ((follow-select-if-visible dest win-start-end)
1695 (follow-debug-message "visible")
1696 (setq visible t)
1697 (goto-char dest))
1698 ;; Not visible anywhere else, lets pick this one.
1699 ;; (Is this case used?)
1700 (visible
1701 (follow-debug-message "visible in selected."))
1702 ;; Far out!
1703 ((eq dest (point-min))
1704 (follow-debug-message "min")
1705 (select-window (car windows))
1706 (goto-char dest)
1707 (set-window-start (selected-window) (point-min))
1708 (setq win-start-end (follow-windows-start-end windows))
1709 (follow-invalidate-cache)
1710 (setq visible t)
1711 (setq aligned nil))
1712 ;; If we can position the cursor without moving the first
1713 ;; window, do it. This is the case which catches `RET'
1714 ;; at the bottom of a window.
1715 ((follow-select-if-visible-from-first dest windows)
1716 (follow-debug-message "Below first")
1717 (setq visible t)
1718 (setq aligned t)
1719 (follow-redisplay windows (car windows))
1720 (goto-char dest))
1721 ;; None of the above. For simplicity, we stick to the
1722 ;; selected window.
1723 (t
1724 (follow-debug-message "None")
1725 (setq visible nil)
1726 (setq aligned nil))))
1727 ;; If a new window has been selected, make sure that the
1728 ;; old is not scrolled when the point is outside the
1729 ;; window.
1730 (or (eq win (selected-window))
1731 (let ((p (window-point win)))
1732 (set-window-start win (window-start win) nil)
1733 (set-window-point win p)))))
1734 ;; Make sure the point is visible in the selected window.
1735 ;; (This could lead to a scroll.)
1736 (if (or visible
1737 (follow-pos-visible dest win win-start-end))
1738 nil
1739 (sit-for 0)
1740 (follow-avoid-tail-recenter)
1741 (setq win-start-end (follow-windows-start-end windows))
1742 (follow-invalidate-cache)
1743 (setq aligned nil))
1744 ;; Redraw the windows whenever needed.
1745 (if (or follow-internal-force-redisplay
1746 (not (or aligned
1747 (follow-windows-aligned-p win-start-end)))
1748 (not (inline (follow-point-visible-all-windows-p
1749 win-start-end))))
1750 (progn
1751 (setq follow-internal-force-redisplay nil)
1752 (follow-redisplay windows (selected-window))
1753 (setq win-start-end (follow-windows-start-end windows))
1754 (follow-invalidate-cache)
1755 ;; When the point ends up in another window. This
1756 ;; happends when dest is in the beginning of the
1757 ;; file and the selected window is not the first.
1758 ;; It can also, in rare situations happend when
1759 ;; long lines are used and there is a big
1760 ;; difference between the width of the windows.
1761 ;; (When scrolling one line in a wide window which
1762 ;; will cause a move larger that an entire small
1763 ;; window.)
1764 (if (follow-pos-visible dest win win-start-end)
1765 nil
1766 (follow-select-if-visible dest win-start-end)
1767 (goto-char dest))))
1768
1769 ;; If the region is visible, make it look good when spanning
1770 ;; multiple windows.
1771 (if (or (and (boundp 'mark-active) (symbol-value 'mark-active))
1772 (and (fboundp 'region-active-p)
1773 (funcall (symbol-function 'region-active-p))))
1774 (follow-maximize-region
1775 (selected-window) windows win-start-end))
1776
1777 (inline (follow-avoid-tail-recenter))
1778 ;; DEBUG
1779 ;;(if (not (follow-windows-aligned-p
1780 ;; (follow-windows-start-end windows)))
1781 ;; (message "follow-mode: windows still unaligend!"))
1782 ;; END OF DEBUG
1783 ) ; Matches (let*
1784 ;; Buffer not in follow mode:
1785 ;; We still must update the windows displaying the tail so that
1786 ;; Emacs won't recenter them.
1787 (follow-avoid-tail-recenter))
1788 (set-buffer orig-buffer)))
1789 (setq follow-inside-post-command-hook nil))
1790
1791 ;;}}}
1792 ;;{{{ The region
1793
1794 ;; Tries to make the highlighted area representing the region look
1795 ;; good when spanning several windows.
1796 ;;
1797 ;; Not perfect, as the point can't be placed at window end, only at
1798 ;; end-1. Whis will highlight a little bit in windows above
1799 ;; the current.
1800
1801 (defun follow-maximize-region (win windows win-start-end)
1802 "Make a highlighted region stretching multiple windows look good
1803 when in Follow mode."
1804 (let* ((all (follow-split-followers windows win))
1805 (pred (car all))
1806 (succ (cdr all))
1807 data)
1808 (while pred
1809 (setq data (assq (car pred) win-start-end))
1810 (set-window-point (car pred) (max (nth 1 data) (- (nth 2 data) 1)))
1811 (setq pred (cdr pred)))
1812 (while succ
1813 (set-window-point (car succ) (nth 1 (assq (car succ) win-start-end)))
1814 (setq succ (cdr succ)))))
1815
1816 ;;}}}
1817 ;;{{{ Scroll bar
1818
1819 ;;;; Scroll-bar support code.
1820
1821 ;;; Why is it needed? Well, if the selected window is in follow mode,
1822 ;;; all its follower stick to it blindly. If one of them is scrolled,
1823 ;;; it immediately returns to the original position when the mouse is
1824 ;;; released. If the selected window is not a follower of the dragged
1825 ;;; window the windows will be unaligned.
1826
1827 ;;; The advices doesn't get compiled. Aestetically, this might be a
1828 ;;; problem but in practical life it isn't.
1829
1830 ;;; Discussion: Now when the other windows in the chain follow the
1831 ;;; dragged, should we really select it?
1832
1833 (cond ((fboundp 'scroll-bar-drag)
1834 ;;;
1835 ;;; Emacs 19 style scrollbars.
1836 ;;;
1837
1838 ;; Select the dragged window if it is a follower of the
1839 ;; selected window.
1840 ;;
1841 ;; Generate advices of the form:
1842 ;; (defadvice scroll-bar-drag (after follow-scroll-bar-drag activate)
1843 ;; "Adviced by `follow-mode'."
1844 ;; (follow-redraw-after-event (ad-get-arg 0)))
1845 (let ((cmds '(scroll-bar-drag
1846 scroll-bar-drag-1 ; Executed at every move.
1847 scroll-bar-scroll-down
1848 scroll-bar-scroll-up
1849 scroll-bar-set-window-start)))
1850 (while cmds
1851 (eval
1852 (` (defadvice (, (intern (symbol-name (car cmds))))
1853 (after
1854 (, (intern (concat "follow-" (symbol-name (car cmds)))))
1855 activate)
1856 "Adviced by Follow Mode."
1857 (follow-redraw-after-event (ad-get-arg 0)))))
1858 (setq cmds (cdr cmds))))
1859
1860
1861 (defun follow-redraw-after-event (event)
1862 "Adviced by Follow mode."
1863 (condition-case nil
1864 (let* ((orig-win (selected-window))
1865 (win (nth 0 (funcall
1866 (symbol-function 'event-start) event)))
1867 (fmode (assq 'follow-mode
1868 (buffer-local-variables
1869 (window-buffer win)))))
1870 (if (and fmode (cdr fmode))
1871 ;; The selected window is in follow-mode
1872 (progn
1873 ;; Recenter around the dragged window.
1874 (select-window win)
1875 (follow-redisplay)
1876 (select-window orig-win))))
1877 (error nil))))
1878
1879
1880 ((fboundp 'scrollbar-vertical-drag)
1881 ;;;
1882 ;;; XEmacs style scrollbars.
1883 ;;;
1884
1885 ;; Advice all scrollbar functions on the form:
1886 ;;
1887 ;; (defadvice scrollbar-line-down
1888 ;; (after follow-scrollbar-line-down activate)
1889 ;; (follow-xemacs-scrollbar-support (ad-get-arg 0)))
1890
1891 (let ((cmds '(scrollbar-line-down ; Window
1892 scrollbar-line-up
1893 scrollbar-page-down ; Object
1894 scrollbar-page-up
1895 scrollbar-to-bottom ; Window
1896 scrollbar-to-top
1897 scrollbar-vertical-drag ; Object
1898 )))
1899
1900 (while cmds
1901 (eval
1902 (` (defadvice (, (intern (symbol-name (car cmds))))
1903 (after
1904 (, (intern (concat "follow-" (symbol-name (car cmds)))))
1905 activate)
1906 "Adviced by `follow-mode'."
1907 (follow-xemacs-scrollbar-support (ad-get-arg 0)))))
1908 (setq cmds (cdr cmds))))
1909
1910
1911 (defun follow-xemacs-scrollbar-support (window)
1912 "Redraw windows showing the same buffer as shown in WINDOW.
1913 WINDOW is either the dragged window, or a cons containing the
1914 window as its first element. This is called while the user drags
1915 the scrollbar.
1916
1917 WINDOW can be an object or a window."
1918 (condition-case nil
1919 (progn
1920 (if (consp window)
1921 (setq window (car window)))
1922 (let ((fmode (assq 'follow-mode
1923 (buffer-local-variables
1924 (window-buffer window))))
1925 (orig-win (selected-window)))
1926 (if (and fmode (cdr fmode))
1927 (progn
1928 ;; Recenter around the dragged window.
1929 (select-window window)
1930 (follow-redisplay)
1931 (select-window orig-win)))))
1932 (error nil)))))
1933
1934 ;;}}}
1935 ;;{{{ Process output
1936
1937 ;;; The following sections installs a spy which listens to process
1938 ;;; output and tries to reposition the windows whose buffers are in
1939 ;;; Follow mode. We play safe as much as possible...
1940 ;;;
1941 ;;; When follow-mode is activated all active processes are
1942 ;;; intercepted. All new processes which change their filter function
1943 ;;; using `set-process-filter' are also intercepted. The reason is
1944 ;;; that a process can cause a redisplay recentering "tail" windows.
1945 ;;; Note that it doesn't hurt to spy on more processes than needed.
1946 ;;;
1947 ;;; Technically, we set the process filter to `follow-generic-filter'.
1948 ;;; The original filter is stored in `follow-process-filter-alist'.
1949 ;;; Our generic filter calls the original filter, or inserts the
1950 ;;; output into the buffer, if the buffer originally didn't have an
1951 ;;; output filter. It also makes sure that the windows connected to
1952 ;;; the buffer are aligned.
1953 ;;;
1954 ;;; Discussion: How to we find processes which doesn't call
1955 ;;; `set-process-filter'? (How often are processes created in a
1956 ;;; buffer after Follow mode are activated?)
1957 ;;;
1958 ;;; Discussion: Should we also advice `process-filter' to make our
1959 ;;; filter invisible to others?
1960
1961 ;;{{{ Advice for `set-process-filter'
1962
1963 ;; Do not call this with 'follow-generic-filter as the name of the
1964 ;; filter...
1965
1966 (defadvice set-process-filter (before follow-set-process-filter activate)
1967 "Follow Mode listens to calls to this function to make
1968 sure process output will be displayed correctly in buffers
1969 in which the mode is activated.
1970
1971 Follow Mode inserts it's own process filter to do it's
1972 magic stuff before the real process filter is called."
1973 (if follow-intercept-processes
1974 (progn
1975 (setq follow-process-filter-alist
1976 (delq (assq (ad-get-arg 0) follow-process-filter-alist)
1977 follow-process-filter-alist))
1978 (follow-tidy-process-filter-alist)
1979 (cond ((eq (ad-get-arg 1) t))
1980 ((eq (ad-get-arg 1) nil)
1981 (ad-set-arg 1 'follow-generic-filter))
1982 (t
1983 (setq follow-process-filter-alist
1984 (cons (cons (ad-get-arg 0) (ad-get-arg 1))
1985 follow-process-filter-alist))
1986 (ad-set-arg 1 'follow-generic-filter))))))
1987
1988
1989 (defun follow-call-set-process-filter (proc filter)
1990 "Call original `set-process-filter' without the Follow mode advice."
1991 (ad-disable-advice 'set-process-filter 'before
1992 'follow-set-process-filter)
1993 (ad-activate 'set-process-filter)
1994 (prog1
1995 (set-process-filter proc filter)
1996 (ad-enable-advice 'set-process-filter 'before
1997 'follow-set-process-filter)
1998 (ad-activate 'set-process-filter)))
1999
2000
2001 (defadvice process-filter (after follow-process-filter activate)
2002 "Normally when Follow mode is activated all processes has the
2003 process filter set to `follow-generic-filter'. With this advice,
2004 the original process filter is returned."
2005 (cond ((eq ad-return-value 'follow-generic-filter)
2006 (setq ad-return-value
2007 (cdr-safe (assq (ad-get-arg 0)
2008 follow-process-filter-alist))))))
2009
2010
2011 (defun follow-call-process-filter (proc)
2012 "Call original `process-filter' without the Follow mode advice."
2013 (ad-disable-advice 'process-filter 'after
2014 'follow-process-filter)
2015 (ad-activate 'process-filter)
2016 (prog1
2017 (process-filter proc)
2018 (ad-enable-advice 'process-filter 'after
2019 'follow-process-filter)
2020 (ad-activate 'process-filter)))
2021
2022
2023 (defun follow-tidy-process-filter-alist ()
2024 "Remove old processes from `follow-process-filter-alist'."
2025 (let ((alist follow-process-filter-alist)
2026 (ps (process-list))
2027 (new ()))
2028 (while alist
2029 (if (and (not (memq (process-status (car (car alist)))
2030 '(exit signal closed nil)))
2031 (memq (car (car alist)) ps))
2032 (setq new (cons (car alist) new)))
2033 (setq alist (cdr alist)))
2034 (setq follow-process-filter-alist new)))
2035
2036 ;;}}}
2037 ;;{{{ Start/stop interception of processes.
2038
2039 ;; Normally, all new processed are intercepted by our `set-process-filter'.
2040 ;; This is needed to intercept old processed which were started before we were
2041 ;; loaded, and processes we have forgotten by calling
2042 ;; `follow-stop-intercept-process-output'.
2043
2044 (defun follow-intercept-process-output ()
2045 "Intercept all active processes.
2046
2047 This is needed so that Follow Mode can track all display events in the
2048 system. (See `follow-mode')"
2049 (interactive)
2050 (let ((list (process-list)))
2051 (while list
2052 (if (eq (process-filter (car list)) 'follow-generic-filter)
2053 nil
2054 ;; The custom `set-process-filter' defined above.
2055 (set-process-filter (car list) (process-filter (car list))))
2056 (setq list (cdr list))))
2057 (setq follow-intercept-processes t))
2058
2059
2060 (defun follow-stop-intercept-process-output ()
2061 "Stop Follow Mode from spying on processes.
2062
2063 All current spypoints are removed and no new will be added.
2064
2065 The effect is that Follow mode won't be able to handle buffers
2066 connected to processes.
2067
2068 The only reason to call this function is if the Follow mode spy filter
2069 would interfere with some other package. If this happens, please
2070 report this using the `follow-submit-feedback' function."
2071 (interactive)
2072 (follow-tidy-process-filter-alist)
2073 (let ((list (process-list)))
2074 (while list
2075 (if (eq (process-filter (car list)) 'follow-generic-filter)
2076 (progn
2077 (follow-call-set-process-filter
2078 (car list)
2079 (cdr-safe (assq (car list) follow-process-filter-alist)))
2080 (setq follow-process-filter-alist
2081 (delq (assq (car list) follow-process-filter-alist)
2082 follow-process-filter-alist))))
2083 (setq list (cdr list))))
2084 (setq follow-intercept-processes nil))
2085
2086 ;;}}}
2087 ;;{{{ The filter
2088
2089 ;;; The following section is a naive method to make buffers with
2090 ;;; process output to work with Follow mode. Whenever the start of the
2091 ;;; window displaying the buffer is moved, we moves it back to it's
2092 ;;; original position and try to select a new window. (If we fail,
2093 ;;; the normal redisplay functions of Emacs will scroll it right
2094 ;;; back!)
2095
2096 (defun follow-generic-filter (proc output)
2097 "Process output filter for process connected to buffers in Follow mode."
2098 (let* ((old-buffer (current-buffer))
2099 (orig-win (selected-window))
2100 (buf (process-buffer proc))
2101 (win (and buf (if (eq buf (window-buffer orig-win))
2102 orig-win
2103 (get-buffer-window buf t))))
2104 (return-to-orig-win (and win (not (eq win orig-win))))
2105 (orig-window-start (and win (window-start win))))
2106
2107 ;; If input is pending, the `sit-for' below won't redraw the
2108 ;; display. In that case, calling `follow-avoid-tail-recenter' may
2109 ;; provoke the process hadnling code to sceduling a redisplay.
2110 ;(or (input-pending-p)
2111 ; (follow-avoid-tail-recenter))
2112
2113 ;; Output the `output'.
2114 (let ((filter (cdr-safe (assq proc follow-process-filter-alist))))
2115 (cond
2116 ;; Call the original filter function
2117 (filter
2118 (funcall filter proc output))
2119
2120 ;; No filter, but we've got a buffer. Just output into it.
2121 (buf
2122 (set-buffer buf)
2123 (if (not (marker-buffer (process-mark proc)))
2124 (set-marker (process-mark proc) (point-max)))
2125 (let ((moving (= (point) (process-mark proc)))
2126 (odeactivate (and (boundp 'deactivate-mark)
2127 (symbol-value 'deactivate-mark)))
2128 (old-buffer-read-only buffer-read-only))
2129 (setq buffer-read-only nil)
2130 (save-excursion
2131 (goto-char (process-mark proc))
2132 ;; `insert-before-markers' just in case the users next
2133 ;; command is M-y.
2134 (insert-before-markers output)
2135 (set-marker (process-mark proc) (point)))
2136 (if moving (goto-char (process-mark proc)))
2137 (if (boundp 'deactivate-mark)
2138 ;; This could really be
2139 ;; (setq deactivate-mark odeactivate)
2140 ;; but this raises an error when compiling on XEmacs.
2141 (funcall (symbol-function 'set)
2142 'deactivate-mark odeactivate))
2143 (setq buffer-read-only old-buffer-read-only)))))
2144
2145 ;; If we're in follow mode, do our stuff. Select a new window and
2146 ;; redisplay. (Actually, it is redundant to check `buf', but I
2147 ;; feel it's more correct.)
2148 (if (and buf win (window-live-p win))
2149 (progn
2150 (set-buffer buf)
2151 (if (and (boundp 'follow-mode) follow-mode)
2152 (progn
2153 (select-window win)
2154 (let* ((windows (follow-all-followers win))
2155 (win-start-end (follow-windows-start-end windows))
2156 (new-window-start (window-start win))
2157 (new-window-point (window-point win)))
2158 (cond
2159 ;; The window was moved. Move it back and
2160 ;; select a new. If no better could be found,
2161 ;; we stick the the new start position. This
2162 ;; is used when the original process filter
2163 ;; tries to position the cursor at the bottom
2164 ;; of the window. Example: `lyskom'.
2165 ((not (eq orig-window-start new-window-start))
2166 (follow-debug-message "filter: Moved")
2167 (set-window-start win orig-window-start)
2168 (follow-redisplay windows win)
2169 (setq win-start-end (follow-windows-start-end windows))
2170 (follow-select-if-visible new-window-point
2171 win-start-end)
2172 (goto-char new-window-point)
2173 (if (eq win (selected-window))
2174 (set-window-start win new-window-start))
2175 (setq win-start-end (follow-windows-start-end windows)))
2176 ;; Stick to this window, if point is visible in it.
2177 ((pos-visible-in-window-p new-window-point)
2178 (follow-debug-message "filter: Visible in window"))
2179 ;; Avoid redisplaying the first window. If the
2180 ;; point is visible at a window below,
2181 ;; redisplay and select it.
2182 ((follow-select-if-visible-from-first
2183 new-window-point windows)
2184 (follow-debug-message "filter: Seen from first")
2185 (follow-redisplay windows (car windows))
2186 (goto-char new-window-point)
2187 (setq win-start-end
2188 (follow-windows-start-end windows)))
2189 ;; None of the above. We stick to the current window.
2190 (t
2191 (follow-debug-message "filter: nothing")))
2192
2193 ;; Here we have slected a window. Make sure the
2194 ;; windows are aligned and the point is visible
2195 ;; in the selected window.
2196 (if (and (not (follow-pos-visible
2197 (point) (selected-window) win-start-end))
2198 (not return-to-orig-win))
2199 (progn
2200 (sit-for 0)
2201 (setq win-start-end
2202 (follow-windows-start-end windows))))
2203
2204 (if (or follow-internal-force-redisplay
2205 (not (follow-windows-aligned-p win-start-end)))
2206 (follow-redisplay windows)))))))
2207
2208 ;; return to the original window.
2209 (if return-to-orig-win
2210 (select-window orig-win))
2211 (set-buffer old-buffer))
2212
2213 (follow-invalidate-cache)
2214
2215 ;; Normally, if the display has been changed, it is redrawn. All
2216 ;; windows showing only the end of a buffer is unconditionally
2217 ;; recentered, we can't prevent it by calling
2218 ;; `follow-avoid-tail-recenter'.
2219 ;;
2220 ;; By performing a redisplay on our own, Emacs need not perform
2221 ;; the above described redisplay. (However, bu performing it when
2222 ;; there are input available just seems to make things worse.)
2223 (if (and follow-avoid-tail-recenter-p
2224 (not (input-pending-p)))
2225 (sit-for 0)))
2226
2227 ;;}}}
2228
2229 ;;}}}
2230 ;;{{{ Window size change
2231
2232 ;; In Emacs 19.29, the functions in `window-size-change-functions' are
2233 ;; called every time a window in a frame changes size. Most notably, it
2234 ;; is called after the frame has been resized.
2235 ;;
2236 ;; We basically call our post-command-hook for every buffer which is
2237 ;; visible in any window in the resized frame, which is in follow-mode.
2238 ;;
2239 ;; Since this function can be called indirectly from
2240 ;; `follow-post-command-hook' we have a potential infinite loop. We
2241 ;; handle this problem by simply not doing anything at all in this
2242 ;; situation. The variable `follow-inside-post-command-hook' contains
2243 ;; information about whether the execution actually is inside the
2244 ;; post-command-hook or not.
2245
2246 (if (boundp 'window-size-change-functions)
2247 (add-hook 'window-size-change-functions 'follow-window-size-change))
2248
2249
2250 (defun follow-window-size-change (frame)
2251 "Redraw all windows in FRAME, when in Follow mode."
2252 ;; Below, we call `post-command-hook'. This makes sure that we
2253 ;; doesn't start a mutually recursive endless loop.
2254 (if follow-inside-post-command-hook
2255 nil
2256 (let ((buffers '())
2257 (orig-window (selected-window))
2258 (orig-buffer (current-buffer))
2259 (orig-frame (selected-frame))
2260 windows
2261 buf)
2262 (select-frame frame)
2263 (unwind-protect
2264 (walk-windows
2265 (function
2266 (lambda (win)
2267 (setq buf (window-buffer win))
2268 (if (memq buf buffers)
2269 nil
2270 (set-buffer buf)
2271 (if (and (boundp 'follow-mode)
2272 follow-mode)
2273 (progn
2274 (setq windows (follow-all-followers win))
2275 (if (memq orig-window windows)
2276 (progn
2277 ;; Make sure we're redrawing around the
2278 ;; selected window.
2279 ;;
2280 ;; We must be really careful not to do this
2281 ;; when we are (indirectly) called by
2282 ;; `post-command-hook'.
2283 (select-window orig-window)
2284 (follow-post-command-hook)
2285 (setq orig-window (selected-window)))
2286 (follow-redisplay windows win))
2287 (setq buffers (cons buf buffers))))))))
2288 (select-frame orig-frame)
2289 (set-buffer orig-buffer)
2290 (select-window orig-window)))))
2291
2292 ;;}}}
2293
2294 ;;{{{ XEmacs isearch
2295
2296 ;; In XEmacs, isearch often finds matches in other windows than the
2297 ;; currently selected. However, when exiting the old window
2298 ;; configuration is restored, with the exception of the beginning of
2299 ;; the start of the window for the selected window. This is not much
2300 ;; help for us.
2301 ;;
2302 ;; We overwrite the stored window configuration with the current,
2303 ;; unless we are in `slow-search-mode', i.e. only a few lines
2304 ;; of text is visible.
2305
2306 (if follow-emacs-version-xemacs-p
2307 (defadvice isearch-done (before follow-isearch-done activate)
2308 (if (and (boundp 'follow-mode)
2309 follow-mode
2310 (boundp 'isearch-window-configuration)
2311 isearch-window-configuration
2312 (boundp 'isearch-slow-terminal-mode)
2313 (not isearch-slow-terminal-mode))
2314 (let ((buf (current-buffer)))
2315 (setq isearch-window-configuration
2316 (current-window-configuration))
2317 (set-buffer buf)))))
2318
2319 ;;}}}
2320 ;;{{{ Tail window handling
2321
2322 ;;; In Emacs (not XEmacs) windows showing nothing are sometimes
2323 ;;; recentered. When in Follow Mode, this is not desireable for
2324 ;;; non-first windows in the window chain. This section tries to
2325 ;;; make the windows stay where they should be.
2326 ;;;
2327 ;;; If the display is updated, all windows starting at (point-max) are
2328 ;;; going to be recentered at the next redisplay, unless we do a
2329 ;;; read-and-write cycle to update the `force' flag inside the windows.
2330 ;;;
2331 ;;; In 19.30, a new varible `window-scroll-functions' is called every
2332 ;;; time a window is recentered. It is not perfect for our situation,
2333 ;;; since when it is called for a tail window, it is to late. However,
2334 ;;; if it is called for another window, we can try to update our
2335 ;;; windows.
2336 ;;;
2337 ;;; By patching `sit-for' we can make sure that to catch all explicit
2338 ;;; updates initiated by lisp programs. Internal calls, on the other
2339 ;;; hand, are not handled.
2340 ;;;
2341 ;;; Please note that the function `follow-avoid-tail-recenter' is also
2342 ;;; called from other places, e.g. `post-command-hook' and
2343 ;;; `post-command-idle-hook'.
2344
2345 ;; If this function is called it is to late for this window, but
2346 ;; we might save other windows from beeing recentered.
2347
2348 (if (and follow-avoid-tail-recenter-p (boundp 'window-scroll-functions))
2349 (add-hook 'window-scroll-functions 'follow-avoid-tail-recenter t))
2350
2351
2352 ;; This prevents all packages which calls `sit-for' directly
2353 ;; to recenter tail windows.
2354
2355 (if follow-avoid-tail-recenter-p
2356 (defadvice sit-for (before follow-sit-for activate)
2357 "Adviced by Follow Mode.
2358
2359 Avoid to recenter windows displaying only the end of a file as when
2360 displaying a short file in two windows, using Follow Mode."
2361 (follow-avoid-tail-recenter)))
2362
2363
2364 ;; Without this advice, `mouse-drag-region' would start to recenter
2365 ;; tail windows.
2366
2367 (if (and follow-avoid-tail-recenter-p
2368 (fboundp 'move-overlay))
2369 (defadvice move-overlay (before follow-move-overlay activate)
2370 "Adviced by Follow Mode. Don't recenter windows showing only
2371 the end of a buffer. This prevents `mouse-drag-region' from
2372 messing things up."
2373 (follow-avoid-tail-recenter)))
2374
2375 ;;}}}
2376 ;;{{{ profile support
2377
2378 ;; The following (non-evaluated) section can be used to
2379 ;; profile this package using `elp'.
2380 ;;
2381 ;; Invalid indentation on purpose!
2382
2383 (cond (nil
2384 (setq elp-function-list
2385 '(window-end
2386 vertical-motion
2387 ; sit-for ;; elp can't handle advices...
2388 follow-mode
2389 follow-all-followers
2390 follow-split-followers
2391 follow-redisplay
2392 follow-downward
2393 follow-calculate-first-window-start
2394 follow-estimate-first-window-start
2395 follow-calculate-first-window-start-from-above
2396 follow-calculate-first-window-start-from-below
2397 follow-calc-win-end
2398 follow-calc-win-start
2399 follow-pos-visible
2400 follow-windows-start-end
2401 follow-cache-valid-p
2402 follow-select-if-visible
2403 follow-select-if-visible-from-first
2404 follow-windows-aligned-p
2405 follow-point-visible-all-windows-p
2406 follow-avoid-tail-recenter
2407 follow-update-window-start
2408 follow-post-command-hook
2409 ))))
2410
2411 ;;}}}
2412
2413 ;;{{{ The end
2414
2415 ;;;
2416 ;;; We're done!
2417 ;;;
2418
2419 (provide 'follow)
2420
2421 ;;}}}
2422
2423 ;; /------------------------------------------------------------------------\
2424 ;; | "I [..] am rarely happier then when spending an entire day programming |
2425 ;; | my computer to perform automatically a task that it would otherwise |
2426 ;; | take me a good ten seconds to do by hand. Ten seconds, I tell myself, |
2427 ;; | is ten seconds. Time is valuable and ten seconds' worth of it is well |
2428 ;; | worth the investment of a day's happy activity working out a way to |
2429 ;; | save it". -- Douglas Adams, "Last Chance to See" |
2430 ;; \------------------------------------------------------------------------/
2431
2432 ;;; follow.el ends here