Scrolling commands which does not signal errors at top/bottom.

http://lists.gnu.org/archive/html/emacs-devel/2010-03/msg01452.html

* simple.el (scroll-up-command, scroll-down-command): New commands.
Put property isearch-scroll=t on them.

* bindings.el (global-map): Rebind [prior] from `scroll-down' to
`scroll-down-command' and [next] from `scroll-up' to
`scroll-up-command'.

* emulation/cua-base.el: Put property CUA=move on
`scroll-up-command' and `scroll-down-command'.
(cua--init-keymaps): Remap `scroll-up-command' to `cua-scroll-up'
and `scroll-down-command' to `cua-scroll-down'.

diff --git a/etc/NEWS b/etc/NEWS
index 5f0dd4b6883b0baa84720d821b270a0e0f84d20e..7c5f6b79b1ab24b8b73b8b741348db652081fa54 100644 (file)
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -65,6 +65,10 @@ Algorithm.
 ** GTK scroll-bars are now placed on the right by default.
 Use `set-scroll-bar-mode' to change this.
 
+** New scrolling commands `scroll-up-command' and `scroll-down-command'
+(bound to [next] and [prior]) does not signal errors at top/bottom
+of buffer at first key-press (instead moves to top/bottom of buffer).
+
 \f
 * Editing Changes in Emacs 24.1
 

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 69e2001775013f48da9be458ea43994d07794ef5..f343754e3d29c366db8273a561523ce859a1616b 100644 (file)
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,20 @@
+2010-04-05  Juri Linkov  <juri@jurta.org>
+
+       Scrolling commands which does not signal errors at top/bottom.
+       http://lists.gnu.org/archive/html/emacs-devel/2010-03/msg01452.html
+
+       * simple.el (scroll-up-command, scroll-down-command): New commands.
+       Put property isearch-scroll=t on them.
+
+       * bindings.el (global-map): Rebind [prior] from `scroll-down' to
+       `scroll-down-command' and [next] from `scroll-up' to
+       `scroll-up-command'.
+
+       * emulation/cua-base.el: Put property CUA=move on
+       `scroll-up-command' and `scroll-down-command'.
+       (cua--init-keymaps): Remap `scroll-up-command' to `cua-scroll-up'
+       and `scroll-down-command' to `cua-scroll-down'.
+
 2010-04-05  Juanma Barranquero  <lekktu@gmail.com>
 
        * help.el (describe-mode): Return nil.

diff --git a/lisp/bindings.el b/lisp/bindings.el
index 37ca3b860559e03f685c44b7c7040c800fa79ac9..a7f6643b2dbdcff922761bcef6f817d3d3eccde2 100644 (file)
--- a/lisp/bindings.el
+++ b/lisp/bindings.el
@@ -873,8 +873,8 @@ or \\[semantic-mode]")))))
 (define-key global-map [up]            'previous-line)
 (define-key global-map [right]         'forward-char)
 (define-key global-map [down]          'next-line)
-(define-key global-map [prior]         'scroll-down)
-(define-key global-map [next]          'scroll-up)
+(define-key global-map [prior]         'scroll-down-command)
+(define-key global-map [next]          'scroll-up-command)
 (define-key global-map [C-up]          'backward-paragraph)
 (define-key global-map [C-down]                'forward-paragraph)
 (define-key global-map [C-prior]       'scroll-right)

diff --git a/lisp/emulation/cua-base.el b/lisp/emulation/cua-base.el
index 57ea683a1ff0878492dee630c5aba96a65c77046..39d3ff785cefa89f0fb1356a1b5b97705fc41131 100644 (file)
--- a/lisp/emulation/cua-base.el
+++ b/lisp/emulation/cua-base.el
@@ -1440,6 +1440,8 @@ If ARG is the atom `-', scroll upward by nearly full screen."
   ;; 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-global-keymap [remap scroll-up-command]   'cua-scroll-up)
+  (define-key cua-global-keymap [remap scroll-down-command] '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)
@@ -1499,6 +1501,7 @@ If ARG is the atom `-', scroll upward by nearly full screen."
    move-end-of-line move-beginning-of-line
    end-of-buffer beginning-of-buffer
    scroll-up scroll-down
+   scroll-up-command scroll-down-command
    up-list down-list backward-up-list
    end-of-defun beginning-of-defun
    forward-sexp backward-sexp

diff --git a/lisp/simple.el b/lisp/simple.el
index 73138111cfe804172d4a27cc92923dcab786ca84..7616d19057a156c8625e5292d53a8f5c67d621cc 100644 (file)
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -4737,6 +4737,69 @@ This also turns on `word-wrap' in the buffer."
 (define-globalized-minor-mode global-visual-line-mode
   visual-line-mode turn-on-visual-line-mode
   :lighter " vl")
+\f
+;;; Scrolling commands.
+
+;;; Scrolling commands which does not signal errors at top/bottom
+;;; of buffer at first key-press (instead moves to top/bottom
+;;; of buffer).
+
+(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.
+When point is already on that position, then signal an error.
+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 '-) (scroll-down-command nil))
+   ((< (prefix-numeric-value arg) 0)
+    (scroll-down-command (- (prefix-numeric-value arg))))
+   ((eobp)
+    (scroll-up arg))  ; signal error
+   (t
+    (condition-case nil
+       (scroll-up arg)
+      (end-of-buffer
+       (if arg
+          ;; When scrolling by ARG lines can't be done,
+          ;; move by ARG lines instead.
+          (forward-line arg)
+        ;; When ARG is nil for full-screen scrolling,
+        ;; move to the bottom of the buffer.
+        (goto-char (point-max))))))))
+
+(put 'scroll-up-command 'isearch-scroll t)
+
+(defun scroll-down-command (&optional arg)
+  "Scroll text of selected window down ARG lines; or near full screen if no ARG.
+If `scroll-down' cannot scroll window further, move cursor to the top line.
+When point is already on that position, then signal an error.
+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 '-) (scroll-up-command nil))
+   ((< (prefix-numeric-value arg) 0)
+    (scroll-up-command (- (prefix-numeric-value arg))))
+   ((bobp)
+    (scroll-down arg))  ; signal error
+   (t
+    (condition-case nil
+       (scroll-down arg)
+      (beginning-of-buffer
+       (if arg
+          ;; When scrolling by ARG lines can't be done,
+          ;; move by ARG lines instead.
+          (forward-line (- arg))
+        ;; When ARG is nil for full-screen scrolling,
+        ;; move to the top of the buffer.
+        (goto-char (point-min))))))))
+
+(put 'scroll-down-command 'isearch-scroll t)
+
 \f
 (defun scroll-other-window-down (lines)
   "Scroll the \"other window\" down.