[nongnu] elpa/scroll-on-jump 9767013ca8 13/31: Support wrapping functions that themselves scroll

[ELPA Syncer]

branch: elpa/scroll-on-jump
commit 9767013ca85928b822226cf5a8d8e0554e14b65f
Author: Campbell Barton <ideasman42@gmail.com>
Commit: Campbell Barton <ideasman42@gmail.com>

    Support wrapping functions that themselves scroll
    
    Fixes #1
---
 readme.rst        | 22 +++++++++++--
 scroll-on-jump.el | 97 ++++++++++++++++++++++++++++++++++++++++++++++---------
 2 files changed, 101 insertions(+), 18 deletions(-)

diff --git a/readme.rst b/readme.rst
index 15eb40d8da..3358cd3472 100644
--- a/readme.rst
+++ b/readme.rst
@@ -53,7 +53,6 @@ The following functions are exposed.
 ``scroll-on-jump-advice-remove``
    Remove the advice added to the function.
 
-
 Commands that work well include:
 
 - Jump to search result, paragraph, function ... etc.
@@ -61,6 +60,16 @@ Commands that work well include:
 - Go to declaration.
 
 
+Wrapping Commands That Scroll
+-----------------------------
+
+If a command it's self sets a new scroll location,
+these can be wrapped using ``scroll-on-jump-with-scroll-`` prefix,
+so ``scroll-on-jump-with-scroll-interactive``, 
``scroll-on-jump-with-scroll-advice-add`` .. etc.
+
+In this case the newly set scroll location will be used when displaying the 
animation.
+
+
 Key Binding Example
 -------------------
 
@@ -129,7 +138,14 @@ Here is a more complete example for evil-mode users.
      (scroll-on-jump-advice-add evil-ex-search-next)
      (scroll-on-jump-advice-add evil-ex-search-previous)
      (scroll-on-jump-advice-add evil-forward-paragraph)
-     (scroll-on-jump-advice-add evil-backward-paragraph))
+     (scroll-on-jump-advice-add evil-backward-paragraph)
+
+     ;; Actions that themselves scroll.
+     (scroll-on-jump-with-scroll-advice-add evil-scroll-down)
+     (scroll-on-jump-with-scroll-advice-add evil-scroll-up)
+     (scroll-on-jump-with-scroll-advice-add evil-scroll-line-to-center)
+     (scroll-on-jump-with-scroll-advice-add evil-scroll-line-to-top)
+     (scroll-on-jump-with-scroll-advice-add evil-scroll-line-to-bottom))
 
    (with-eval-after-load 'goto-chg
      (scroll-on-jump-advice-add goto-last-change)
@@ -173,5 +189,5 @@ Until this is available on melpa, straight can be used to 
install this package.
 Limitations
 ===========
 
-- Any commands that themselves scroll to a new location will not work as 
expected
+- Any commands that themselves scroll to a new location *and* modify the 
buffer will not work as expected
   (they may scroll too far for example).
diff --git a/scroll-on-jump.el b/scroll-on-jump.el
index 640be27ee0..f318f669f1 100644
--- a/scroll-on-jump.el
+++ b/scroll-on-jump.el
@@ -401,11 +401,7 @@ Argument ALSO-MOVE-POINT When non-nil, move the POINT as 
well."
 
   (goto-char point-next))
 
