From: jbw@bigbird.bu.edu (Joe Wells)
Newsgroups: gnu.emacs.help
Subject: Re: modifying C-v and M-v
Date: 15 Apr 92 23:41:57 GMT
Distribution: na
Organization: Boston University Computer Science Department
In-reply-to: pat@jaameri.gsfc.nasa.gov's message of 14 Apr 92 13:25:43 GMT

In article <1992Apr14.132543.22983@nsisrv.gsfc.nasa.gov> pat@jaameri.gsfc.nasa.gov (Patrick M. Ryan) writes:

   I'd like to modify the behavior of the scroll-up (M-v) and
   scroll-down (C-v) keys as such:

   1. If I am at the top of the buffer, I want scroll-up to put
      the cursor at the top of the screen.  Right now it just beeps.

   2. If I am at the bottom of the buffer, I want scroll-down to
      put the cursor on the last line (or the end of the buffer).

Included below.

-- 
Enjoy,

Joe Wells <jbw@cs.bu.edu>
Member of the League for Programming Freedom --- send e-mail for details

----------------------------------------------------------------------
;; Improved window scrolling commands.
;; Copyright (C) 1988, 1989, 1991 Free Software Foundation, Inc.

;; This program is not officially part of GNU Emacs.

;; This program is distributed in the hope that it will be useful, but
;; WITHOUT ANY WARRANTY.  No author or distributor accepts responsibility
;; to anyone for the consequences of using it or for whether it serves any
;; particular purpose or works at all, unless he says so in writing.
;; Refer to the GNU General Public License for full details.

;; Everyone is granted permission to copy, modify and redistribute this
;; program, but only under the conditions described in the GNU General
;; Public License.  A copy of this license is supposed to have been given
;; to you along with GNU Emacs so you can know your rights and
;; responsibilities.  It should be in a file named COPYING.  Among other
;; things, the copyright notice and this notice must be preserved on all
;; copies.

;; LCD Archive Entry: scroll-fix|Joe Wells|jbw@cs.bu.edu|
;; Improved window scrolling commands|9 Aug 1991|||

;; Author: Joe Wells <jbw@cs.bu.edu>
;; Created by: Joe Wells, jbw@bucsf
;; Created on: Fall 1987
;; Last modified by: Joe Wells, jbw@maverick.uswest.com
;; Last modified on: Fri Aug  9 17:47:25 1991
;; Filename: scroll-fix.el
;; Purpose: Improved window scrolling commands
;; Change log: 
;; 
;; Fri Aug  9 17:04:10 1991  Joe Wells  (jbw at maverick.uswest.com)
;; 
;; 	* Cleaned up some stuff, added more documentation.
;; 
;; 	* Fixed problem where ding signals error when executing keyboard
;; 	  macro and the fact that debug-on-error is made non-nil causes
;; 	  messy problem for user.
;; 
;; Thu Aug  8 11:00:48 1991  Joe Wells  (jbw at maverick.uswest.com)
;; 
;; 	* Added more documentation at the front.  Installation
;; 	  instructions for Sun users.
;; 

