From: Kim F. Storm <storm@cua.dk>
Date: Fri, 30 Apr 2004 21:38:44 +0000 (+0000)
Subject: (cua--standard-movement-commands):
X-Git-Tag: ttn-vms-21-2-B4~6495
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=82851d10ad9e6e66f5a4f55732866023742f353a;p=emacs.git

(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 24f95ec21ea..0dbfce78870 100644
--- 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)