🚀 go-pugleaf

	I have been using Epoch v3.2 for a while now, and have found I
make frequent use of the following.  it allows you to scroll an Epoch
window with the mouse buttons.  It is set up (by default) for a 3
button mouse, so that once invoked, you can scroll up with C-left, 
scroll down with C-right, and page ahead in the direction of scrolling 
by pressing the middle button while scrolling. 

	Comments, improvements, etc, to beck@cs.ualberta.ca (internet)
	                                beck@alberta.uucp (uucp)

	Enjoy, 
	Bob Beck

-----------------------Cut Here-----------------
;;; Copyright (C) 1990  Robert Beck
;;;
;;; Disclaimer Follows. 
;;;
;;; This file is for use with Epoch, a modified version of GNU Emacs.
;;; Requires Epoch 3.2 or later.
;;;
;;; This code is distributed in the hope that it will be useful,
;;; bute WITHOUT ANY WARRANTY. No author or distributor accepts
;;; responsibility to anyone for the consequences of using this code
;;; or for whether it serves any particular purpose or works at all,
;;; unless explicitly stated in a written agreement.
;;;
;;; Everyone is granted permission to copy, modify and redistribute
;;; this code, but only under the conditions described in the
;;; GNU Emacs General Public License, except the original author nor his
;;; agents are bound by the License in their use of this code.
;;; (These special rights for the author in no way restrict the rights of
;;;  others given in the License or this prologue)
;;; A copy of this license is supposed to have been given to you along
;;; with Epoch 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. 
;;;

;; The author of this package welcomes feedback and improvements.
;; Please mail any comments, feedback, or improvements to this package
;; to the author:
;;      Bob Beck, beck@cs.ualberta.ca (internet)
;;                beck@alberta.uucp (uucp)


;; mscroll.el contains the mscroll packge, which is meant to be used
;; as an add-on to the default epoch mouse bindings.  This is a set of
;; functions and bindings, it is NOT a new mouse handler. mscroll
;; allows you to scroll and page an epoch window using the mouse
;; buttons.  


;; Mscroll is activated with the command "mscroll" (M-x mscroll) once
;; this file has been loaded. It is normally useful to set it up as an
;; autoload. The actual button bindings and state masks for the mouse
;; are set up from user variables, which may be changed by the user
;; either in a .emacs or in the hook function.

