NetNews Usenet Archive 1993 #1/NN_1993_1.iso/spool/alt/lucidem/help/838

Text File | 1993-01-05 | 9.2 KB | 231 lines

x-gateway: rodan.UU.NET from help-lucid-emacs to alt.lucid-emacs.help; Tue, 5 Jan 1993 09:48:55 EST
From: [e-mail] (Amir J Katz)
Message-ID: <[e-mail]>
Subject: scroll-in-place
Organization: SEE Technologies Ltd.
Reply-To: [e-mail]
X-Mailer: ELM [version 2.3 PL11]
Date: Tue, 5 Jan 1993 14:48:57 GMT
Newsgroups: alt.lucid-emacs.help
Path: sparky!uunet!wendy-fate.uu.net!help-lucid-emacs
Sender: [e-mail]
Lines: 217

Four years ago, an excellent package was posted to gnu.emacs.sources by Joe
Wells, then at Boston U, which solves the problem of scroll-page up/down not
returning to the same point. It works fine under emacs 18.x.

However, Under Lucid 19.3, using these modified scroll up/down functions
destroys the mark. Thus, when copying areas spanning more than a screenful,
the generic C-v/M-v must again be used.

Has anyone fixed that for Lucid Emacs? This is way above my lisp skills.
I'm enclosing the package below, so a kind soul may modify it for lemacs.

TIA,
    Amir

;; Date-Received: 3 Dec 88 16:05:14 GMT
;; Reply-To: [e-mail] (Joe Wells)
;; Organization: Boston Univ Comp. Sci.
;;
;; 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: [e-mail]
;; 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
;; [e-mail] (school year)
;; [e-mail] (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)

--
/* ----------------------------------------------------------- */
/*  Amir J. Katz             |   [e-mail]           */
/*  System Specialist        |   Voice:  [phone]        */
/*  SEE Technologies Ltd.    |   Fax:    [phone]        */
/*  ....... To Boldly Go Where No One Has Hacked Before....... */