From bb9c899b07a6a7de3a04b65caa55f11fdc36908c Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Sun, 5 Jun 2022 21:35:56 +0200 Subject: [PATCH] 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 b93a6d5de6e..1a4abdc9ecd 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{} and +@kbd{} 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 8250cac1cc4..b75c1c9f6c1 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 '' and ''. +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 a22df8025b3..c749e6e41d6 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 5da867715f6..1b8fe2b2628 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) -- 2.39.2