# HG changeset patch
# User Kim F. Storm <storm@cua.dk>
# Date 1083361124 0
# Node ID eb737a4709cb7b879a2ceac51eef8bc653af8663
# Parent  49e42dd581dd86b62ac879e23f3f76441c16af98
(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 -r 49e42dd581dd -r eb737a4709cb lisp/emulation/cua-base.el
--- a/lisp/emulation/cua-base.el	Fri Apr 30 21:38:23 2004 +0000
+++ b/lisp/emulation/cua-base.el	Fri Apr 30 21:38:44 2004 +0000
@@ -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 @@
     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 @@
   "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 @@
   (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)