Add variable scroll-error-top-bottom.
[bpt/emacs.git] / lisp / simple.el
index cce793f..34e31b1 100644 (file)
@@ -2806,7 +2806,7 @@ ring directly.")
   "The tail of the kill ring whose car is the last thing yanked.")
 
 (defcustom save-interprogram-paste-before-kill nil
-  "Save the paste strings into `kill-ring' before replacing it with emacs strings.
+  "Save clipboard strings into kill ring before replacing them.
 When one selects something in another program to paste it into Emacs,
 but kills something in Emacs before actually pasting it,
 this selection is gone unless this variable is non-nil,
@@ -3468,17 +3468,18 @@ START and END specify the portion of the current buffer to be copied."
   (interactive
    (list (read-buffer "Append to buffer: " (other-buffer (current-buffer) t))
         (region-beginning) (region-end)))
-  (let ((oldbuf (current-buffer)))
-    (let* ((append-to (get-buffer-create buffer))
-           (windows (get-buffer-window-list append-to t t))
-           point)
+  (let* ((oldbuf (current-buffer))
+         (append-to (get-buffer-create buffer))
+         (windows (get-buffer-window-list append-to t t))
+         point)
+    (save-excursion
       (with-current-buffer append-to
-       (setq point (point))
-       (barf-if-buffer-read-only)
-       (insert-buffer-substring oldbuf start end)
-       (dolist (window windows)
-         (when (= (window-point window) point)
-           (set-window-point window (point))))))))
+        (setq point (point))
+        (barf-if-buffer-read-only)
+        (insert-buffer-substring oldbuf start end)
+        (dolist (window windows)
+          (when (= (window-point window) point)
+            (set-window-point window (point))))))))
 
 (defun prepend-to-buffer (buffer start end)
   "Prepend to specified buffer the text of the region.
@@ -4002,9 +4003,10 @@ and more reliable (no dependence on goal column, etc.)."
            (insert (if use-hard-newlines hard-newline "\n")))
        (line-move arg nil nil try-vscroll))
     (if (called-interactively-p 'interactive)
-       (condition-case nil
+       (condition-case err
            (line-move arg nil nil try-vscroll)
-         ((beginning-of-buffer end-of-buffer) (ding)))
+         ((beginning-of-buffer end-of-buffer)
+          (signal (car err) (cdr err))))
       (line-move arg nil nil try-vscroll)))
   nil)
 
@@ -4032,9 +4034,10 @@ to use and more reliable (no dependence on goal column, etc.)."
   (interactive "^p\np")
   (or arg (setq arg 1))
   (if (called-interactively-p 'interactive)
-      (condition-case nil
+      (condition-case err
          (line-move (- arg) nil nil try-vscroll)
-       ((beginning-of-buffer end-of-buffer) (ding)))
+       ((beginning-of-buffer end-of-buffer)
+        (signal (car err) (cdr err))))
     (line-move (- arg) nil nil try-vscroll))
   nil)
 
@@ -4700,7 +4703,7 @@ other purposes."
 This also turns on `word-wrap' in the buffer."
   :keymap visual-line-mode-map
   :group 'visual-line
-  :lighter " wrap"
+  :lighter " Wrap"
   (if visual-line-mode
       (progn
        (set (make-local-variable 'visual-line--saved-state) nil)
@@ -4735,6 +4738,111 @@ This also turns on `word-wrap' in the buffer."
   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).
+
+(defcustom scroll-error-top-bottom nil
+  "Move point to top/bottom of buffer before signalling a scrolling error.
+A value of nil means just signal an error if no more scrolling possible.
+A value of t means point moves to the beginning or the end of the buffer
+\(depending on scrolling direction) when no more scrolling possible.
+When point is already on that position, then signal an error."
+  :type 'boolean
+  :group 'scrolling
+  :version "24.1")
+
+(defun scroll-up-command (&optional arg)
+  "Scroll text of selected window upward ARG lines; or near full screen if no ARG.
+If `scroll-error-top-bottom' is non-nil and `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
+   ((null scroll-error-top-bottom)
+    (scroll-up arg))
+   ((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)
+(add-to-list 'scroll-preserve-screen-position-commands 'scroll-up-command)
+
+(defun scroll-down-command (&optional arg)
+  "Scroll text of selected window down ARG lines; or near full screen if no ARG.
+If `scroll-error-top-bottom' is non-nil and `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
+   ((null scroll-error-top-bottom)
+    (scroll-down arg))
+   ((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)
+(add-to-list 'scroll-preserve-screen-position-commands 'scroll-down-command)
+
+;;; Scrolling commands which scroll a line instead of full screen.
+
+(defun scroll-up-line (&optional arg)
+  "Scroll text of selected window upward ARG lines; or one line if no ARG.
+If ARG is omitted or nil, scroll upward by one line.
+This is different from `scroll-up-command' that scrolls a full screen."
+  (interactive "p")
+  (scroll-up (or arg 1)))
+
+(put 'scroll-up-line 'isearch-scroll t)
+(add-to-list 'scroll-preserve-screen-position-commands 'scroll-up-line)
+
+(defun scroll-down-line (&optional arg)
+  "Scroll text of selected window down ARG lines; or one line if no ARG.
+If ARG is omitted or nil, scroll down by one line.
+This is different from `scroll-down-command' that scrolls a full screen."
+  (interactive "p")
+  (scroll-down (or arg 1)))
+
+(put 'scroll-down-line 'isearch-scroll t)
+(add-to-list 'scroll-preserve-screen-position-commands 'scroll-down-line)
+
+\f
 (defun scroll-other-window-down (lines)
   "Scroll the \"other window\" down.
 For more details, see the documentation for `scroll-other-window'."
@@ -4854,7 +4962,18 @@ With argument 0, interchanges line point is in with line mark is in."
                       (forward-line arg))))
                  arg))
 
+;; FIXME seems to leave point BEFORE the current object when ARG = 0,
+;; which seems inconsistent with the ARG /= 0 case.
+;; FIXME document SPECIAL.
 (defun transpose-subr (mover arg &optional special)
+  "Subroutine to do the work of transposing objects.
+Works for lines, sentences, paragraphs, etc.  MOVER is a function that
+moves forward by units of the given object (e.g. forward-sentence,
+forward-paragraph).  If ARG is zero, exchanges the current object
+with the one containing mark.  If ARG is an integer, moves the
+current object past ARG following (if ARG is positive) or
+preceding (if ARG is negative) objects, leaving point after the
+current object."
   (let ((aux (if special mover
               (lambda (x)
                 (cons (progn (funcall mover x) (point))
@@ -5478,12 +5597,12 @@ cancel the use of the current buffer (for special-purpose buffers),
 or go back to just one window (by deleting all but the selected window)."
   (interactive)
   (cond ((eq last-command 'mode-exited) nil)
+       ((region-active-p)
+        (deactivate-mark))
        ((> (minibuffer-depth) 0)
         (abort-recursive-edit))
        (current-prefix-arg
         nil)
-       ((region-active-p)
-        (deactivate-mark))
        ((> (recursion-depth) 0)
         (exit-recursive-edit))
        (buffer-quit-function
@@ -6541,7 +6660,7 @@ VAR is normally a symbol (a variable) in which case it is treated like
 a hook, with a buffer-local and a global part.  But it can also be an
 arbitrary expression.
 ARGS is a list of variables which will be passed as additional arguments
-to each function, after the inital argument, and which the first argument
+to each function, after the initial argument, and which the first argument
 expects to receive when called."
   (declare (indent 2) (debug t))
   ;; We need those two gensyms because CL's lexical scoping is not available