Article View: comp.emacs
Article #9626mouse scrolling
From: Theodore A. Camus
Date: Mon, 26 Feb 1990 19:17
Date: Mon, 26 Feb 1990 19:17
64 lines
2502 bytes
2502 bytes
This may be useful to some of you.
Place the mouse one line below the cursor and shift left click;
everything moves up one. Place it two below the cursor, and it
moves two, etc.
X version :
-----------
(define-key mouse-map x-button-s-left 'x-scroll-to-cursor)
(defun x-scroll-to-cursor (arg)
(let* ((cursor-y (current-row))
(mouse-y (progn (x-mouse-set-point arg) (current-row)))
(pos (point))
(ok (cond ((< mouse-y cursor-y)
(move-to-window-line 0)
(/= (point) 1))
(t (/= (point) (point-max))))))
(cond (ok (goto-char pos)
(scroll-up (- mouse-y cursor-y))
(move-to-window-line 0)
(next-line cursor-y)
(move-to-column (- (car arg) (car (window-edges)))))
(t (goto-char pos)))))
Suntool version :
-----------------
(global-set-mouse '(text shift left) 'mouse-scroll-to-cursor)
(defun mouse-scroll-to-cursor (w x y)
(let* ((offset (current-row))
(pos (point))
(ok (cond ((< y offset)
(move-to-window-line 0)
(/= (point) 1))
(t (/= (point) (point-max))))))
(cond (ok (goto-char pos)
(scroll-up (- y offset))
(cursor-to-window-top)
(next-line offset)
(move-to-column x))
(t (goto-char pos)))))
Needed for both :
-----------------
(defun current-row ()
"Returns current row #, from screen top, from 0."
(let* ((pos (point))
(top (window-start))
(count 0))
(beginning-of-line)
(while (/= (point) top)
(forward-line -1)
(setq count (1+ count)))
(goto-char pos)
count))
CSnet: tac@cs.brown.edu Ted Camus
ARPAnet: tac%cs.brown.edu@relay.cs.net Box 1910 CS Dept
BITnet: tac@browncs.BITNET Brown University
"An ounce of example is worth a pound of theory." Providence, RI 02912
Technical Details
Message-ID:
<30704@brunix.UUCP>Path:
arc1-ca.pugleaf.net!utzoo!utgpu!jarvis.csri.toronto.edu!cs.utexas.edu!uunet!brunix!tacShow Full Headers
Complete Article Headers
Path: arc1-ca.pugleaf.net!utzoo!utgpu!jarvis.csri.toronto.edu!cs.utexas.edu!uunet!brunix!tac From: tac@cs.brown.edu (Theodore A. Camus) Newsgroups: comp.emacs Subject: mouse scrolling Message-ID: <30704@brunix.UUCP> Date: 26 Feb 90 19:17:36 GMT Sender: news@brunix.UUCP Reply-To: tac@cs.brown.edu (Theodore A. Camus) Organization: Brown University Department of Computer Science Lines: 64