comparison lisp/follow.el @ 14578:55d804f97ffc

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