Add variable `scroll-preserve-screen-position-commands'.

http://lists.gnu.org/archive/html/emacs-devel/2010-04/msg00403.html

* window.c (Vscroll_preserve_screen_position_commands): New variable
with the default value as the list of Qscroll_down and Qscroll_up.
(window_scroll_pixel_based, window_scroll_line_based): Search the
last command in the list Vscroll_preserve_screen_position_commands
instead of comparing with Qscroll_up and Qscroll_down.

* mwheel.el (scroll-preserve-screen-position-commands):
Add mwheel-scroll to this list of commands.

* simple.el (scroll-preserve-screen-position-commands):
Add scroll-up-command, scroll-down-command, scroll-up-line,
scroll-down-line to this list of commands.

diff --git a/etc/NEWS b/etc/NEWS
index e52f43767fb978702160c5e7298a2d659886703b..b559b9c93a613f6daf473c820db8cfbf16c0bb5b 100644 (file)
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -75,6 +75,9 @@ of buffer at first key-press (instead moves to top/bottom of buffer).
 ** New scrolling commands `scroll-up-line' and `scroll-down-line'
 scroll a line instead of full screen.
 
+** New variable `scroll-preserve-screen-position-commands' defines
+a list of scroll command affected by `scroll-preserve-screen-position.
+
 \f
 * Editing Changes in Emacs 24.1
 

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 9a439444831d1275e1ea88d0473dc3a765ab1c6a..8baac73bd9a80e06f809310460928155c152b46b 100644 (file)
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,12 @@
+2010-04-14  Juri Linkov  <juri@jurta.org>
+
+       * mwheel.el (scroll-preserve-screen-position-commands):
+       Add mwheel-scroll to this list of commands.
+
+       * simple.el (scroll-preserve-screen-position-commands):
+       Add scroll-up-command, scroll-down-command, scroll-up-line,
+       scroll-down-line to this list of commands.
+
 2010-04-13  Stefan Monnier  <monnier@iro.umontreal.ca>
 
        * obsolete/complete.el: Move from lisp/complete.el.

diff --git a/lisp/mwheel.el b/lisp/mwheel.el
index c505833502abc6d6fa3820a80fe77e30131b3568..f88b2e86503fd6e5c0dda67a7468f55768dfc0b2 100644 (file)
--- a/lisp/mwheel.el
+++ b/lisp/mwheel.el
@@ -246,6 +246,8 @@ This should only be bound to mouse buttons 4 and 5."
          (run-with-timer mouse-wheel-inhibit-click-time nil
                          'mwheel-inhibit-click-timeout))))
 
+(add-to-list 'scroll-preserve-screen-position-commands 'mwheel-scroll)
+
 (defvar mwheel-installed-bindings nil)
 
 ;; preloaded ;;;###autoload

diff --git a/lisp/simple.el b/lisp/simple.el
index 66ea9ebebd9cd9b5d51b9363e99fc66ed41cd126..60fe6c875d2b562234e44afe9b6975aba9a29585 100644 (file)
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -4771,6 +4771,7 @@ If ARG is the atom `-', scroll downward by nearly full screen."
         (goto-char (point-max))))))))
 
 (put 'scroll-up-command 'isearch-scroll t)
+(add-to-list 'scroll-preserve-screen-position-commands 'scroll-up-command)
 
 (defun scroll-down-command (&optional arg)
   "Scroll text of selected window down ARG lines; or near full screen if no ARG.
@@ -4799,6 +4800,7 @@ If ARG is the atom `-', scroll upward by nearly full screen."
         (goto-char (point-min))))))))
 
 (put 'scroll-down-command 'isearch-scroll t)
+(add-to-list 'scroll-preserve-screen-position-commands 'scroll-down-command)
 
 ;;; Scrolling commands which scroll a line instead of full screen.
 
@@ -4810,6 +4812,7 @@ This is different from `scroll-up-command' that scrolls a full screen."
   (scroll-up (or arg 1)))
 
 (put 'scroll-up-line 'isearch-scroll t)
+(add-to-list 'scroll-preserve-screen-position-commands 'scroll-up-line)
 
 (defun scroll-down-line (&optional arg)
   "Scroll text of selected window down ARG lines; or one line if no ARG.
@@ -4819,6 +4822,7 @@ This is different from `scroll-down-command' that scrolls a full screen."
   (scroll-down (or arg 1)))
 
 (put 'scroll-down-line 'isearch-scroll t)