;; To make mscroll load automatically, you should put this file in a
;; directory which is in your EMACSLOADPATH, then put the following
;; command in your .emacs file : 
;; (autoload 'mscroll "mscroll" "Mouse scrolling" t nil)

;; The default bindings for mscroll set it up for a 3 button mouse.
;; With such, it works as follows :

;; Control-left button  scrolls up while held.
;; Control-right button scrolls down while held.
;; Middle button pages ahead in the direction of scrolling, each time it
;; is hit while are scrolling.
;; Shift-left button scrolls left while held.
;; Shift-right button scrolls right while held.

;; hooks:

;; mscroll-hook : hook function for mscroll. this hook is called by
;; the mscroll command before any mouse bindings are made.

;; variables:

;; mscroll::mouse-bindings : list where each element is a list of
;; arguments to be used by global-set-mouse to bind keys to the
;; mscroll scrolling functions

;; mscroll::up, mscroll::down, mscroll::left, mscroll::right : lists
;; of state masks used by the scrolling functions to define the state
;; the mouse must be in for scrolling to occur

;; mscroll::pageup, mscroll::pagedown : lists of state modifiers which are
;; used to modify the appropriate scrolling mask to determine when
;; paging should occur.

;; mscroll::vertical-inc, mscroll::horizontal-inc : values determine
;; how much to scroll horizontally or vertically when scrolling.
;; defualt values are the same as epoch's vertical-inc and
;; horizontal-inc, these are provided to allow the button scrolling to
;; use a different value from the drag scrolling.


;; Changing mscroll's bindings:  

;;  To change the bindings in mscroll, you must change BOTH the
;;mscroll::mouse-bindings list AND any affected button mask variables.
;;Sorry, but this is necessitated by fact that binding a mouse button
;;requires different parameters than the masks returned by query-mouse.
;;An example: Suppose you wanted the mscroll upward and downward
;;scrolling keys to be bound to unmodified button1 and 3, with the
;;conventional epoch bindings moved to the controled button states. 
;;The following code fragment would accomplish this."


;;;; Change the normal epoch pointing and pasting functions to controled
;;;; buttions, put the mscroll vertical scrolling functions on the
;;;; uncontrolled buttons Note that we can just put all our rebindings
;;;; in this list.
;;  (setq mscroll::mouse-bindings '((mouse-left 0 'mscroll::scroll-up)
;;                        (mouse-middle 0 'nil)
;;			  (mouse-right 0 'mscroll::scroll-down) 
;;			  (mouse-left mouse-shift 'mscroll::scroll-left)
;;			  (mouse-right mouse-shift 'mscroll::scroll-right)
;;			  (mouse-left mouse-control 'start-mouse-drag)
;;			  (mouse-left mouse-control-up 'end-mouse-drag)
;;			  (mouse-middle mouse-control 'mouse::paste-cut-buffer)
;;			  (mouse-right mouse-control 'extend-mouse-drag)
;;			  (mouse-right mouse-control-up 'end-mouse-drag)))

;; Since we changed two mscroll keys, we must change the masks associated with 
;; their functions. 

;;  (setq mscroll::up '(mouse1-mask))
;;  (setq mscroll::down '(mouse3-mask))
;;  (mscroll)



(require 'mouse)
(provide 'mscroll)

(defvar mscroll::mouse-bindings '((mouse-left mouse-control
'mscroll::scroll-up) (mouse-right mouse-control 'mscroll::scroll-down)
(mouse-left mouse-shift 'mscroll::scroll-left) (mouse-right
mouse-shift 'mscroll::scroll-right)) "*list where each element of the
form (button modifier function) used as arguments to global-set-mouse
to set the mouse bindings.")

(defvar mscroll::up '(mouse1-mask control-mod-mask) "*list of state
masks, which when added together represent the state the mouse must be
in for upward scrolling to take place.")

(defvar mscroll::down '(mouse3-mask control-mod-mask) "*list of state
masks, which when added together represent the state the mouse must be
in for downward scrolling to take place.")

(defvar mscroll::right '(mouse3-mask shift-mod-mask) "*list of state
masks, which when added together represent the state the mouse must be
in for right scrolling to take place.")

(defvar mscroll::left '(mouse1-mask shift-mod-mask) "*list of state
masks, which when added together represent the state the mouse must be
in for left scrolling to take place.")

(defvar mscroll::pageup '(mouse2-mask) "*list of state masks, which
when added to mscroll::up represent the state the mouse must be in to
page up during upward scrolling")

(defvar mscroll::pagedown '(mouse2-mask) "*list of state masks, which,
when added to mscroll::down represent the state the mouse must be in
to page down during downward scrolling")

(defvar mscroll::vertical-inc vertical-drag-inc "*number of lines to
scroll when scrolling up or down with the mouse buttons. defaults to
the value of vertical-drag-inc")

(defvar mscroll::horizontal-inc horizontal-drag-inc "*number of lines to
scroll when scrolling left or right with the mouse buttons. defaults
to the value of horizontal-scroll-inc")

(defun mscroll::sum (list)
  (let ((num (car-safe list)))
    (if num 
	(+ (eval num) (mscroll::sum (cdr-safe list)))
      0)))

(defun mscroll::check-mouse (state &optional state2)
  "Returns t if mouse is in state "state", or "state2" nil otherwise."
  (let ((pos (query-mouse)))
    (or (= (mscroll::sum state) (elt pos 2))
	(if state2
	    (= (mscroll::sum state2) (elt pos 2))))))

(defun mscroll::scroll-up (fred)
  (let ((page t))
    (while (mscroll::check-mouse mscroll::up 
				 (cons (mscroll::sum mscroll::pageup)
				       mscroll::up))
      (progn
	(if (mscroll::check-mouse (cons (mscroll::sum mscroll::pageup)
					mscroll::up))
	    (progn
	      (if page
		  (progn
		    (scroll-up)
		    (setq page (not page)))
		(scroll-up mscroll::vertical-inc)))
	  (progn
	    (scroll-up mscroll::vertical-inc)
	    (setq page t)))
	(epoch::redisplay-screen)))))

(defun mscroll::scroll-down (fred)
  (let ((page t))
    (while (mscroll::check-mouse mscroll::down
				 (cons (mscroll::sum mscroll::pagedown)
				       mscroll::down))
      (progn
	(if  (mscroll::check-mouse (cons (mscroll::sum mscroll::pagedown)
					 mscroll::down))
	    (progn
	      (if page
		  (progn
		    (scroll-down)
		    (setq page (not page)))
		(scroll-down mscroll::vertical-inc)))
	  (progn
	    (scroll-down mscroll::vertical-inc)
	    (setq page t)))
	(epoch::redisplay-screen)))))

(defun mscroll::scroll-right (fred)
  (while (mscroll::check-mouse mscroll::right)
    (progn
      (scroll-right mscroll::horizontal-inc)
      (epoch::redisplay-screen))))

(defun mscroll::scroll-left (fred)
  (while (mscroll::check-mouse mscroll::left)
    (progn
      (scroll-left mscroll::horizontal-inc)
      (epoch::redisplay-screen))))

(defun mscroll::bind-mouse (bindings) 
  "bind the global mouse keys as specified in the list bindings, which
should be the same format as mscroll::mouse-bindings"
  (let ((args (car-safe bindings)))
    (if args
	(progn
	  (global-set-mouse (eval (elt args 0)) (eval (elt args 1))
			    (eval (elt args 2)))
	  (mscroll::bind-mouse (cdr-safe bindings))))))

(defun mscroll ()
  "set up the mscroll package and bind the mouse to allow scrolling
 and paging of epoch windows using the mouse buttons.

 The default bindings for mscroll set it up for a 3 button mouse.
 With such, it works as follows :

 Control-left button  scrolls up while held.
 Control-right button scrolls down while held.
 Middle button pages ahead in the direction of scrolling, each time it
 is hit while are scrolling.
 Shift-left button scrolls left while held.
 Shift-right button scrolls right while held.

 hooks:

 mscroll-hook : hook function for mscroll. this hook is called by
 the mscroll command before any mouse bindings are made.

 variables:

 mscroll::mouse-bindings : list where each element is a list of
 arguments to be used by global-set-mouse to bind keys to the
 mscroll scrolling functions

 mscroll::up, mscroll::down, mscroll::left, mscroll::right : lists
 of state masks used by the scrolling functions to define the state
 the mouse must be in for scrolling to occur

 mscroll::pageup, mscroll::pagedown : lists of state masks which are
 used to modify the appropriate scrolling mask to determine when
 paging should occur.

 mscroll::vertical-inc, mscroll::horizontal-inc : values determine
 how much to scroll horizontally or vertically when scrolling.
 defualt values are the same as epoch's vertical-inc and
 horizontal-inc, these are provided to allow the button scrolling to
 use a different value from the drag scrolling.

Changing mscroll's bindings:  

  To change the bindings in mscroll, you must change BOTH the
mscroll::mouse-bindings list AND any affected button mask variables.
Sorry, but this is necessitated by fact that binding a mouse button
requires different parameters than the masks returned by query-mouse.
An example: Suppose you wanted the mscroll upward and downward
scrolling keys to be bound to unmodified button1 and 3, with the
conventional epoch bindings moved to the controled button states. 
The following code fragment would accomplish this.

;; Change the normal epoch pointing and pasting functions to controled
;; buttions, put the mscroll vertical scrolling functions on the
;; uncontrolled buttons Note that we can just put all our rebindings
;; in this list.
  (setq mscroll::mouse-bindings '((mouse-left 0 'mscroll::scroll-up)
                          (mouse-middle 0 'nil)
			  (mouse-right 0 'mscroll::scroll-down) 
			  (mouse-left mouse-shift 'mscroll::scroll-left)
			  (mouse-right mouse-shift 'mscroll::scroll-right)
			  (mouse-left mouse-control 'start-mouse-drag)
			  (mouse-left mouse-control-up 'end-mouse-drag)
			  (mouse-middle mouse-control 'mouse::paste-cut-buffer)
			  (mouse-right mouse-control 'extend-mouse-drag)
			  (mouse-right mouse-control-up 'end-mouse-drag)))

;; Since we changed two mscroll keys, we must change the masks associated with 
;; their functions. 

  (setq mscroll::up '(mouse1-mask))
  (setq mscroll::down '(mouse3-mask))
  (mscroll)
"
  (interactive)
  (run-hooks 'mscroll-hook)
  (mscroll::bind-mouse mscroll::mouse-bindings))



--
 Bob Beck, beck@cs.ualberta.ca  University of Alberta, Edmonton, Alta. Canada.