(eval-when-compile
(if (or (featurep 'bytecomp)
(featurep 'byte-compile))
(cond ((featurep 'xemacs)
(if (eq (get 'force-mode-line-update 'byte-compile)
'byte-compile-obsolete)
(put 'force-mode-line-update 'byte-compile 'nil))
(if (eq (get 'frame-first-window 'byte-compile)
'byte-compile-obsolete)
(put 'frame-first-window 'byte-compile 'nil))))))
(defgroup follow nil
"Synchronize windows showing the same buffer."
:prefix "follow-"
:group 'windows
:group 'convenience)
(defcustom follow-mode-hook nil
"Hooks to run when follow-mode is turned on."
:type 'hook
:group 'follow)
(defcustom follow-mode-off-hook nil
"Hooks to run when follow-mode is turned off."
:type 'hook
:group 'follow)
(defcustom follow-mode-prefix "\C-c."
"Prefix key to use for follow commands in Follow mode.
The value of this variable is checked as part of loading Follow mode.
After that, changing the prefix key requires manipulating keymaps."
:type 'string
:group 'follow)
(defvar follow-mode-map
(let ((mainmap (make-sparse-keymap))
(map (make-sparse-keymap)))
(define-key map "\C-v" 'follow-scroll-up)
(define-key map "\M-v" 'follow-scroll-down)
(define-key map "v" 'follow-scroll-down)
(define-key map "1" 'follow-delete-other-windows-and-split)
(define-key map "b" 'follow-switch-to-buffer)
(define-key map "\C-b" 'follow-switch-to-buffer-all)
(define-key map "\C-l" 'follow-recenter)
(define-key map "<" 'follow-first-window)
(define-key map ">" 'follow-last-window)
(define-key map "n" 'follow-next-window)
(define-key map "p" 'follow-previous-window)
(define-key mainmap follow-mode-prefix map)
(define-key mainmap [remap end-of-buffer] 'follow-end-of-buffer)
(if (not (featurep 'xemacs))
(let ((menumap (funcall (symbol-function 'make-sparse-keymap)
"Follow"))
(count 0)
id)
(mapcar
(function
(lambda (item)
(setq id
(or (cdr item)
(progn
(setq count (+ count 1))
(intern (format "separator-%d" count)))))
(define-key menumap (vector id) item)
(or (eq id 'follow-mode)
(put id 'menu-enable 'follow-mode))))
'(("Toggle Follow mode" . follow-mode)
("--")
("Recenter" . follow-recenter)
("--")
("Previous Window" . follow-previous-window)
("Next Windows" . follow-next-window)
("Last Window" . follow-last-window)
("First Window" . follow-first-window)
("--")
("Switch To Buffer (all windows)"
. follow-switch-to-buffer-all)
("Switch To Buffer" . follow-switch-to-buffer)
("--")
("Delete Other Windows and Split"
. follow-delete-other-windows-and-split)
("--")
("Scroll Down" . follow-scroll-down)
("Scroll Up" . follow-scroll-up)))
(let ((tools-map (lookup-key (current-global-map) [menu-bar tools]))
(last nil))
(if (sequencep tools-map)
(progn
(mapcar (function
(lambda (x)
(setq last (or (cdr-safe
(cdr-safe
(cdr-safe x)))
last))))
tools-map)
(if last
(progn
(funcall (symbol-function 'define-key-after)
tools-map [separator-follow] '("--") last)
(funcall (symbol-function 'define-key-after)
tools-map [follow] (cons "Follow" menumap)
'separator-follow))
(define-key (current-global-map) [menu-bar tools follow]
(cons "Follow" menumap))))
(define-key mainmap [menu-bar follow]
(cons "Follow" menumap)))))
(let ((menu '("Follow"
:filter follow-menu-filter
["Scroll Up" follow-scroll-up t]
["Scroll Down" follow-scroll-down t]
["Delete Other Windows and Split"
follow-delete-other-windows-and-split t]
["Switch To Buffer" follow-switch-to-buffer t]
["Switch To Buffer (all windows)"
follow-switch-to-buffer-all t]
["First Window" follow-first-window t]
["Last Window" follow-last-window t]
["Next Windows" follow-next-window t]
["Previous Window" follow-previous-window t]
["Recenter" follow-recenter t]
["Deactivate" follow-mode t])))
(funcall (symbol-function 'set-buffer-menubar)
(symbol-value 'current-menubar))
(funcall (symbol-function 'add-submenu) '("Tools") menu))
(defun follow-menu-filter (menu)
(if follow-mode
menu
'(["Activate " follow-mode t]))))
mainmap)
"Minor mode keymap for Follow mode.")
(defcustom follow-mode-line-text " Follow"
"Text shown in the mode line when Follow mode is active.
Defaults to \" Follow\". Examples of other values
are \" Fw\", or simply \"\"."
:type 'string
:group 'follow)
(defcustom follow-auto nil
"Non-nil activates Follow mode whenever a file is loaded."
:type 'boolean
:group 'follow)
(defcustom follow-intercept-processes (fboundp 'start-process)
"When non-nil, Follow Mode will monitor process output."
:type 'boolean
:group 'follow)
(defvar follow-avoid-tail-recenter-p (not (featurep 'xemacs))
"*When non-nil, patch Emacs so that tail windows won't be recentered.
A \"tail window\" is a window that displays only the end of
the buffer. Normally it is practical for the user that empty
windows are recentered automatically. However, when using
Follow Mode it breaks the display when the end is displayed
in a window \"above\" the last window. This is for
example the case when displaying a short page in info.
Must be set before Follow Mode is loaded.
Please note that it is not possible to fully prevent Emacs from
recentering empty windows. Please report if you find a repeatable
situation in which Emacs recenters empty windows.
XEmacs, as of 19.12, does not recenter windows, good!")
(defvar follow-cache-command-list
'(next-line previous-line forward-char backward-char)
"List of commands that don't require recalculation.
In order to be able to use the cache, a command should not change the
contents of the buffer, nor should it change selected window or current
buffer.
The commands in this list are checked at load time.
To mark other commands as suitable for caching, set the symbol
property `follow-mode-use-cache' to non-nil.")
(defvar follow-debug nil
"*Non-nil when debugging Follow mode.")
(defvar follow-internal-force-redisplay nil
"True when Follow mode should redisplay the windows.")
(defvar follow-process-filter-alist '()
"The original filters for processes intercepted by Follow mode.")
(defvar follow-active-menu nil
"The menu visible when Follow mode is active.")
(defvar follow-deactive-menu nil
"The menu visible when Follow mode is deactivated.")
(defvar follow-inside-post-command-hook nil
"Non-nil when inside Follow modes `post-command-hook'.
Used by `follow-window-size-change'.")
(defvar follow-windows-start-end-cache nil
"Cache used by `follow-window-start-end'.")
(defsubst follow-debug-message (&rest args)
"Like message, but only active when `follow-debug' is non-nil."
(if (and (boundp 'follow-debug) follow-debug)
(apply 'message args)))
(dolist (cmd follow-cache-command-list)
(put cmd 'follow-mode-use-cache t))
(defun turn-on-follow-mode ()
"Turn on Follow mode. Please see the function `follow-mode'."
(interactive)
(follow-mode 1))
(defun turn-off-follow-mode ()
"Turn off Follow mode. Please see the function `follow-mode'."
(interactive)
(follow-mode -1))
(put 'follow-mode 'permanent-local t)
(define-minor-mode follow-mode
"Minor mode that combines windows into one tall virtual window.
The feeling of a \"virtual window\" has been accomplished by the use
of two major techniques:
* The windows always displays adjacent sections of the buffer.
This means that whenever one window is moved, all the
others will follow. (Hence the name Follow Mode.)
* Should the point (cursor) end up outside a window, another
window displaying that point is selected, if possible. This
makes it possible to walk between windows using normal cursor
movement commands.
Follow mode comes to its prime when used on a large screen and two
side-by-side window are used. The user can, with the help of Follow
mode, use two full-height windows as though they would have been
one. Imagine yourself editing a large function, or section of text,
and being able to use 144 lines instead of the normal 72... (your
mileage may vary).
To split one large window into two side-by-side windows, the commands
`\\[split-window-horizontally]' or \
`M-x follow-delete-other-windows-and-split' can be used.
Only windows displayed in the same frame follow each-other.
If the variable `follow-intercept-processes' is non-nil, Follow mode
will listen to the output of processes and redisplay accordingly.
\(This is the default.)
When Follow mode is switched on, the hook `follow-mode-hook'
is called. When turned off, `follow-mode-off-hook' is called.
Keys specific to Follow mode:
\\{follow-mode-map}"
:keymap follow-mode-map
(if (and follow-mode follow-intercept-processes)
(follow-intercept-process-output))
(cond (follow-mode (if (boundp 'scroll-on-clipped-lines)
(setq scroll-on-clipped-lines nil))
(force-mode-line-update)
(add-hook 'post-command-hook 'follow-post-command-hook t)
(run-hooks 'follow-mode-hook))
((not follow-mode) (force-mode-line-update)
(run-hooks 'follow-mode-off-hook))))
(add-hook 'find-file-hook 'follow-find-file-hook t)
(defun follow-find-file-hook ()
"Find-file hook for Follow Mode. See the variable `follow-auto'."
(if follow-auto (follow-mode t)))
(defun follow-scroll-up (&optional arg)
"Scroll text in a Follow Mode window chain up.
If called with no ARG, the `next-screen-context-lines' last lines of
the bottom window in the chain will be visible in the top window.
If called with an argument, scroll ARG lines up.
Negative ARG means scroll downward.
Works like `scroll-up' when not in Follow Mode."
(interactive "P")
(cond ((not (and (boundp 'follow-mode) follow-mode))
(scroll-up arg))
(arg
(save-excursion (scroll-up arg))
(setq follow-internal-force-redisplay t))
(t
(let* ((windows (follow-all-followers))
(end (window-end (car (reverse windows)))))
(if (eq end (point-max))
(signal 'end-of-buffer nil)
(select-window (car windows))
(if end
(goto-char end))
(vertical-motion (- next-screen-context-lines))
(set-window-start (car windows) (point)))))))
(defun follow-scroll-down (&optional arg)
"Scroll text in a Follow Mode window chain down.
If called with no ARG, the `next-screen-context-lines' top lines of
the top window in the chain will be visible in the bottom window.
If called with an argument, scroll ARG lines down.
Negative ARG means scroll upward.
Works like `scroll-up' when not in Follow Mode."
(interactive "P")
(cond ((not (and (boundp 'follow-mode) follow-mode))
(scroll-up arg))
(arg
(save-excursion (scroll-down arg)))
(t
(let* ((windows (follow-all-followers))
(win (car (reverse windows)))
(start (window-start (car windows))))
(if (eq start (point-min))
(signal 'beginning-of-buffer nil)
(select-window win)
(goto-char start)
(vertical-motion (- (- (window-height win)
1
next-screen-context-lines)))
(set-window-start win (point))
(goto-char start)
(vertical-motion (- next-screen-context-lines 1))
(setq follow-internal-force-redisplay t))))))
(defun follow-delete-other-windows-and-split (&optional arg)
"Create two side by side windows and enter Follow Mode.
Execute this command to display as much as possible of the text
in the selected window. All other windows, in the current
frame, are deleted and the selected window is split in two
side-by-side windows. Follow Mode is activated, hence the
two windows always will display two successive pages.
\(If one window is moved, the other one will follow.)
If ARG is positive, the leftmost window is selected. If it negative,
the rightmost is selected. If ARG is nil, the leftmost window is
selected if the original window is the first one in the frame.
To bind this command to a hotkey, place the following line
in your `~/.emacs' file, replacing [f7] by your favourite key:
(global-set-key [f7] 'follow-delete-other-windows-and-split)"
(interactive "P")
(let ((other (or (and (null arg)
(not (eq (selected-window)
(frame-first-window (selected-frame)))))
(and arg
(< (prefix-numeric-value arg) 0))))
(start (window-start)))
(delete-other-windows)
(split-window-horizontally)
(if other
(progn
(other-window 1)
(set-window-start (selected-window) start)
(setq follow-internal-force-redisplay t)))
(follow-mode 1)))
(defun follow-switch-to-buffer (buffer)
"Show BUFFER in all windows in the current Follow Mode window chain."
(interactive "BSwitch to Buffer: ")
(let ((orig-window (selected-window))
(windows (follow-all-followers)))
(while windows
(select-window (car windows))
(switch-to-buffer buffer)
(setq windows (cdr windows)))
(select-window orig-window)))
(defun follow-switch-to-buffer-all (&optional buffer)
"Show BUFFER in all windows on this frame.
Defaults to current buffer."
(interactive (list (read-buffer "Switch to Buffer: "
(current-buffer))))
(or buffer (setq buffer (current-buffer)))
(let ((orig-window (selected-window)))
(walk-windows
(function
(lambda (win)
(select-window win)
(switch-to-buffer buffer))))
(select-window orig-window)
(follow-redisplay)))
(defun follow-switch-to-current-buffer-all ()
"Show current buffer in all windows on this frame, and enter Follow Mode.
To bind this command to a hotkey place the following line
in your `~/.emacs' file:
(global-set-key [f7] 'follow-switch-to-current-buffer-all)"
(interactive)
(or (and (boundp 'follow-mode) follow-mode)
(follow-mode 1))
(follow-switch-to-buffer-all))
(defun follow-next-window ()
"Select the next window showing the same buffer."
(interactive)
(let ((succ (cdr (follow-split-followers (follow-all-followers)))))
(if succ
(select-window (car succ))
(error "%s" "No more windows"))))
(defun follow-previous-window ()
"Select the previous window showing the same buffer."
(interactive)
(let ((pred (car (follow-split-followers (follow-all-followers)))))
(if pred
(select-window (car pred))
(error "%s" "No more windows"))))
(defun follow-first-window ()
"Select the first window in the frame showing the same buffer."
(interactive)
(select-window (car (follow-all-followers))))
(defun follow-last-window ()
"Select the last window in the frame showing the same buffer."
(interactive)
(select-window (car (reverse (follow-all-followers)))))
(defun follow-recenter (&optional arg)
"Recenter the middle window around point.
Rearrange all other windows around the middle window.
With a positive argument, place the current line ARG lines
from the top. With a negative, place it -ARG lines from the
bottom."
(interactive "P")
(if arg
(let ((p (point))
(arg (prefix-numeric-value arg)))
(if (>= arg 0)
(progn
(follow-first-window)
(goto-char p)
(recenter arg))
(follow-last-window)
(goto-char p)
(recenter arg)
(setq follow-internal-force-redisplay t)))
(let* ((dest (point))
(windows (follow-all-followers))
(win (nth (/ (- (length windows) 1) 2) windows)))
(select-window win)
(goto-char dest)
(recenter)
)))
(defun follow-redraw ()
"Arrange windows displaying the same buffer in successor order.
This function can be called even if the buffer is not in Follow mode.
Hopefully, there should be no reason to call this function when in
Follow mode since the windows should always be aligned."
(interactive)
(sit-for 0)
(follow-redisplay))
(defun follow-end-of-buffer (&optional arg)
"Move point to the end of the buffer, Follow Mode style.
If the end is not visible, it will be displayed in the last possible
window in the Follow Mode window chain.
The mark is left at the previous position. With arg N, put point N/10
of the way from the true end."
(interactive "P")
(let ((followers (follow-all-followers))
(pos (point)))
(cond (arg
(select-window (car (reverse followers))))
((follow-select-if-end-visible
(follow-windows-start-end followers)))
(t
(select-window (car (reverse followers)))))
(goto-char pos)
(with-no-warnings
(end-of-buffer arg))))
(defun follow-all-followers (&optional testwin)
"Return all windows displaying the same buffer as the TESTWIN.
The list contains only windows displayed in the same frame as TESTWIN.
If TESTWIN is nil the selected window is used."
(or (and testwin (window-live-p testwin))
(setq testwin (selected-window)))
(let* ((top (frame-first-window (window-frame testwin)))
(win top)
(done nil)
(windows '())
(buffer (window-buffer testwin)))
(while (and (not done) win)
(if (eq (window-buffer win) buffer)
(setq windows (cons win windows)))
(setq win (next-window win 'not))
(if (eq win top)
(setq done t)))
(nreverse windows)))
(defun follow-split-followers (windows &optional win)
"Split the WINDOWS into the sets: predecessors and successors.
Return `(PRED . SUCC)' where `PRED' and `SUCC' are ordered starting
from the selected window."
(or win
(setq win (selected-window)))
(let ((pred '()))
(while (not (eq (car windows) win))
(setq pred (cons (car windows) pred))
(setq windows (cdr windows)))
(cons pred (cdr windows))))
(defun follow-calc-win-end (&optional win)
"Calculate the presumed window end for WIN.
Actually, the position returned is the start of the next
window, normally is the end plus one.
If WIN is nil, the selected window is used.
Returns (end-pos end-of-buffer-p)"
(if (featurep 'xemacs)
(let ((end (window-end win t)))
(if (= end (funcall (symbol-function 'point-max)
(window-buffer win)))
(list end t)
(list (+ end 1) nil)))
(let ((orig-win (and win (selected-window)))
height
buffer-end-p)
(if win (select-window win))
(prog1
(save-excursion
(goto-char (window-start))
(setq height (- (window-height) 1))
(setq buffer-end-p
(if (bolp)
(not (= height (vertical-motion height)))
(save-restriction
(narrow-to-region (point) (point-max))
(not (= height (vertical-motion height))))))
(list (point) buffer-end-p))
(if orig-win
(select-window orig-win))))))
(defun follow-calc-win-start (windows pos win)
"Calculate where WIN will start if the first in WINDOWS start at POS.
If WIN is nil the point below all windows is returned."
(let (start)
(while (and windows (not (eq (car windows) win)))
(setq start (window-start (car windows)))
(set-window-start (car windows) pos 'noforce)
(setq pos (car (inline (follow-calc-win-end (car windows)))))
(set-window-start (car windows) start 'noforce)
(setq windows (cdr windows)))
pos))
(defsubst follow-cache-valid-p (windows)
"Test if the cached value of `follow-windows-start-end' can be used.
Note that this handles the case when the cache has been set to nil."
(let ((res t)
(cache follow-windows-start-end-cache))
(while (and res windows cache)
(setq res (and (eq (car windows)
(car (car cache)))
(eq (window-start (car windows))
(car (cdr (car cache))))))
(setq windows (cdr windows))
(setq cache (cdr cache)))
(and res (null windows) (null cache))))
(defsubst follow-invalidate-cache ()
"Force `follow-windows-start-end' to recalculate the end of the window."
(setq follow-windows-start-end-cache nil))
(defun follow-windows-start-end (windows)
"Builds a list of (WIN START END BUFFER-END-P) for every window in WINDOWS."
(if (follow-cache-valid-p windows)
follow-windows-start-end-cache
(let ((win-start-end '())
(orig-win (selected-window)))
(while windows
(select-window (car windows))
(setq win-start-end
(cons (cons (car windows)
(cons (window-start)
(follow-calc-win-end)))
win-start-end))
(setq windows (cdr windows)))
(select-window orig-win)
(setq follow-windows-start-end-cache (nreverse win-start-end))
follow-windows-start-end-cache)))
(defsubst follow-pos-visible (pos win win-start-end)
"Non-nil when POS is visible in WIN."
(let ((wstart-wend-bend (cdr (assq win win-start-end))))
(and (>= pos (car wstart-wend-bend))
(or (< pos (car (cdr wstart-wend-bend)))
(nth 2 wstart-wend-bend)))))
(defsubst follow-windows-aligned-p (win-start-end)
"Non-nil if the follower WINDOWS are aligned."
(let ((res t))
(save-excursion
(goto-char (window-start (car (car win-start-end))))
(if (bolp)
nil
(vertical-motion 0 (car (car win-start-end)))
(setq res (eq (point) (window-start (car (car win-start-end)))))))
(while (and res (cdr win-start-end))
(setq res (eq (car (cdr (cdr (car win-start-end))))
(car (cdr (car (cdr win-start-end))))))
(setq win-start-end (cdr win-start-end)))
res))
(defun follow-point-visible-all-windows-p (win-start-end)
"Non-nil when the window-point is visible in all windows."
(let ((res t))
(while (and res win-start-end)
(setq res (follow-pos-visible (window-point (car (car win-start-end)))
(car (car win-start-end))
win-start-end))
(setq win-start-end (cdr win-start-end)))
res))
(defun follow-update-window-start (win)
"Make sure that the start of WIN starts at a full screen line."
(save-excursion
(goto-char (window-start win))
(if (bolp)
nil
(vertical-motion 0 win)
(if (eq (point) (window-start win))
nil
(vertical-motion 1 win)
(set-window-start win (point) 'noforce)))))
(defun follow-select-if-visible (dest win-start-end)
"Select and return a window, if DEST is visible in it.
Return the selected window."
(let ((win nil))
(while (and (not win) win-start-end)
(if (follow-pos-visible dest (car (car win-start-end)) win-start-end)
(progn
(setq win (car (car win-start-end)))
(select-window win)))
(setq win-start-end (cdr win-start-end)))
win))
(defun follow-select-if-end-visible (win-start-end)
"Select and return a window, if end is visible in it."
(let ((win nil))
(while (and (not win) win-start-end)
(if (and (eq (point-max) (nth 2 (car win-start-end)))
(nth 3 (car win-start-end))
(let ((end (window-end (car (car win-start-end)))))
(and end
(eq (point-max) (min (point-max) end)))))
(progn
(setq win (car (car win-start-end)))
(select-window win)))
(setq win-start-end (cdr win-start-end)))
win))
(defun follow-select-if-visible-from-first (dest windows)
"Select and return a window with DEST, if WINDOWS are redrawn from top."
(let ((win nil)
end-pos-end-p)
(save-excursion
(goto-char (window-start (car windows)))
(vertical-motion 0 (car windows))
(if (< dest (point))
nil
(save-window-excursion
(while (and (not win) windows)
(set-window-start (car windows) (point) 'noforce)
(setq end-pos-end-p (follow-calc-win-end (car windows)))
(goto-char (car end-pos-end-p))
(if (or (car (cdr end-pos-end-p))
(< dest (point)))
(setq win (car windows))
(setq windows (cdr windows)))))))
(if win
(select-window win))
win))
(defun follow-redisplay (&optional windows win)
"Reposition the WINDOWS around WIN.
Should the point be too close to the roof we redisplay everything
from the top. WINDOWS should contain a list of windows to
redisplay, it is assumed that WIN is a member of the list.
Should WINDOWS be nil, the windows displaying the
same buffer as WIN, in the current frame, are used.
Should WIN be nil, the selected window is used."
(or win
(setq win (selected-window)))
(or windows
(setq windows (follow-all-followers win)))
(follow-downward windows (follow-calculate-first-window-start windows win)))
(defun follow-downward (windows pos)
"Redisplay all WINDOWS starting at POS."
(while windows
(set-window-start (car windows) pos)
(setq pos (car (follow-calc-win-end (car windows))))
(setq windows (cdr windows))))
(defun follow-calculate-first-window-start (windows &optional win start)
"Calculate the start of the first window.
WINDOWS is a chain of windows to work with. WIN is the window
to recenter around. It is assumed that WIN starts at position
START."
(or win
(setq win (selected-window)))
(or start
(setq start (window-start win)))
(let ((guess (follow-estimate-first-window-start windows win start)))
(if (car guess)
(cdr guess)
(let ((win-start (follow-calc-win-start windows (cdr guess) win)))
(cond ((= win-start start)
(follow-debug-message "exact")
(cdr guess))
((< win-start start)
(follow-debug-message "above")
(follow-calculate-first-window-start-from-above
windows (cdr guess) win start))
(t
(follow-debug-message "below")
(follow-calculate-first-window-start-from-below
windows (cdr guess) win start)))))))
(defun follow-estimate-first-window-start (windows win start)
"Estimate the position of the first window.
Returns (EXACT . POS). If EXACT is non-nil, POS is the starting
position of the first window. Otherwise it is a good guess."
(let ((pred (car (follow-split-followers windows win)))
(exact nil))
(save-excursion
(goto-char start)
(vertical-motion 0 win)
(while pred
(vertical-motion (- 1 (window-height (car pred))) (car pred))
(if (not (bolp))
(setq exact nil))
(setq pred (cdr pred)))
(cons exact (point)))))
(defun follow-calculate-first-window-start-from-above
(windows guess win start)
(save-excursion
(let ((done nil)
win-start
res)
(goto-char guess)
(while (not done)
(if (not (= (vertical-motion 1 (car windows)) 1))
(progn
(setq done t)
(setq res (point-max)))
(setq win-start (follow-calc-win-start windows (point) win))
(if (>= win-start start)
(progn
(setq done t)
(setq res (point))))))
res)))
(defun follow-calculate-first-window-start-from-below
(windows guess &optional win start)
(setq win (or win (selected-window)))
(setq start (or start (window-start win)))
(save-excursion
(let ((done nil)
win-start
res)
(goto-char guess)
(vertical-motion 0 (car windows))
(setq res (point))
(while (not done)
(if (not (= (vertical-motion -1 (car windows)) -1))
(progn
(setq done t)
(setq res (point-min)))
(setq win-start (follow-calc-win-start windows (point) win))
(cond ((= win-start start) (setq done t)
(setq res (point)))
((< win-start start) (setq done t))
(t (setq res (point))))))
res)))
(defun follow-avoid-tail-recenter (&rest rest)
"Make sure windows displaying the end of a buffer aren't recentered.
This is done by reading and rewriting the start position of
non-first windows in Follow Mode."
(if follow-avoid-tail-recenter-p
(let* ((orig-buffer (current-buffer))
(top (frame-first-window (selected-frame)))
(win top)
(who '()) start
pair) (if (window-minibuffer-p top)
nil
(while (progn
(setq start (window-start win))
(set-buffer (window-buffer win))
(setq pair (cons (window-buffer win) (window-frame win)))
(if (member pair who)
(if (and (boundp 'follow-mode) follow-mode
(eq (point-max) start))
(set-window-start win start))
(setq who (cons pair who)))
(setq win (next-window win 'not t))
(not (eq win top)))) (set-buffer orig-buffer)))))
(defun follow-post-command-hook ()
"Ensure that the windows in Follow mode are adjacent after each command."
(setq follow-inside-post-command-hook t)
(if (or (not (input-pending-p))
(and (boundp 'current-mouse-event)
(symbol-value 'current-mouse-event)
(fboundp 'button-event-p)
(funcall (symbol-function 'button-event-p)
(symbol-value 'current-mouse-event))))
(let ((orig-buffer (current-buffer))
(win (selected-window)))
(set-buffer (window-buffer win))
(or (and (symbolp this-command)
(get this-command 'follow-mode-use-cache))
(follow-invalidate-cache))
(if (and (boundp 'follow-mode) follow-mode
(not (window-minibuffer-p win)))
(let* ((windows (inline (follow-all-followers win)))
(dest (point))
(win-start-end (inline
(follow-update-window-start (car windows))
(follow-windows-start-end windows)))
(aligned (follow-windows-aligned-p win-start-end))
(visible (follow-pos-visible dest win win-start-end)))
(if (not (and aligned visible))
(follow-invalidate-cache))
(inline (follow-avoid-tail-recenter))
(or follow-internal-force-redisplay
(progn
(if (eq dest (point-max))
(cond
((and visible
aligned
(not (memq this-command
'(backward-delete-char
delete-backward-char
backward-delete-char-untabify
kill-region))))
(follow-debug-message "Max: same"))
((follow-select-if-end-visible win-start-end)
(follow-debug-message "Max: end visible")
(setq visible t)
(setq aligned nil)
(goto-char dest))
(t
(follow-debug-message "Max: default")
(select-window (car (reverse windows)))
(goto-char dest)
(setq visible nil)
(setq aligned nil)))
(cond
((and visible aligned)
(follow-debug-message "same"))
((follow-select-if-visible dest win-start-end)
(follow-debug-message "visible")
(setq visible t)
(goto-char dest))
(visible
(follow-debug-message "visible in selected."))
((eq dest (point-min))
(follow-debug-message "min")
(select-window (car windows))
(goto-char dest)
(set-window-start (selected-window) (point-min))
(setq win-start-end (follow-windows-start-end windows))
(follow-invalidate-cache)
(setq visible t)
(setq aligned nil))
((follow-select-if-visible-from-first dest windows)
(follow-debug-message "Below first")
(setq visible t)
(setq aligned t)
(follow-redisplay windows (car windows))
(goto-char dest))
(t
(follow-debug-message "None")
(setq visible nil)
(setq aligned nil))))
(or (eq win (selected-window))
(let ((p (window-point win)))
(set-window-start win (window-start win) nil)
(set-window-point win p)))))
(if (or visible
(follow-pos-visible dest win win-start-end))
nil
(sit-for 0)
(follow-avoid-tail-recenter)
(setq win-start-end (follow-windows-start-end windows))
(follow-invalidate-cache)
(setq aligned nil))
(if (or follow-internal-force-redisplay
(not (or aligned
(follow-windows-aligned-p win-start-end)))
(not (inline (follow-point-visible-all-windows-p
win-start-end))))
(progn
(setq follow-internal-force-redisplay nil)
(follow-redisplay windows (selected-window))
(setq win-start-end (follow-windows-start-end windows))
(follow-invalidate-cache)
(if (follow-pos-visible dest win win-start-end)
nil
(follow-select-if-visible dest win-start-end)
(goto-char dest))))
(if (or (and (boundp 'mark-active) (symbol-value 'mark-active))
(and (fboundp 'region-active-p)
(funcall (symbol-function 'region-active-p))))
(follow-maximize-region
(selected-window) windows win-start-end))
(inline (follow-avoid-tail-recenter))
) (follow-avoid-tail-recenter))
(set-buffer orig-buffer)))
(setq follow-inside-post-command-hook nil))
(defun follow-maximize-region (win windows win-start-end)
"Make a highlighted region stretching multiple windows look good."
(let* ((all (follow-split-followers windows win))
(pred (car all))
(succ (cdr all))
data)
(while pred
(setq data (assq (car pred) win-start-end))
(set-window-point (car pred) (max (nth 1 data) (- (nth 2 data) 1)))
(setq pred (cdr pred)))
(while succ
(set-window-point (car succ) (nth 1 (assq (car succ) win-start-end)))
(setq succ (cdr succ)))))
(cond ((fboundp 'scroll-bar-drag)
(let ((cmds '(scroll-bar-drag
scroll-bar-drag-1 scroll-bar-scroll-down
scroll-bar-scroll-up
scroll-bar-set-window-start)))
(while cmds
(eval
`(defadvice ,(intern (symbol-name (car cmds)))
(after
,(intern (concat "follow-" (symbol-name (car cmds))))
activate)
"Adviced by Follow Mode."
(follow-redraw-after-event (ad-get-arg 0))))
(setq cmds (cdr cmds))))
(defun follow-redraw-after-event (event)
"Adviced by Follow mode."
(condition-case nil
(let* ((orig-win (selected-window))
(win (nth 0 (funcall
(symbol-function 'event-start) event)))
(fmode (assq 'follow-mode
(buffer-local-variables
(window-buffer win)))))
(if (and fmode (cdr fmode))
(progn
(select-window win)
(follow-redisplay)
(select-window orig-win))))
(error nil))))
((fboundp 'scrollbar-vertical-drag)
(let ((cmds '(scrollbar-line-down scrollbar-line-up
scrollbar-page-down scrollbar-page-up
scrollbar-to-bottom scrollbar-to-top
scrollbar-vertical-drag )))
(while cmds
(eval
`(defadvice ,(intern (symbol-name (car cmds)))
(after
,(intern (concat "follow-" (symbol-name (car cmds))))
activate)
"Adviced by `follow-mode'."
(follow-xemacs-scrollbar-support (ad-get-arg 0))))
(setq cmds (cdr cmds))))
(defun follow-xemacs-scrollbar-support (window)
"Redraw windows showing the same buffer as shown in WINDOW.
WINDOW is either the dragged window, or a cons containing the
window as its first element. This is called while the user drags
the scrollbar.
WINDOW can be an object or a window."
(condition-case nil
(progn
(if (consp window)
(setq window (car window)))
(let ((fmode (assq 'follow-mode
(buffer-local-variables
(window-buffer window))))
(orig-win (selected-window)))
(if (and fmode (cdr fmode))
(progn
(select-window window)
(follow-redisplay)
(select-window orig-win)))))
(error nil)))))
(defadvice set-process-filter (before follow-set-process-filter activate)
"Ensure process output will be displayed correctly in Follow Mode buffers.
Follow Mode inserts its own process filter to do its
magic stuff before the real process filter is called."
(if follow-intercept-processes
(progn
(setq follow-process-filter-alist
(delq (assq (ad-get-arg 0) follow-process-filter-alist)
follow-process-filter-alist))
(follow-tidy-process-filter-alist)
(cond ((eq (ad-get-arg 1) t))
((eq (ad-get-arg 1) nil)
(ad-set-arg 1 'follow-generic-filter))
(t
(setq follow-process-filter-alist
(cons (cons (ad-get-arg 0) (ad-get-arg 1))
follow-process-filter-alist))
(ad-set-arg 1 'follow-generic-filter))))))
(defun follow-call-set-process-filter (proc filter)
"Call original `set-process-filter' without the Follow mode advice."
(ad-disable-advice 'set-process-filter 'before
'follow-set-process-filter)
(ad-activate 'set-process-filter)
(prog1
(set-process-filter proc filter)
(ad-enable-advice 'set-process-filter 'before
'follow-set-process-filter)
(ad-activate 'set-process-filter)))
(defadvice process-filter (after follow-process-filter activate)
"Return the original process filter, not `follow-generic-filter'."
(cond ((eq ad-return-value 'follow-generic-filter)
(setq ad-return-value
(cdr-safe (assq (ad-get-arg 0)
follow-process-filter-alist))))))
(defun follow-call-process-filter (proc)
"Call original `process-filter' without the Follow mode advice."
(ad-disable-advice 'process-filter 'after
'follow-process-filter)
(ad-activate 'process-filter)
(prog1
(process-filter proc)
(ad-enable-advice 'process-filter 'after
'follow-process-filter)
(ad-activate 'process-filter)))
(defun follow-tidy-process-filter-alist ()
"Remove old processes from `follow-process-filter-alist'."
(let ((alist follow-process-filter-alist)
(ps (process-list))
(new ()))
(while alist
(if (and (not (memq (process-status (car (car alist)))
'(exit signal closed nil)))
(memq (car (car alist)) ps))
(setq new (cons (car alist) new)))
(setq alist (cdr alist)))
(setq follow-process-filter-alist new)))
(defun follow-intercept-process-output ()
"Intercept all active processes.
This is needed so that Follow Mode can track all display events in the
system. (See `follow-mode')"
(interactive)
(let ((list (process-list)))
(while list
(if (eq (process-filter (car list)) 'follow-generic-filter)
nil
(set-process-filter (car list) (process-filter (car list))))
(setq list (cdr list))))
(setq follow-intercept-processes t))
(defun follow-stop-intercept-process-output ()
"Stop Follow Mode from spying on processes.
All current spypoints are removed and no new will be added.
The effect is that Follow mode won't be able to handle buffers
connected to processes.
The only reason to call this function is if the Follow mode spy filter
would interfere with some other package. If this happens, please
report this using the `report-emacs-bug' function."
(interactive)
(follow-tidy-process-filter-alist)
(let ((list (process-list)))
(while list
(if (eq (process-filter (car list)) 'follow-generic-filter)
(progn
(follow-call-set-process-filter
(car list)
(cdr-safe (assq (car list) follow-process-filter-alist)))
(setq follow-process-filter-alist
(delq (assq (car list) follow-process-filter-alist)
follow-process-filter-alist))))
(setq list (cdr list))))
(setq follow-intercept-processes nil))
(defun follow-generic-filter (proc output)
"Process output filter for process connected to buffers in Follow mode."
(let* ((old-buffer (current-buffer))
(orig-win (selected-window))
(buf (process-buffer proc))
(win (and buf (if (eq buf (window-buffer orig-win))
orig-win
(get-buffer-window buf t))))
(return-to-orig-win (and win (not (eq win orig-win))))
(orig-window-start (and win (window-start win))))
(let ((filter (cdr-safe (assq proc follow-process-filter-alist))))
(cond
(filter
(funcall filter proc output))
(buf
(set-buffer buf)
(if (not (marker-buffer (process-mark proc)))
(set-marker (process-mark proc) (point-max)))
(let ((moving (= (point) (process-mark proc)))
deactivate-mark
(inhibit-read-only t))
(save-excursion
(goto-char (process-mark proc))
(insert-before-markers output)
(set-marker (process-mark proc) (point)))
(if moving (goto-char (process-mark proc)))))))
(if (and buf win (window-live-p win))
(progn
(set-buffer buf)
(if (and (boundp 'follow-mode) follow-mode)
(progn
(select-window win)
(let* ((windows (follow-all-followers win))
(win-start-end (follow-windows-start-end windows))
(new-window-start (window-start win))
(new-window-point (window-point win)))
(cond
((not (eq orig-window-start new-window-start))
(follow-debug-message "filter: Moved")
(set-window-start win orig-window-start)
(follow-redisplay windows win)
(setq win-start-end (follow-windows-start-end windows))
(follow-select-if-visible new-window-point
win-start-end)
(goto-char new-window-point)
(if (eq win (selected-window))
(set-window-start win new-window-start))
(setq win-start-end (follow-windows-start-end windows)))
((pos-visible-in-window-p new-window-point)
(follow-debug-message "filter: Visible in window"))
((follow-select-if-visible-from-first
new-window-point windows)
(follow-debug-message "filter: Seen from first")
(follow-redisplay windows (car windows))
(goto-char new-window-point)
(setq win-start-end
(follow-windows-start-end windows)))
(t
(follow-debug-message "filter: nothing")))
(if (and (not (follow-pos-visible
(point) (selected-window) win-start-end))
(not return-to-orig-win))
(progn
(sit-for 0)
(setq win-start-end
(follow-windows-start-end windows))))
(if (or follow-internal-force-redisplay
(not (follow-windows-aligned-p win-start-end)))
(follow-redisplay windows)))))))
(if return-to-orig-win
(select-window orig-win))
(if (and (eq buf (current-buffer))
(buffer-name old-buffer))
(set-buffer old-buffer)))
(follow-invalidate-cache)
(if (and follow-avoid-tail-recenter-p
(not (input-pending-p)))
(sit-for 0)))
(if (boundp 'window-size-change-functions)
(add-hook 'window-size-change-functions 'follow-window-size-change))
(defun follow-window-size-change (frame)
"Redraw all windows in FRAME, when in Follow mode."
(if follow-inside-post-command-hook
nil
(let ((buffers '())
(orig-window (selected-window))
(orig-buffer (current-buffer))
(orig-frame (selected-frame))
windows
buf)
(select-frame frame)
(unwind-protect
(walk-windows
(function
(lambda (win)
(setq buf (window-buffer win))
(if (memq buf buffers)
nil
(set-buffer buf)
(if (and (boundp 'follow-mode)
follow-mode)
(progn
(setq windows (follow-all-followers win))
(if (memq orig-window windows)
(progn
(select-window orig-window)
(follow-post-command-hook)
(setq orig-window (selected-window)))
(follow-redisplay windows win))
(setq buffers (cons buf buffers))))))))
(select-frame orig-frame)
(set-buffer orig-buffer)
(select-window orig-window)))))
(if (featurep 'xemacs)
(defadvice isearch-done (before follow-isearch-done activate)
(if (and (boundp 'follow-mode)
follow-mode
(boundp 'isearch-window-configuration)
isearch-window-configuration
(boundp 'isearch-slow-terminal-mode)
(not isearch-slow-terminal-mode))
(let ((buf (current-buffer)))
(setq isearch-window-configuration
(current-window-configuration))
(set-buffer buf)))))
(if (and follow-avoid-tail-recenter-p (boundp 'window-scroll-functions))
(add-hook 'window-scroll-functions 'follow-avoid-tail-recenter t))
(if follow-avoid-tail-recenter-p
(defadvice sit-for (before follow-sit-for activate)
"Adviced by Follow Mode.
Avoid to recenter windows displaying only the end of a file as when
displaying a short file in two windows, using Follow Mode."
(follow-avoid-tail-recenter)))
(if (and follow-avoid-tail-recenter-p
(fboundp 'move-overlay))
(defadvice move-overlay (before follow-move-overlay activate)
"Adviced by Follow Mode.
Don't recenter windows showing only the end of a buffer.
This prevents `mouse-drag-region' from messing things up."
(follow-avoid-tail-recenter)))
(cond (nil
(setq elp-function-list
'(window-end
vertical-motion
follow-mode
follow-all-followers
follow-split-followers
follow-redisplay
follow-downward
follow-calculate-first-window-start
follow-estimate-first-window-start
follow-calculate-first-window-start-from-above
follow-calculate-first-window-start-from-below
follow-calc-win-end
follow-calc-win-start
follow-pos-visible
follow-windows-start-end
follow-cache-valid-p
follow-select-if-visible
follow-select-if-visible-from-first
follow-windows-aligned-p
follow-point-visible-all-windows-p
follow-avoid-tail-recenter
follow-update-window-start
follow-post-command-hook
))))
(provide 'follow)