-;; ---------------------------------------------------------------------------
-;; Public Functions
-
-;;;###autoload
-(defmacro scroll-on-jump (&rest body)
+(defmacro scroll-on-jump--impl (use-window-start &rest body)
   "Main macro that wraps BODY in logic that reacts to change in `point'."
   `
   (let
@@ -414,7 +410,13 @@ Argument ALSO-MOVE-POINT When non-nil, move the POINT as 
well."
       (window (selected-window))
 
       (point-prev (point))
-      (point-next nil))
+      (point-next nil)
+
+      (window-start-prev nil)
+      (window-start-next nil))
+
+    (when ,use-window-start
+      (setq window-start-prev (window-start window)))
 
     (prog1
       (save-excursion
@@ -431,19 +433,53 @@ Argument ALSO-MOVE-POINT When non-nil, move the POINT as 
well."
           (setq point-next (point))))
 
       (cond
-        ( ;; Perform animated scroll.
-          (and
-            ;; Buffer/Context changed.
-            (eq buf (window-buffer window)) (eq buf (current-buffer)) (eq 
window (selected-window))
+        ( ;; Context changed or recursed, simply jump.
+          (not
+            (and
+              ;; Buffer/Context changed.
+              (eq buf (window-buffer window))
+              (eq buf (current-buffer))
+              (eq window (selected-window))
 
-            ;; Disallow recursion.
-            (not (boundp 'scroll-on-jump--resurse)))
+              ;; Disallow recursion.
+              (not (boundp 'scroll-on-jump--resurse))))
 
+          (goto-char point-next))
+
+        (t ;; Perform animated scroll.
           (let ((scroll-on-jump--resurse t))
-            (scroll-on-jump-auto-center window point-prev point-next)))
+            (if window-start-prev
+              (progn
+                (setq window-start-next (window-start window))
+                (unless (eq window-start-prev window-start-next)
+                  (set-window-start window window-start-prev)
+                  (let
+                    (
+                      (lines-scroll
+                        (1- (count-screen-lines window-start-prev 
window-start-next t window)))
+                      (dir
+                        (if (< window-start-prev window-start-next)
+                          1
+                          -1)))
+                    (scroll-on-jump--scroll-impl
+                      window
+                      (* dir lines-scroll)
+                      dir
+                      (not (eq (point) point-next)))))
+                (goto-char point-next))
+              (scroll-on-jump-auto-center window point-prev point-next))))))))
 
-        (t ;; Context changed or recursed, simply jump.
-          (goto-char point-next))))))
+
+;; ---------------------------------------------------------------------------
+;; Public Functions
+
+;; ----------------
+;; Default Behavior
+;;
+;; Use for wrapping functions that set the point.
+
+;;;###autoload
+(defmacro scroll-on-jump (&rest body) `(scroll-on-jump--impl nil ,@body))
 
 ;;;###autoload
 (defmacro scroll-on-jump-interactive (fn)
@@ -468,6 +504,37 @@ without changing behavior anywhere else."
   "Remove advice on FN added by `scroll-on-jump-advice-add'."
   (advice-remove fn #'scroll-on-jump-advice--wrapper))
 
+;; -----------
+;; With-Scroll
+;;
+;; Use when wrapping actions that themselves scroll.
+
+;;;###autoload
+(defmacro scroll-on-jump-with-scroll (&rest body) `(scroll-on-jump--impl t 
,@body))
+
+;;;###autoload
+(defmacro scroll-on-jump-with-scroll-interactive (fn)
+  "Macro that wraps interactive call to function FN.
+
+Use if you want to use `scroll-on-jump-with-scroll' for a single `key-binding',
+without changing behavior anywhere else."
+  `(lambda () (interactive) (scroll-on-jump-with-scroll (call-interactively 
,fn))))
+
+;; Helper function (not public).
+(defun scroll-on-jump-advice--with-scroll-wrapper (old-fn &rest args)
+  "Internal function use to advise using `scroll-on-jump-advice-add' (calling 
OLD-FN with ARGS)."
+  (scroll-on-jump-with-scroll (apply old-fn args)))
+
+;;;###autoload
+(defmacro scroll-on-jump-with-scroll-advice-remove (fn)
+  "Remove advice on FN added by `scroll-on-jump-with-scroll-advice-add'."
+  (advice-remove fn #'scroll-on-jump-advice--with-scroll-wrapper))
+
+;;;###autoload
+(defmacro scroll-on-jump-with-scroll-advice-add (fn)
+  "Add advice to FN, to instrument it with scrolling capabilities."
+  (advice-add fn :around #'scroll-on-jump-advice--with-scroll-wrapper))
+
 (provide 'scroll-on-jump)
 
 ;;; scroll-on-jump.el ends here