+(add-to-list 'scroll-preserve-screen-position-commands 'scroll-down-line)
 
 \f
 (defun scroll-other-window-down (lines)

diff --git a/src/ChangeLog b/src/ChangeLog
index a8e8aa7ddfbec6f9c5c39ab1169f485709b83e66..e4130a64838e2f47408980a15fb93b41a1202e85 100644 (file)
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,11 @@
+2010-04-14  Juri Linkov  <juri@jurta.org>
+
+       * window.c (Vscroll_preserve_screen_position_commands): New variable
+       with the default value as the list of Qscroll_down and Qscroll_up.
+       (window_scroll_pixel_based, window_scroll_line_based): Search the
+       last command in the list Vscroll_preserve_screen_position_commands
+       instead of comparing with Qscroll_up and Qscroll_down.
+
 2010-04-13  Jan Djärv  <jan.h.d@swipnet.se>
 
        * gtkutil.c (xg_set_geometry): Set geometry for PPosition also.

diff --git a/src/window.c b/src/window.c
index f17a645f82ce3105a694c510d183c78ecfc1e555..2757b98ddd9f640485e1c61ab9253b98fe8bb51a 100644 (file)
--- a/src/window.c
+++ b/src/window.c
@@ -168,6 +168,10 @@ static Lisp_Object Vwindow_configuration_change_hook;
 
 Lisp_Object Vscroll_preserve_screen_position;
 
+/* List of commands affected by `Vscroll_preserve_screen_position'.  */
+
+Lisp_Object Vscroll_preserve_screen_position_commands;
+
 /* Non-nil means that text is inserted before window's markers.  */
 
 Lisp_Object Vwindow_point_insertion_type;
@@ -4946,8 +4950,8 @@ window_scroll_pixel_based (window, n, whole, noerror)
         possibility of point becoming "stuck" on a tall line when
         scrolling by one line.  */
       if (window_scroll_pixel_based_preserve_y < 0
-         || (!EQ (current_kboard->Vlast_command, Qscroll_up)
-             && !EQ (current_kboard->Vlast_command, Qscroll_down)))
+         || NILP (Fmemq (current_kboard->Vlast_command,
+                         Vscroll_preserve_screen_position_commands)))
        {
          start_display (&it, w, start);
          move_it_to (&it, PT, -1, -1, -1, MOVE_TO_POS);
@@ -5207,8 +5211,8 @@ window_scroll_line_based (window, n, whole, noerror)
   if (!NILP (Vscroll_preserve_screen_position))
     {
       if (window_scroll_preserve_vpos <= 0
-         || (!EQ (current_kboard->Vlast_command, Qscroll_up)
-             && !EQ (current_kboard->Vlast_command, Qscroll_down)))
+         || NILP (Fmemq (current_kboard->Vlast_command,
+                         Vscroll_preserve_screen_position_commands)))
        {
          struct position posit
            = *compute_motion (startpos, 0, 0, 0,
@@ -7265,9 +7269,19 @@ at the scroll margin or window boundary respectively.
 A value of t means point keeps its screen position if the scroll
 command moved it vertically out of the window, e.g. when scrolling
 by full screens.
-Any other value means point always keeps its screen position.  */);
+Any other value means point always keeps its screen position.
+Scroll commands are defined by the variable
+`scroll-preserve-screen-position-commands'.  */);
   Vscroll_preserve_screen_position = Qnil;
 
+  DEFVAR_LISP ("scroll-preserve-screen-position-commands",
+              &Vscroll_preserve_screen_position_commands,
+              doc: /* A list of commands whose scrolling should keep screen position unchanged.
+This list defines the names of scroll commands affected by the variable
+`scroll-preserve-screen-position'.  */);
+  Vscroll_preserve_screen_position_commands =
+    Fcons (Qscroll_down, Fcons (Qscroll_up, Qnil));
+
   DEFVAR_LISP ("window-point-insertion-type", &Vwindow_point_insertion_type,
               doc: /* Type of marker to use for `window-point'.  */);
   Vwindow_point_insertion_type = Qnil;