From 79ce172a464f2d5cced69f97fd86c4e03a0876a9 Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Tue, 6 Apr 2010 02:38:53 +0300 Subject: [PATCH] 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'. --- etc/NEWS | 4 +++ lisp/ChangeLog | 17 ++++++++++ lisp/bindings.el | 4 +-- lisp/emulation/cua-base.el | 3 ++ lisp/simple.el | 63 ++++++++++++++++++++++++++++++++++++++ 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 + + 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 * 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 @@ -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") + +;;; 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.