master bb9c899b07: Make the goal column work for the scrolling commands, too

[Lars Ingebrigtsen]

branch: master
commit bb9c899b07a6a7de3a04b65caa55f11fdc36908c
Author: Lars Ingebrigtsen <larsi@gnus.org>
Commit: Lars Ingebrigtsen <larsi@gnus.org>

    Make the goal column work for the scrolling commands, too
    
    * doc/emacs/basic.texi (Moving Point): Document it.
    * lisp/simple.el (set-goal-column): Update doc string.
    
    * lisp/window.el (scroll-up-command, scroll-down-command): Make
    the goal column take effect for these commands, too (bug#17346).
---
 doc/emacs/basic.texi |  10 ++---
 etc/NEWS             |   5 +++
 lisp/simple.el       |  15 +++++---
 lisp/window.el       | 107 +++++++++++++++++++++++++++++++--------------------
 4 files changed, 85 insertions(+), 52 deletions(-)

diff --git a/doc/emacs/basic.texi b/doc/emacs/basic.texi
index b93a6d5de6..1a4abdc9ec 100644
--- a/doc/emacs/basic.texi
+++ b/doc/emacs/basic.texi
@@ -347,11 +347,11 @@ move to the column number specified by the argument's 
numeric value.
 @kindex C-x C-n
 @findex set-goal-column
 Use the current column of point as the @dfn{semipermanent goal column}
-for @kbd{C-n} and @kbd{C-p} (@code{set-goal-column}) in the current
-buffer.  When a semipermanent goal column is in effect, those commands
-always try to move to this column, or as close as possible to it,
-after moving vertically.  The goal column remains in effect until
-canceled.
+(@code{set-goal-column}) in the current buffer.  When a semipermanent
+goal column is in effect, @kbd{C-n}, @kbd{C-p}, @kbd{<prior>} and
+@kbd{<next>} always try to move to this column, or as close as
+possible to it, after moving vertically.  The goal column remains in
+effect until canceled.
 
 @item C-u C-x C-n
 Cancel the goal column.  Henceforth, @kbd{C-n} and @kbd{C-p} try to
diff --git a/etc/NEWS b/etc/NEWS
index 8250cac1cc..b75c1c9f6c 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -136,6 +136,11 @@ of 'user-emacs-directory'.
 
 * Incompatible changes in Emacs 29.1
 
++++
+** Setting the goal columns now also affects '<prior>' and '<next>'.
+Previously, 'C-x C-n' only affected 'next-line' and 'previous-line',
+but it now also affects 'scroll-up-command' and 'scroll-down-command'.
+
 ---
 ** The 'd' command in Dired now more consistently skip dot files.
 In previous Emacs versions, commands like `C-u 10 d' would put the "D"
diff --git a/lisp/simple.el b/lisp/simple.el
index a22df8025b..c749e6e41d 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -8078,13 +8078,18 @@ For motion by visual lines, see 
`beginning-of-visual-line'."
 (put 'set-goal-column 'disabled t)
 
 (defun set-goal-column (arg)
-  "Set the current horizontal position as a goal for \\[next-line] and 
\\[previous-line].
+  "Set the current horizontal position as a goal column.
+This goal column will affect the \\[next-line] and \\[previous-line] commands,
+as well as the \\[scroll-up-command] and \\[scroll-down-command] commands.
+
 Those commands will move to this position in the line moved to
 rather than trying to keep the same horizontal position.
-With a non-nil argument ARG, clears out the goal column
-so that \\[next-line] and \\[previous-line] resume vertical motion.
-The goal column is stored in the variable `goal-column'.
-This is a buffer-local setting."
+
+With a non-nil argument ARG, clears out the goal column so that
+these commands resume normal motion.
+
+The goal column is stored in the variable `goal-column'.  This is
+a buffer-local setting."
   (interactive "P")
   (if arg
       (progn
diff --git a/lisp/window.el b/lisp/window.el
index 5da867715f..1b8fe2b262 100644
--- a/lisp/window.el
+++ b/lisp/window.el
@@ -10103,28 +10103,45 @@ scroll window further, move cursor to the bottom line.
 When point is already on that position, then signal an error.
 A near full screen is `next-screen-context-lines' less than a full screen.
 Negative ARG means scroll downward.
-If ARG is the atom `-', scroll downward by nearly full screen."
+
+If ARG is the atom `-', scroll downward by nearly full screen.
+
+The command \\[set-goal-column] can be used to create a
+semipermanent goal column for this command."
   (interactive "^P")
-  (cond
-   ((null scroll-error-top-bottom)
-    (scroll-up arg))
-   ((eq arg '-)
-    (scroll-down-command nil))
-   ((< (prefix-numeric-value arg) 0)
-    (scroll-down-command (- (prefix-numeric-value arg))))
-   ((eobp)
-    (scroll-up arg))                   ; signal error
-   (t
-    (condition-case nil
-       (scroll-up arg)
-      (end-of-buffer
-       (if arg
-          ;; When scrolling by ARG lines can't be done,
-          ;; move by ARG lines instead.
-          (forward-line arg)
-        ;; When ARG is nil for full-screen scrolling,
-        ;; move to the bottom of the buffer.
-        (goto-char (point-max))))))))
+  (prog1
+      (cond
+       ((null scroll-error-top-bottom)
+        (scroll-up arg))
+       ((eq arg '-)
+        (scroll-down-command nil))
+       ((< (prefix-numeric-value arg) 0)
+        (scroll-down-command (- (prefix-numeric-value arg))))
+       ((eobp)
+        (scroll-up arg))                ; signal error
+       (t
+        (condition-case nil
+           (scroll-up arg)
+          (end-of-buffer
+           (if arg
+              ;; When scrolling by ARG lines can't be done,
+              ;; move by ARG lines instead.
+              (forward-line arg)
+            ;; When ARG is nil for full-screen scrolling,
+            ;; move to the bottom of the buffer.
+            (goto-char (point-max)))))))
+    (scroll-command--goto-goal-column)))
+
+(defun scroll-command--goto-goal-column ()
+  (when goal-column
+    ;; Move to the desired column.
+    (if (and line-move-visual
+             (not (or truncate-lines truncate-partial-width-windows)))
+        ;; Under line-move-visual, goal-column should be
+        ;; interpreted in units of the frame's canonical character
+        ;; width, which is exactly what vertical-motion does.
+        (vertical-motion (cons goal-column 0))
+      (line-move-to-column (truncate goal-column)))))
 
 (put 'scroll-up-command 'scroll-command t)
 
@@ -10140,28 +10157,34 @@ scroll window further, move cursor to the top line.
 When point is already on that position, then signal an error.
 A near full screen is `next-screen-context-lines' less than a full screen.
 Negative ARG means scroll upward.
-If ARG is the atom `-', scroll upward by nearly full screen."
+
+If ARG is the atom `-', scroll upward by nearly full screen.
+
+The command \\[set-goal-column] can be used to create a
+semipermanent goal column for this command."
   (interactive "^P")
-  (cond
-   ((null scroll-error-top-bottom)
-    (scroll-down arg))
-   ((eq arg '-)
-    (scroll-up-command nil))
-   ((< (prefix-numeric-value arg) 0)
-    (scroll-up-command (- (prefix-numeric-value arg))))
-   ((bobp)
-    (scroll-down arg))                 ; signal error
-   (t
-    (condition-case nil
-       (scroll-down arg)
-      (beginning-of-buffer
-       (if arg
-          ;; When scrolling by ARG lines can't be done,
-          ;; move by ARG lines instead.
-          (forward-line (- arg))
-        ;; When ARG is nil for full-screen scrolling,
-        ;; move to the top of the buffer.
-        (goto-char (point-min))))))))
+  (prog1
+      (cond
+       ((null scroll-error-top-bottom)
+        (scroll-down arg))
+       ((eq arg '-)
+        (scroll-up-command nil))
+       ((< (prefix-numeric-value arg) 0)
+        (scroll-up-command (- (prefix-numeric-value arg))))
+       ((bobp)
+        (scroll-down arg))              ; signal error
+       (t
+        (condition-case nil
+           (scroll-down arg)
+          (beginning-of-buffer
+           (if arg
+              ;; When scrolling by ARG lines can't be done,
+              ;; move by ARG lines instead.
+              (forward-line (- arg))
+            ;; When ARG is nil for full-screen scrolling,
+            ;; move to the top of the buffer.
+            (goto-char (point-min)))))))
+    (scroll-command--goto-goal-column)))
 
 (put 'scroll-down-command 'scroll-command t)