Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
branch: master
Fetching contributors…

Cannot retrieve contributors at this time

201 lines (176 sloc) 6.952 kb
;; safescrollmouse.el: Adds a timeout mechanism to scroll mice to prevent
;; accidental button-2 presses
;;
;; $Id: safescrollmouse.el,v 1.5 2002/11/23 22:01:50 bradym Exp $
;;
;; Motivation:
;; -----------
;;
;; Mice with scrolls wheels are nice since you can use the scroll wheel to
;; quickly navigate through a document. However, on most mice, the scroll
;; wheel does double duty as the middle mouse button. If one isn't
;; sufficiently careful while scrolling, inadvertant button presses can occur,
;; and in X environments, this results in text getting pasted in various
;; bits of your document as you're scrolling around.
;;
;; This library is pretty simple. It wraps around mwheel, tracking when
;; the various mouse events occur. If a middle button push occurs to soon
;; after a scrolling event, it assumes it was accidental and ignores it.
;;
;; This library does no other changing of how the mouse wheel works. To
;; configure what the scroll buttons do, configure mwheel in the usual way.
;;
;; Operation:
;; ----------
;;
;; 1. ssm-mouse-scroll-time-threshold is the time in milliseconds necessary
;; between a mouse scroll event (scrolling the mouse scroll wheel up or
;; down) and a middle button press event. Tweak according to your likes.
;;
;; 2. (load "safescrollmouse")
;;
;; 3. (safescrollmouse-install)
;;
;; Dependancies:
;; -------------
;;
;; This file requires mwheel.
;; This file only runs in xemacs 21 or later.
;;
;; Author:
;; -------
;;
;; Please send comments, criticisms, and suggestions to:
;;
;; Brady Montz (bradym@balestra.org)
;;
;; Copyright:
;; ----------
;;
;; Copyright (C) 2002 Brady Montz
;;
;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the GNU General Public License
;; as published by the Free Software Foundation; either version 2
;; of the License, or (at your option) any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, write to the Free Software
;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA
(defconst safescrollmouse-version "1.0.1")
;; Vars describing your mouse
(defvar ssm-mouse-scroll-roll-buttons '(4 5)
"Defines which button events are sent by scrolling a mouse scrollwheel")
(defvar ssm-mouse-not-scroll-roll-buttons '(1 2 3)
"Defines which button events are sent by pressing mouse buttons")
(defvar ssm-mouse-scroll-wheel-button 2
"Defines the button event sent by pressing the scroll wheel")
(defvar ssm-scrolling-keys
'([(button4)] [(shift button4)] [(control button4)]
[(button5)] [(shift button5)] [(control button5)])
"A list of key events generated by scrolling the mouse wheel")
;; Vars the user may like to tweak
(defvar ssm-mouse-scroll-time-threshold 500
"If a ssm-mouse-scroll-wheel-button press occurs within this many
milliseconds of a scroll event, it is ignored")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Misc support stuff
(defvar ssm-log-debug nil
"When set, debug traces are written to the *debug* buffer")
(autoload 'mwheel-scroll "mwheel" "Enable mouse wheel support.")
(defvar ssm-mouse-4-hook nil)
(defvar ssm-mouse-5-hook nil)
(defvar ssm-last-relevant-event nil)
(defun ssm-scroll-func-4 (event)
(ssm-debug "scrolling")
(ignore-errors (mwheel-scroll event))
; (scroll-down-command)
)
(defun ssm-scroll-func-5 (event)
(ssm-debug "scrolling")
(ignore-errors (mwheel-scroll event))
; (scroll-down-command)
)
(add-hook 'ssm-mouse-4-hook 'ssm-scroll-func-4)
(add-hook 'ssm-mouse-5-hook 'ssm-scroll-func-5)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Debug support
(defun ssm-debug (string)
(when ssm-log-debug
(save-excursion
(let* ((buffer (get-buffer-create "*debug*"))
(window (get-buffer-window buffer)))
(if window
(select-window window))
(set-buffer buffer)
(goto-char (point-max))
(insert (concat string "\n"))
(goto-char (point-max))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; The main stuff
(defun ssm-mouse-scroll-roll-p (event)
(and event
(memq (event-button event) ssm-mouse-scroll-roll-buttons)))
(defun ssm-mouse-scroll-wheel-click-p (event)
(and event
(eq (event-button event) ssm-mouse-scroll-wheel-button)))
(defun ssm-event-diff-within-threshold (event1 event2 threshold)
(and event1
event2
(< (abs (- (event-timestamp event1) (event-timestamp event2)))
threshold)))
(defun ssm-currently-scrolling-p (event)
(and (ssm-event-diff-within-threshold event ssm-last-relevant-event
ssm-mouse-scroll-time-threshold)
(ssm-mouse-scroll-roll-p ssm-last-relevant-event)))
(defun ssm-currently-pasting-p (event)
(and (ssm-event-diff-within-threshold event ssm-last-relevant-event
ssm-mouse-scroll-time-threshold)
(ssm-mouse-scroll-wheel-click-p ssm-last-relevant-event)))
(defun ssm-accept-event-p (event)
(let ((return-value
(cond ((ssm-currently-scrolling-p event)
(not (ssm-mouse-scroll-wheel-click-p event)))
((ssm-currently-pasting-p event)
(not (ssm-mouse-scroll-roll-p event)))
(t t)))
(event-button-num (event-button event)))
(when (and return-value
(or (memq event-button-num ssm-mouse-scroll-roll-buttons)
(eq event-button-num ssm-mouse-scroll-wheel-button)))
(setq ssm-last-relevant-event (copy-event event)))
(if return-value
(ssm-debug (format "accepting event: %d" event-button-num))
(ssm-debug (format "ignoring event: %d" event-button-num)))
return-value))
(defun ssm-event-hook (event &optional click-count)
(interactive "e")
(if (ssm-accept-event-p event)
(ssm-dispatch event)
t))
(defun ssm-dispatch (event)
(ssm-debug (format "dispatching button %d" (event-button event)))
(case (event-button event)
(4 (run-hook-with-args 'ssm-mouse-4-hook event))
(5 (run-hook-with-args 'ssm-mouse-5-hook event))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Functions exported to the user
(defun safescrollmouse-install ()
"Enable mouse wheel support."
(interactive)
(let ((keys ssm-scrolling-keys))
(ignore-errors
(while keys
(define-key global-map (car keys) 'ssm-event-hook)
(setq keys (cdr keys)))))
(add-hook 'mouse-track-down-hook 'ssm-event-hook)
(add-hook 'mouse-track-click-hook 'ssm-event-hook))
Jump to Line
Something went wrong with that request. Please try again.