Re: [Emacs-diffs] /srv/bzr/emacs/trunk r99831: Scrolling commands which does not signal errors at top/bottom.

[Juri Linkov]

> Please add a new variable so we can do
>
>             && NILP (Fmemq (current_kboard->Vlast_command, Vnewvariable))
>
> and let Lisp packages add their commands to that variable.

A new variable is added in this patch (that includes other changes as well):

=== modified file 'src/window.c'
--- src/window.c        2010-03-31 02:08:05 +0000
+++ src/window.c        2010-04-09 22:42:06 +0000
@@ -168,6 +168,10 @@
 
 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 @@
         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 @@
   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 @@
 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;
@@ -7377,9 +7391,9 @@
   initial_define_key (control_x_map, '<', "scroll-left");
   initial_define_key (control_x_map, '>', "scroll-right");
 
-  initial_define_key (global_map, Ctl ('V'), "scroll-up");
+  initial_define_key (global_map, Ctl ('V'), "scroll-up-command");
   initial_define_key (meta_map, Ctl ('V'), "scroll-other-window");
-  initial_define_key (meta_map, 'v', "scroll-down");
+  initial_define_key (meta_map, 'v', "scroll-down-command");
 }
 
 /* arch-tag: 90a9c576-0590-48f1-a5f1-6c96a0452d9f

=== modified file 'lisp/mwheel.el'
--- lisp/mwheel.el      2010-01-13 08:35:10 +0000
+++ lisp/mwheel.el      2010-04-09 22:30:53 +0000
@@ -246,6 +246,8 @@ (defun mwheel-scroll (event)
          (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

=== modified file 'lisp/simple.el'
--- lisp/simple.el      2010-04-05 23:44:24 +0000
+++ lisp/simple.el      2010-04-09 22:37:09 +0000
@@ -4744,6 +4877,16 @@ (define-globalized-minor-mode global-vis
 ;;; of buffer at first key-press (instead moves to top/bottom
 ;;; of buffer).
 
+(defcustom scroll-error-top-bottom nil
+  "Move point to top/bottom of buffer before signalling a scrolling error.
+A value of nil means just signal an error if no more scrolling possible.
+A value of t means point moves to the beginning or the end of the buffer
+\(depending on scrolling direction) when no more scrolling possible.
+When point is already on that position, then signal an error."
+  :type 'boolean
+  :group 'scrolling
+  :version "24.1")
+
 (defun scroll-up-command (&optional arg)
   "Scroll text of selected window upward ARG lines; or near full screen if no 
ARG.
 If `scroll-up' cannot scroll window further, move cursor to the bottom line.
@@ -4753,6 +4896,8 @@ (defun scroll-up-command (&optional arg)
 If ARG is the atom `-', scroll downward by nearly full screen."
   (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))))
@@ -4771,6 +4916,7 @@ (defun scroll-up-command (&optional arg)
         (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.
@@ -4781,6 +4927,8 @@ (defun scroll-down-command (&optional ar
 If ARG is the atom `-', scroll upward by nearly full screen."
   (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))))
@@ -4799,6 +4947,7 @@ (defun scroll-down-command (&optional ar
         (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 +4959,7 @@ (defun scroll-up-line (&optional arg)
   (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 +4969,7 @@ (defun scroll-down-line (&optional arg)
   (scroll-down (or arg 1)))
 
 (put 'scroll-down-line 'isearch-scroll t)
+(add-to-list 'scroll-preserve-screen-position-commands 'scroll-down-line)
 
 
 (defun scroll-other-window-down (lines)

=== modified file 'lisp/emulation/pc-select.el'
--- lisp/emulation/pc-select.el 2010-03-12 17:47:22 +0000
+++ lisp/emulation/pc-select.el 2010-04-06 23:17:36 +0000
@@ -93,6 +93,9 @@ (defcustom pc-select-override-scroll-err
 errors are suppressed."
   :type 'boolean
   :group 'pc-select)
+(define-obsolete-variable-alias 'pc-select-override-scroll-error
+                                'scroll-error-top-bottom
+                                "24.1")
 
 (defcustom pc-select-selection-keys-only nil
   "*Non-nil means only bind the basic selection keys when started.

=== modified file 'lisp/tutorial.el'
--- lisp/tutorial.el    2010-01-13 08:35:10 +0000
+++ lisp/tutorial.el    2010-04-06 23:10:38 +0000
@@ -218,8 +218,8 @@ (defconst tutorial--default-keys
              (save-buffers-kill-terminal [?\C-x ?\C-c])
 
              ;; * SUMMARY
-             (scroll-up [?\C-v])
-             (scroll-down [?\M-v])
+             (scroll-up-command [?\C-v])
+             (scroll-down-command [?\M-v])
              (recenter-top-bottom [?\C-l])
 
              ;; * BASIC CURSOR CONTROL

=== modified file 'lisp/image-mode.el'
--- lisp/image-mode.el  2010-03-10 14:01:48 +0000
+++ lisp/image-mode.el  2010-04-09 22:31:42 +0000
@@ -302,6 +302,8 @@ (defvar image-mode-map
     (define-key map [remap next-line] 'image-next-line)
     (define-key map [remap scroll-up] 'image-scroll-up)
     (define-key map [remap scroll-down] 'image-scroll-down)
+    (define-key map [remap scroll-up-command] 'image-scroll-up)
+    (define-key map [remap scroll-down-command] 'image-scroll-down)
     (define-key map [remap move-beginning-of-line] 'image-bol)
     (define-key map [remap move-end-of-line] 'image-eol)
     (define-key map [remap beginning-of-buffer] 'image-bob)

=== modified file 'lisp/emulation/cua-rect.el'
--- lisp/emulation/cua-rect.el  2010-01-13 08:35:10 +0000
+++ lisp/emulation/cua-rect.el  2010-04-09 22:30:27 +0000
@@ -1432,6 +1432,8 @@ (defun cua--init-rectangles ()
   (define-key cua--rectangle-keymap [remap beginning-of-buffer] 
'cua-resize-rectangle-top)
   (define-key cua--rectangle-keymap [remap scroll-down]         
'cua-resize-rectangle-page-up)
   (define-key cua--rectangle-keymap [remap scroll-up]           
'cua-resize-rectangle-page-down)
+  (define-key cua--rectangle-keymap [remap scroll-down-command] 
'cua-resize-rectangle-page-up)
+  (define-key cua--rectangle-keymap [remap scroll-up-command]   
'cua-resize-rectangle-page-down)
 
   (define-key cua--rectangle-keymap [remap delete-backward-char] 
'cua-delete-char-rectangle)
   (define-key cua--rectangle-keymap [remap backward-delete-char] 
'cua-delete-char-rectangle)

=== modified file 'lisp/forms.el'
--- lisp/forms.el       2010-01-13 08:35:10 +0000
+++ lisp/forms.el       2010-04-09 22:31:08 +0000
@@ -1407,7 +1407,9 @@ (defun forms--change-commands ()
   (if forms-forms-scroll
       (progn
        (local-set-key [remap scroll-up] 'forms-next-record)
-       (local-set-key [remap scroll-down] 'forms-prev-record)))
+       (local-set-key [remap scroll-down] 'forms-prev-record)
+       (local-set-key [remap scroll-up-command] 'forms-next-record)
+       (local-set-key [remap scroll-down-command] 'forms-prev-record)))
   ;;
   ;; beginning-of-buffer -> forms-first-record
   ;; end-of-buffer -> forms-end-record

-- 
Juri Linkov
http://www.jurta.org/emacs/