bug#23347: 25.0.92; Follow mode scrolling broken -- scrolls only one page

[Alan Mackenzie <acm@muc.de>]

Hello, Anders.

On Sun, Apr 24, 2016 at 05:37:57PM +0200, Anders Lindgren wrote:
> Hi!

> Agreed. All three scroll commands (non-follow-mode scroll, scroll one page,
> and scroll N pages) are useful.

[ .... ]

> Yes, I agree, `page' isn't a good choice.

> What about `follow-scroll-up-keep-point'? That way it would be clear what
> the difference is between it and the normal scroll command.

> If I would have designed Follow mode today, I probably would have used your
> name, `follow-scroll-up-window', and named the N-page scroll
> `follow-scroll-up-window-group'.

I've just used `follow-scroll-up-window' and
`follow-scroll-down-window'.  At least, for now.

[ .... ]

> Anyway, here is what I think we can agree on:
> > 1. `follow-scroll-up/down' should scroll by N windows.
> > 2. There need to be commands in follow.el that scroll by 1 window as is
> >   done by the current `follow-scroll-up/down'.  You have suggested the
> >   name `follow-scroll-up/down-one-page'.  I have countered with
> >   `follow-scroll-up/down-window'.

> > If we can agree, I'm willing to amend follow.el.  I think it's probably
> > too late for this fix to make it into Emacs 25.1, though.
> >

> Well, give it a try. Feel free to pick a suitable name. If we come up with
> a clean solution quickly John might accept it.

OK.  I had one or two minor problems with follow-scroll-up/down with a
non-nil ARG.  In the end, I just extracted functionality from
follow-scroll-up/down-window into separate functions, and called those
from all four scrolling functions.

Anyway, here is the patch I've come up with.  Could you review it and
test it, please.  Thanks!


diff --git a/lisp/follow.el b/lisp/follow.el
index 5801f79..3e23247 100644
--- a/lisp/follow.el
+++ b/lisp/follow.el
@@ -532,6 +532,80 @@ follow-get-scrolled-point
 ;; position...  (This would also be corrected if we would have had a
 ;; good redisplay abstraction.)
 
+(defun follow-scroll-up-arg (arg)
+  "Scroll the text in a follow mode window chain up by ARG lines.
+If ARG is nil, scroll the size of the current window.
+
+This is an internal function for `follow-scroll-up' and
+`follow-scroll-up-window'."
+  (let ((opoint (point))  (owin (selected-window)))
+    (while
+        ;; If we are too near EOB, try scrolling the previous window.
+        (condition-case nil (progn (scroll-up arg) nil)
+          (end-of-buffer
+           (condition-case nil (progn (follow-previous-window) t)
+             (error
+              (select-window owin)
+              (goto-char opoint)
+              (signal 'end-of-buffer nil))))))
+    (unless (and scroll-preserve-screen-position
+                 (get this-command 'scroll-command))
+      (goto-char opoint))
+    (setq follow-fixed-window t)))
+
+(defun follow-scroll-down-arg (arg)
+  "Scroll the text in a follow mode window chain down by ARG lines.
+If ARG is nil, scroll the size of the current window.
+
+This is an internal function for `follow-scroll-down' and
+`follow-scroll-down-window'."
+  (let ((opoint (point)))
+    (scroll-down arg)
+    (unless (and scroll-preserve-screen-position
+                 (get this-command 'scroll-command))
+      (goto-char opoint))
+    (setq follow-fixed-window t)))
+
+;;;###autoload
+(defun follow-scroll-up-window (&optional arg)
+  "Scroll text in a Follow mode window up by that window's size.
+The other windows in the window chain will scroll synchronously.
+
+If called with no ARG, the `next-screen-context-lines' last lines of
+the window will be visible after the scroll.
+
+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 follow-mode)
+	 (scroll-up arg))
+	((eq arg '-)
+	 (follow-scroll-down-window))
+	(t (follow-scroll-up-arg arg))))
+(put 'follow-scroll-up-window 'scroll-command t)
+
+;;;###autoload
+(defun follow-scroll-down-window (&optional arg)
+  "Scroll text in a Follow mode window down by that window's size.
+The other windows in the window chain will scroll synchronously.
+
+If called with no ARG, the `next-screen-context-lines' top lines of
+the window in the chain will be visible after the scroll.
+
+If called with an argument, scroll ARG lines down.
+Negative ARG means scroll upward.
+
+Works like `scroll-down' when not in Follow mode."
+  (interactive "P")
+  (cond ((not follow-mode)
+	 (scroll-down arg))
+	((eq arg '-)
+	 (follow-scroll-up-window))
+	(t (follow-scroll-down-arg arg))))
+(put 'follow-scroll-down-window 'scroll-command t)
+
 ;;;###autoload
 (defun follow-scroll-up (&optional arg)
   "Scroll text in a Follow mode window chain up.
@@ -546,23 +620,18 @@ follow-scroll-up
   (interactive "P")
   (cond ((not follow-mode)
 	 (scroll-up arg))
-	((eq arg '-)
-	 (follow-scroll-down))
-	(t
-	 (let ((opoint (point))  (owin (selected-window)))
-	   (while
-	       ;; If we are too near EOB, try scrolling the previous window.
-	       (condition-case nil (progn (scroll-up arg) nil)
-		 (end-of-buffer
-		  (condition-case nil (progn (follow-previous-window) t)
-		    (error
-		     (select-window owin)
-		     (goto-char opoint)
-		     (signal 'end-of-buffer nil))))))
-	   (unless (and scroll-preserve-screen-position
-			(get this-command 'scroll-command))
-	     (goto-char opoint))
-	   (setq follow-fixed-window t)))))
+	(arg (follow-scroll-up-arg arg))
+        (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))
+	     ;; `window-end' might return nil.
+	     (if end
+		 (goto-char end))
+	     (vertical-motion (- next-screen-context-lines))
+	     (set-window-start (car windows) (point)))))))
 (put 'follow-scroll-up 'scroll-command t)
 
 ;;;###autoload
@@ -579,15 +648,22 @@ follow-scroll-down
   (interactive "P")
   (cond ((not follow-mode)
 	 (scroll-down arg))
-	((eq arg '-)
-	 (follow-scroll-up))
-	(t
-	 (let ((opoint (point)))
-	   (scroll-down arg)
-	   (unless (and scroll-preserve-screen-position
-			(get this-command 'scroll-command))
-	     (goto-char opoint))
-	   (setq follow-fixed-window t)))))
+	(arg (follow-scroll-down-arg 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)
+				    (if header-line-format 2 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))))))
 (put 'follow-scroll-down 'scroll-command t)
 
 (declare-function comint-adjust-point "comint" (window))


>     -- Anders

-- 
Alan Mackenzie (Nuremberg, Germany).