jbw@bucsb.UUCP (Joe Wells) (12/03/88)
Here are improved scrolling commands for GNU Emacs. The functions
here can effectively replace scroll-up and scroll-down.
They provide a superior scrolling capability, because 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.
These scrolling commands keep point on the same line of the screen,
and on (or near) the same column.
If a scrolling action is given a numeric argument, it will use that as
the distance to scroll. Immediately subsequent scrolling actions
without arguments will use the same distance.
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.
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.
So, put these in a file, bind to keys of your choice, and enjoy!
--
Joe Wells
INTERNET: jbw%bucsf.bu.edu@bu-it.bu.edu
UUCP: ...!harvard!bu-cs!bucsf!jbw
-------------------------------cut here---------------------------------
;; Improved window scrolling commands.
;; Copyright (C) 1988 Free Software Foundation, Inc.
;; This file is not officially part of GNU Emacs, but is being donated
;; to the Free Software Foundation.
;; GNU Emacs 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 Emacs General Public
;; License for full details.
;; Everyone is granted permission to copy, modify and redistribute
;; GNU Emacs, but only under the conditions described in the
;; GNU Emacs 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.
;; Author: Joe Wells
;; jbw%bucsf.bu.edu@bu-it.bu.edu (school year)
;; joew%uswest@boulder.colorado.edu (summer)
;; The ideas for this package were derived from the C code in
;; src/window.c and elsewhere. The names of the functions conflict
;; with names in lisp/term/sun.el. If someone can think of better
;; names, send me a suggestion. The functions in this file should
;; always be byte-compiled for speed. The functions really don't know
;; what to do with an argument of '-, which results from C-u - or ESC
;; -. I could use some suggestions on that also.
(require 'backquote)
(defmacro abs (n)
(`(let ((m (, n)))
(if (< m 0) (- m) m))))
(defmacro same-sign (x y)
(`(let ((z (, y)))
(if (< (, x) 0)
(< z 0) (>= z 0)))))
(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 scroll-up-in-place or
scroll-down-in-place when repeated after hitting 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 line in the window.
However, if a sequence of scrolling commands starts with less text on
the last screen, this is remembered here.")
(defun scroll-down-in-place (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.
Leaves point in same row and column of window."
(interactive "P")
(scroll-in-place-command n -1)
nil)
(defun scroll-up-in-place (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.
Leaves point in same row and column of window."
(interactive "P")
(scroll-in-place-command n 1)
nil)
(defun scroll-in-place-command (arg direction)
"Scroll text of current window ARG lines in DIRECTION direction. If ARG
is null, scrolls almost entire window. If ARG is '-, scrolls window in
- DIRECTION direction. DIRECTION is either 1 or -1. Leaves point in same
row and column of window."
;; (message "%s %s %s %s %s %s"
;; last-command this-command arg sip:default-motion
;; sip:eob-motion sip:eob-blank-limit)
(let* ((window (selected-window))
(height (- (window-height window)
(if (eq window (minibuffer-window)) 0 1)))
(lines (- height next-screen-context-lines))
(n (prefix-numeric-value arg))
(first-scroll
(not (memq last-command '(scroll-down-in-place scroll-up-in-place))))
moved)
;; Barf on zero argument
(and (numberp arg) (zerop arg) (while t (signal 'args-out-of-range arg)))
;; Figure out how much vertical motion to use. An explicit argument
;; is always given precedence. If a immediately prior scroll ran
;; into a buffer boundary, and didn't go full distance, and this is
;; a scroll in the opposite direction, go back the amount last
;; traveled. (Man is that a confusing sentence!) Otherwise, if
;; following a prior scroll use the last explicit argument.
(cond ((or (numberp arg) (consp arg))
(setq sip:default-motion n)
(setq sip:eob-motion nil)
(setq lines n))
((eq arg '-) ;needs more work
(setq lines (- lines)))
(first-scroll
(setq sip:default-motion lines)
(setq sip:eob-motion nil))
((and sip:eob-motion
(not (same-sign direction sip:eob-motion)))
(setq lines (abs sip:eob-motion))
(setq sip:eob-motion nil))
(t ;in sequence w/o arg ...
(setq lines sip:default-motion)))
(cond (first-scroll
(setq sip:goal-column (or (and track-eol (eolp) 9999)
(current-column)))
(setq sip:eob-blank-limit
(save-excursion
(goto-char (window-start window))
(vertical-motion (1- height))))))
(setq lines (* direction lines))
;; 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)))))
(catch 'foo
(save-excursion
(goto-char (window-start window))
(cond ((< lines 0) ; upward -- scrolling down
(cond ((bobp)
(ding)
(message (get 'beginning-of-buffer 'error-message))
(throw 'foo nil)))
(setq moved (vertical-motion lines)))
((> lines 0) ; downward -- scrolling up
(setq moved (+ (vertical-motion (+ lines sip:eob-blank-limit))
(vertical-motion (- sip:eob-blank-limit))))
(cond ((< moved 1)
(ding)
(message (get 'end-of-buffer 'error-message))
(throw 'foo nil))))
(t (error "Impossible zero value")))
(set-window-start window (point)))
(if (< (abs moved) (abs lines))
(setq sip:eob-motion moved))
(vertical-motion moved))) ;keep point on same window line
(move-to-column sip:goal-column))
(provide 'scroll-in-place)