branch: elpa/scroll-on-jump
commit 9767013ca85928b822226cf5a8d8e0554e14b65f
Author: Campbell Barton <[email protected]>
Commit: Campbell Barton <[email protected]>
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