;; Here are improved scrolling commands for GNU Emacs.  The functions here
;; can effectively replace scroll-up and scroll-down.
;; 
;; Installation:
;; 
;; Put this in a file named "scroll-fix.el" in the load-path of your
;; Emacs.  Byte-compile it with M-x byte-compile-file.  If you use the
;; option scroll-in-place-replace-original, where the functionality of the
;; commands scroll-up and scroll-down is replaced, you should load this
;; with require like this:
;; 
;;   (require 'scroll-fix)
;; 
;; In this case, you can use keybindings already in place for scroll-up
;; and scroll-down.
;; 
;; If you keep scroll-in-place-replace-original nil, you can also autoload
;; these functions like this:
;; 
;;   (autoload 'scroll-down-in-place "scroll-fix" nil t)
;;   (autoload 'scroll-up-in-place "scroll-fix" nil t)
;; 
;; Bind them to keys in the standard manner.  I like to use any keys
;; labelled "Page Up" and "Page Down" or "Prior" and "Next".
;; 
;; Features:
;; 
;; * All scrolling actions are now completely reversible.  By reversible,
;; I mean that by using only prefix arguments and the scrolling commands,
;; you can return the screen and the point to the *exact* original
;; configuration it was in before you started scrolling.
;; 
;; * Point (the cursor) is kept on the same line of the screen, and as
;; close to the same column as possible.  This means that when you scroll
;; back to the view you started with, point is in exactly the same place.
;; 
;; * When a scrolling action is given a numeric argument and it uses that
;; as the distance to scroll, immediately subsequent scrolling actions
;; without arguments will use the same distance.  Thus, you can
;; temporarily change the scrolling distance without having to retype the
;; argument for every command.
;; 
;; * The replacement for scroll-up will avoid leaving blank-space past the
;; end of the buffer on the screen, except when necessary to make a
;; previous scrolling action reversible.  This helps save valuable screen
;; real estate on small screens.
;; 
;; * When near the beginning or end of a buffer, these commands will
;; remember that the last scrolling action they did was not a complete
;; scroll, and will reverse it properly.
;; 
;; * When no more scrolling can be done because the beginning or end of
;; the buffer is visible, scroll-up and scroll-down will move point to the
;; end or beginning of the buffer.  This too is completely reversible.
;; 
;; * If you are in the minibuffer, and its entire contents are visible,
;; then the scrolling commands scroll the minibuffer-scroll-window
;; instead.  (The minibuffer-scroll-window is typically a completion
;; window.)  If there is no minibuffer-scroll-window, the next-window is
;; scrolled.
;; 
;; * M-x scroll-in-place will toggle between the new behavior and the old
;; behavior.
;; 
;; * Ordinarily, scroll-fix overrides the default functionality of
;; scroll-up and scroll-down.  You can unset a variable to allow keeping
;; the original functionality of scroll-up and scroll-down, and just
;; having the new functionality on the symbols scroll-up-in-place and
;; scroll-down-in-place.  (This is what I do.)  This behavior can be
;; toggled dynamically; it is not determined at load time.
;; 
;; Problems:
;; 
;; * Doesn't work properly with extremely long lines.  This has to do with
;; (current-column).  I'll fix this someday.
;; 
;; * It's hard to tell when a scrolling operation only scrolls the screen
;; partially.  Your eyes can get lost.  I started on adding an option to
;; change the behavior, but I've never really pursued it.
;; 
;; * The names scroll-up-in-place and scroll-down-in-place conflict with
;; functions in the terminal-specific file term/sun.el.  Load or autoload
;; this file using your term-setup-hook, which runs after the
;; terminal-specific file is loaded.  If you autoload, use fmakunbound on
;; the functions first:
;; 
;;   (fmakunbound 'scroll-down-in-place)
;;   (fmakunbound 'scroll-up-in-place)
;;   (autoload 'scroll-down-in-place "scroll-fix" nil t)
;;   (autoload 'scroll-up-in-place "scroll-fix" nil t)
;; 
;; If you're not using a Sun, you won't see this problem.
;; 
;; * The moving point to end-of-buffer feature can cause confusion when
;; scrolling another window and you can't see point move.  When reversing
;; direction, the first scroll might not appear to do anything because it
;; is just moving point.

;; The ideas for this package were derived from the C code in src/window.c
;; and elsewhere.  The functions in this file should always be
;; byte-compiled for speed.  Someone should rewrite this in C (as part of
;; src/window.c) for speed.

;; This package redefines scroll-up and scroll-down.  The new functions
;; are also available on scroll-up-in-place and scroll-down-in-place.  The
;; functions look at the name they are called with to determine how to
;; behave.  Thus, they may behave unreliably from programs; use
;; scroll-in-place-command directly instead.

(require 'backquote)

(defmacro abs (n)
  (`(let ((m (, n)))
      (if (< m 0) (- m) m))))

;; Jim Cotrell <rbj@dsys.icst.nbs.gov>
;; (defun same-sign (x y) (natnump (logxor x y)))

;; both negative or both non-negative
(defmacro same-sign (x y)
  (`(let ((z (, y)))
     (if (< (, x) 0)
	 (< z 0) (>= z 0)))))

(defvar scroll-in-place t
  "*Whether new enhanced scrolling is enabled.
If true, the new scrolling will be used instead of the default scrolling
when either scroll-down-in-place or scroll-up-in-place is called.  In
addition, if scroll-in-place-replace-original is also true, scroll-up and
scroll-down will exhibit the new scrolling.  This is true by default.  The
scroll-in-place command will toggle this variable for you.

The enhanced scrolling of the scroll-in-place feature makes all scrolling
actions completely reversible.  No more pounding on the arrow keys trying
to get back to your place in the buffer.  You can use the new scrolling to
move point to the beginning or the end of the buffer.  The new scrolling
also does something useful in the minibuffer\; it scrolls either the other
window or the completion window.  Try it, you'll like it.")

(defvar scroll-in-place-replace-original nil
  "*Whether scroll-up and scroll-down will call new enhanced scrolling.
If true, and scroll-in-place is true, the new scrolling will be used
instead of the default scrolling when either scroll-up or scroll-down is
called.  This is false by default.")

;; This needs alot more work *******************
(defvar scroll-in-place-eob-blank-allowed nil
  "*Whether new scrolling allows blank space to show past end of buffer.

NOT IMPLEMENTED YET.

If false, when scrolling will show the end of buffer, less than the normal
full distance is scrolled, keeping the end of buffer on the last line of
the window (but see comment next to definition of sip:eob-blank-limit).
If true, always scrolls the normal distance downward except when the end
of buffer is already shown within the window.  This is false by default.")

(defvar sip:goal-column 0)
;; Current goal column for scrolling motion.  It is the column where point
;; was at the start of current run of scrolling commands.

(defvar sip:default-motion nil)
;; Default argument to scroll-up-in-place or scroll-down-in-place, when
;; repeated with no intervening command and no argument.  This is the last
;; argument used.

(defvar sip:eob-motion nil)
;; Amount of motion to be used by next scroll-up-in-place or
;; scroll-down-in-place when reversing direction after encountering the
;; end/beginning of the buffer with no intervening command and no
;; argument.  This is the amount of vertical motion that was actually done
;; on the last scroll operation (which was less than requested, because of
;; buffer boundaries).

(defvar sip:eob-blank-limit nil)
;; This is the minimum amount of text that is required on the last
;; screen.  scroll-up-in-place will refuse to scroll any more than this.
;; Normally this is one less than the number of text lines in the window.
;; However, if a sequence of scrolling commands starts with less text on
;; the last screen, this is remembered here.

(defvar sip:eob-last-point nil)
;; Following a scroll operation that attempted to scroll past the
;; beginning or end of the buffer, point is moved to the beginning of end
;; of buffer.  This is the location of point before the move and is used
;; for reversing that move.

(defun scroll-in-place (arg)
  "Toggle the use of the new enhanced scrolling.
With argument, turn feature on if arg is positive.  See the variable
scroll-in-place for more details."
  (interactive "P")
  (setq scroll-in-place
	(if (null arg)
	    (not scroll-in-place)
	  (> (prefix-numeric-value arg) 0))))

(defun scroll-down-in-place (&optional n)
  "Scroll text of current window downward ARG lines\; or near full screen if
no ARG.  When calling from a program, supply a number as argument or nil.

See also the variable scroll-in-place.  Don't call this from a program."
  (interactive "P")
  (if (and scroll-in-place
	   (or scroll-in-place-replace-original
	       (eq this-command 'scroll-down-in-place)))
      (scroll-in-place-command n -1)
    (original-scroll-down n))
  nil)

(or (fboundp 'original-scroll-down)
    (fset 'original-scroll-down (symbol-function 'scroll-down)))
(fset 'scroll-down (symbol-function 'scroll-down-in-place))

(defun scroll-up-in-place (&optional n)
  "Scroll text of current window upward ARG lines\; or near full screen if
no ARG.  When calling from a program, supply a number as argument or nil.

See also the variable scroll-in-place.  Don't call this from a program."
  (interactive "P")
  (if (and scroll-in-place
	   (or scroll-in-place-replace-original
	       (eq this-command 'scroll-up-in-place)))
      (scroll-in-place-command n 1)
    (original-scroll-up n))
  nil)

(or (fboundp 'original-scroll-up)
    (fset 'original-scroll-up (symbol-function 'scroll-up)))
(fset 'scroll-up (symbol-function 'scroll-up-in-place))

(defun scroll-in-place-command (arg direction)
  "Scroll text of current window ARG lines in DIRECTION direction.
If ARG is null, figures out how much to scroll based on previous
scrolling, or scrolls window-height minus next-screen-context-lines.  If
ARG is '- (the symbol), scrolls window in - DIRECTION direction.
DIRECTION is either 1 or -1.  Leaves point in same row and column of
window.  If the minibuffer is the selected-window, may scroll another
window instead.  If the beginning or end of buffer is already visible, and
scrolling in that direction, will move point there instead."
  ;;(message "%s %s %s %s %s %s %s"
  ;;arg last-command this-command sip:default-motion
  ;;sip:eob-blank-limit sip:eob-motion sip:eob-last-point)
  (let* (;; For a rare bug that I can't repeat at will.
	 (original-debug-on-error debug-on-error)
	 (debug-on-error t)
	 ;; The original configuration info is only used when we scroll
	 ;; another window from the minibuffer.
	 (orig-window (selected-window))
	 ;; We need this when restoring the original configuration because
	 ;; (current-buffer) might not be (window-buffer (selected-window)),
	 ;; and select-window does a set-buffer.
	 (orig-buffer (current-buffer))
	 (window
	  ;; If in the minibuffer, make scrolling do something useful.
	  (if (and (eq orig-window (minibuffer-window))
		   (save-excursion
		     ;; Just in case we're called with the minibuffer
		     ;; window selected but some other buffer current.
		     (set-buffer (window-buffer orig-window))
		     ;; Are the entire minibuffer contents visible?
		     (and (pos-visible-in-window-p (point-max) orig-window)
			  (pos-visible-in-window-p (point-min) orig-window))))
	      (if (and minibuffer-scroll-window
		       ;; Is minibuffer-scroll-window a deleted window?
		       (window-start minibuffer-scroll-window))
		  minibuffer-scroll-window
		(next-window orig-window))
	    orig-window))
	 (height (- (window-height window)
		    (if (eq window (minibuffer-window)) 0 1)))
	 (default-lines (max 1 (- height next-screen-context-lines)))
	 (n (prefix-numeric-value arg))
	 (first-scroll
	  ;; WARNING: if you change the names of the calling functions,
	  ;; you must change this code!
	  (not (or (memq last-command '(scroll-up-in-place
					scroll-down-in-place))
		   (and scroll-in-place-replace-original
			(memq last-command '(scroll-up scroll-down))))))
	 ;; lines is going to be the number of lines that we finally
	 ;; decide to move, with negative meaning towards the
	 ;; beginning of the buffer.
	 lines
	 ;; number of lines actually moved, with negative meaning towards
	 ;; the beginning of the buffer.
	 moved)
    
    ;; Barf on zero ARG argument
    ;; Hmm ... maybe I should allow zero ARG ... what should it mean?  *******
    (and (eq arg 0)
	 (while t (signal 'args-out-of-range (list 'arg arg))))
    ;; Barf on DIRECTION not 1 or -1
    (or (memq direction '(1 -1))
	(while t (signal 'args-out-of-range (list 'direction direction))))
    
    ;; If we get an interactive argument of - (the symbol named "-"), we
    ;; treat it as though we received an argument of nil and the opposite
    ;; direction.
    (if (eq arg '-)
	(setq direction (- direction)
	      arg nil
	      n (prefix-numeric-value nil)))
    
    (unwind-protect
	(progn
	  
	  ;; If currently in minibuffer-window, scroll other window
	  (select-window window)	; does set-buffer
    
	  ;; Figure out how much vertical motion to use.  An explicit
	  ;; argument is always given precedence.  If no explicit argument
	  ;; is given, we decide based on several factors.  First, if this
	  ;; scrolling command does not follow another, ie. it is the first,
	  ;; then we use the default, calculated to leave
	  ;; next-screen-context-lines of context on the screen.  Second, we
	  ;; check if this should reverse a scrolling command that moved
	  ;; point to the end/beginning of the buffer.  Third, if an
	  ;; immediately preceding scroll command couldn't scroll full
	  ;; distance because it ran into a buffer boundary, and this is a
	  ;; scroll in the opposite direction, go back the amount that last
	  ;; command traveled.  Fourth, if following a prior scroll use the
	  ;; last explicit argument.
	  (cond ((or (numberp arg) (consp arg))
		 (setq lines n
		       sip:default-motion n
		       sip:eob-motion nil
		       sip:eob-last-point nil))
		(first-scroll
		 (setq lines default-lines
		       sip:default-motion default-lines
		       sip:eob-motion nil
		       sip:eob-last-point nil))
		(sip:eob-last-point
		 (or (bobp) (eobp)
		     (error "bad value: sip:eob-last-point: %s" sip:eob-last-point))
		 (and (eq sip:eob-last-point (point))
		      (error "bad value: sip:eob-last-point: %s" sip:eob-last-point))
		 ;; In this case, we're doing the actual motion right here.
		 (setq lines 0)
		 ;; Only do something if scrolling away from buffer boundary.
		 (and (same-sign direction (- sip:eob-last-point (point)))
		      (goto-char sip:eob-last-point)
		      (setq sip:eob-last-point nil))) ;only once
		((and sip:eob-motion
		      (not (same-sign direction sip:eob-motion)))
		 (setq lines (abs sip:eob-motion)
		       sip:eob-motion nil)) ;this must be done second
		(t
		 ;; second or later in a sequence without an explicit arg
		 (setq lines sip:default-motion)))
	  ;;sip:eob-motion nil
	  ;;sip:eob-last-point nil
	  (setq lines (* direction lines))
    
	  ;; On the first scroll command, record the current column and
	  ;; whether and where the end-of-buffer is in the window.
	  (cond (first-scroll
		 ;; TODO: The 9999 needs to be fixed for Emacs 18.56+.
		 ;; TODO: Integrate this with goal-column and
		 ;;   temporary-goal-column?
		 (setq sip:goal-column (or (and track-eol (eolp) 9999)
					   (current-column)))
		 ;; We record the number of lines of text in the window
		 ;; minus one.  We will use this later to make scrolling up
		 ;; from the end of buffer and then back down completely
		 ;; reversible.  Otherwise, the scrolling feature that
		 ;; prevents the end of buffer from ever being higher than
		 ;; the last line of the window would prevent reversibility.
		 (setq sip:eob-blank-limit
		       (if scroll-in-place-eob-blank-allowed
			   0
			 (save-excursion
			   (goto-char (window-start window))
			   (vertical-motion (1- height)))))))
    
	  ;; if point not in window, center window around point
	  (save-excursion
	    (cond ((not (pos-visible-in-window-p (point) window))
		   (vertical-motion (/ (- height) 2))
		   (set-window-start window (point)))))
	  
	  (and
	   (not (= lines 0))
	   
	   ;; Execute the scrolling motion.
	   (catch 'buffer-boundary
	     (save-excursion
	       (goto-char (window-start window))
	       (cond ((< lines 0)	; upward -- scrolling down
		      (cond ((bobp)
			     ;; The debug stuff is because ding signals an
			     ;; error when executing a keyboard macro, and
			     ;; I've got debug-on-error turned on above to
			     ;; catch a rare bug.
			     (let ((debug-on-error original-debug-on-error))
			       (ding))
			     (message (get 'beginning-of-buffer
					   'error-message))
			     (throw 'buffer-boundary t)))
		      (setq moved (vertical-motion lines)))
		     ((> lines 0)	; downward -- scrolling up
		      ;; When checking for downward motion scrolling up, we
		      ;; actually move somewhere between one and two screens
		      ;; worth of distance, to make sure that the end of
		      ;; buffer will be at least sip:eob-blank-limit lines
		      ;; down from the first line.  sip:eob-blank-limit is
		      ;; the number of lines of text after the first line
		      ;; that were in this window at the time the current
		      ;; sequence of scrolling commands started.
		      (setq moved
			    (+ (vertical-motion (+ lines
						   sip:eob-blank-limit))
			       (vertical-motion (- sip:eob-blank-limit))))
		      (cond ((< moved 1)
			     ;; See comment above.
			     (let ((debug-on-error original-debug-on-error))
			       (ding))
			     (message (get 'end-of-buffer 'error-message))
			     (throw 'buffer-boundary t))))
		     (t (error "bad value: lines: %s" lines)))
	       ;; The actual scrolling occurs here.
	       (set-window-start window (point)))
	     (if (< (abs moved) (abs lines))
		 (setq sip:eob-motion moved))
	     ;; keep point on same line of window
	     (vertical-motion moved)
	     ;; keep point on same column of window
	     (move-to-column sip:goal-column)
	     nil)
	   
	   ;; We are already at the limit of scrolling.  Move point to the
	   ;; buffer boundary instead.
	   (cond ((and (< lines 0) (not (bobp)))
		  (setq sip:eob-last-point (point))
		  (goto-char (point-min)))
		 ((and (> lines 0) (not (eobp)))
		  (setq sip:eob-last-point (point))
		  (goto-char (point-max))))))
      
      ;; Restore original selected-window and current-buffer
      (select-window orig-window)
      (set-buffer orig-buffer)))
  
  ;; Is there some other value we should return?
  nil)

(provide 'scroll-fix)
Newsgroups: gnu.emacs.help