Permalink
Browse files

Sun May 10 22:53:18 CEST 2009 update

  • Loading branch information...
0 parents commit 3415a598366d00643d10c852a38003afb9c58a07 @tarsius tarsius committed May 10, 2009
Showing with 200 additions and 0 deletions.
  1. +200 −0 safescrollmouse.el
@@ -0,0 +1,200 @@
+;; 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))

0 comments on commit 3415a59

Please sign in to comment.