(cua--standard-movement-commands):

Add cua-scroll-up and cua-scroll-down.
(cua-scroll-up, cua-scroll-down): New commands.
(cua--init-keymaps): Remap scroll-up and scroll-down.

diff --git a/lisp/emulation/cua-base.el b/lisp/emulation/cua-base.el
index 24f95ec21ea98393248a46a9f1ffa93718414900..0dbfce7887079c4ec376ac9b102b84ec24881804 100644 (file)
--- a/lisp/emulation/cua-base.el
+++ b/lisp/emulation/cua-base.el
@@ -1,6 +1,6 @@
 ;;; cua-base.el --- emulate CUA key bindings
 
-;; Copyright (C) 1997,98,99,200,01,02,03  Free Software Foundation, Inc.
+;; Copyright (C) 1997,98,99,200,01,02,03,04  Free Software Foundation, Inc.
 
 ;; Author: Kim F. Storm <storm@cua.dk>
 ;; Keywords: keyboard emulation convenience cua
@@ -893,7 +893,7 @@ With a double \\[universal-argument] prefix argument, unconditionally set mark."
     forward-word backward-word
     end-of-line beginning-of-line
     end-of-buffer beginning-of-buffer
-    scroll-up scroll-down
+    scroll-up scroll-down cua-scroll-up cua-scroll-down
     forward-sentence backward-sentence
     forward-paragraph backward-paragraph)
   "List of standard movement commands.
@@ -903,6 +903,46 @@ Extra commands should be added to `cua-movement-commands'")
   "User may add additional movement commands to this list.")
 
 
+;;; Scrolling commands which does not signal errors at top/bottom
+;;; of buffer at first key-press (instead moves to top/bottom
+;;; of buffer).
+
+(defun cua-scroll-up (&optional arg)
+  "Scroll text of current window upward ARG lines; or near full screen if no ARG.
+If window cannot be scrolled further, move cursor to bottom line instead.
+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."
+  (interactive "P")
+  (cond
+   ((eq arg '-) (cua-scroll-down nil))
+   ((< (prefix-numeric-value arg) 0)
+    (cua-scroll-down (- (prefix-numeric-value arg))))
+   ((eobp)
+    (scroll-up arg))  ; signal error
+   (t
+    (condition-case nil
+       (scroll-up arg)
+      (end-of-buffer (goto-char (point-max)))))))
+
+(defun cua-scroll-down (&optional arg)
+  "Scroll text of current window downward ARG lines; or near full screen if no ARG.
+If window cannot be scrolled further, move cursor to top line instead.
+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."
+  (interactive "P")
+  (cond
+   ((eq arg '-) (cua-scroll-up nil))
+   ((< (prefix-numeric-value arg) 0)
+    (cua-scroll-up (- (prefix-numeric-value arg))))
+   ((bobp)
+    (scroll-down arg))  ; signal error
+   (t
+    (condition-case nil
+       (scroll-down arg)
+      (beginning-of-buffer (goto-char (point-min)))))))
+
 ;;; Cursor indications
 
 (defun cua--update-indications ()
@@ -1108,6 +1148,10 @@ Extra commands should be added to `cua-movement-commands'")
   (define-key cua-global-keymap [remap undo]           'cua-undo)
   (define-key cua-global-keymap [remap advertised-undo]        'cua-undo)
 
+  ;; scrolling
+  (define-key cua-global-keymap [remap scroll-up]      'cua-scroll-up)
+  (define-key cua-global-keymap [remap scroll-down]    'cua-scroll-down)
+
   (define-key cua--cua-keys-keymap [(control x) timeout] 'kill-region)
   (define-key cua--cua-keys-keymap [(control c) timeout] 'copy-region-as-kill)
   (define-key cua--cua-keys-keymap [(control z)] 'undo)