summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJuri Linkov <juri@jurta.org>2010-04-06 02:38:53 +0300
committerJuri Linkov <juri@jurta.org>2010-04-06 02:38:53 +0300
commit79ce172a464f2d5cced69f97fd86c4e03a0876a9 (patch)
treef7347b58dd13fcc423f8b006bb39fe2219892393
parent6460e5342cb08578eb2fd22b086373bbc12a11d0 (diff)
downloademacs-79ce172a464f2d5cced69f97fd86c4e03a0876a9.tar.gz
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'.
-rw-r--r--etc/NEWS4
-rw-r--r--lisp/ChangeLog17
-rw-r--r--lisp/bindings.el4
-rw-r--r--lisp/emulation/cua-base.el3
-rw-r--r--lisp/simple.el63
5 files changed, 89 insertions, 2 deletions
diff --git a/etc/NEWS b/etc/NEWS
index 5f0dd4b6883..7c5f6b79b1a 100644
--- 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).
+
* Editing Changes in Emacs 24.1
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 69e20017750..f343754e3d2 100644
--- 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 37ca3b86055..a7f6643b2db 100644
--- 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 57ea683a1ff..39d3ff785ce 100644
--- 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 73138111cfe..7616d19057a 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -4738,6 +4738,69 @@ This also turns on `word-wrap' in the buffer."
visual-line-mode turn-on-visual-line-mode
:lighter " vl")
+;;; 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)
+
+
(defun scroll-other-window-down (lines)
"Scroll the \"other window\" down.
For more details, see the documentation for `scroll-other-window'."