annotate lisp/mwheel.el @ 46066:99487f98aaa7

(mouse-wheel-change-button): Deactivate before changing. (mouse-wheel-up-button, mouse-wheel-down-button): Obsolete. (mouse-wheel-up-event, mouse-wheel-down-event): New vars. (mouse-wheel-follow-mouse): Change default to t. (mwheel-event-button): Return the basic event symbol. (mwheel-scroll): Work with non-mouse events. (mouse-wheel-mode): Use the new vars. (mwheel-install): Obey `uninstall'.
author Stefan Monnier <monnier@iro.umontreal.ca>
date Thu, 27 Jun 2002 21:45:42 +0000
parents 5133c42d55cc
children b0e4184605e5
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
26398
7eb699cb9ef2 Initial import from perry
William M. Perry <wmperry@aventail.com>
parents:
diff changeset
1 ;;; mwheel.el --- Mouse support for MS intelli-mouse type mice
7eb699cb9ef2 Initial import from perry
William M. Perry <wmperry@aventail.com>
parents:
diff changeset
2
46066
99487f98aaa7 (mouse-wheel-change-button): Deactivate before changing.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 46001
diff changeset
3 ;; Copyright (C) 1998,2000,2001,2002 Free Software Foundation, Inc.
26398
7eb699cb9ef2 Initial import from perry
William M. Perry <wmperry@aventail.com>
parents:
diff changeset
4 ;; Maintainer: William M. Perry <wmperry@gnu.org>
7eb699cb9ef2 Initial import from perry
William M. Perry <wmperry@aventail.com>
parents:
diff changeset
5 ;; Keywords: mouse
7eb699cb9ef2 Initial import from perry
William M. Perry <wmperry@aventail.com>
parents:
diff changeset
6
26410
55a234a9fe88 Fix copyright notice. Don't require 'cl at run time.
Gerd Moellmann <gerd@gnu.org>
parents: 26398
diff changeset
7 ;; This file is part of GNU Emacs.
26398
7eb699cb9ef2 Initial import from perry
William M. Perry <wmperry@aventail.com>
parents:
diff changeset
8
26410
55a234a9fe88 Fix copyright notice. Don't require 'cl at run time.
Gerd Moellmann <gerd@gnu.org>
parents: 26398
diff changeset
9 ;; GNU Emacs is free software; you can redistribute it and/or modify
55a234a9fe88 Fix copyright notice. Don't require 'cl at run time.
Gerd Moellmann <gerd@gnu.org>
parents: 26398
diff changeset
10 ;; it under the terms of the GNU General Public License as published by
26398
7eb699cb9ef2 Initial import from perry
William M. Perry <wmperry@aventail.com>
parents:
diff changeset
11 ;; the Free Software Foundation; either version 2, or (at your option)
7eb699cb9ef2 Initial import from perry
William M. Perry <wmperry@aventail.com>
parents:
diff changeset
12 ;; any later version.
7eb699cb9ef2 Initial import from perry
William M. Perry <wmperry@aventail.com>
parents:
diff changeset
13
26410
55a234a9fe88 Fix copyright notice. Don't require 'cl at run time.
Gerd Moellmann <gerd@gnu.org>
parents: 26398
diff changeset
14 ;; GNU Emacs is distributed in the hope that it will be useful,
55a234a9fe88 Fix copyright notice. Don't require 'cl at run time.
Gerd Moellmann <gerd@gnu.org>
parents: 26398
diff changeset
15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
55a234a9fe88 Fix copyright notice. Don't require 'cl at run time.
Gerd Moellmann <gerd@gnu.org>
parents: 26398
diff changeset
16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
55a234a9fe88 Fix copyright notice. Don't require 'cl at run time.
Gerd Moellmann <gerd@gnu.org>
parents: 26398
diff changeset
17 ;; GNU General Public License for more details.
26398
7eb699cb9ef2 Initial import from perry
William M. Perry <wmperry@aventail.com>
parents:
diff changeset
18
7eb699cb9ef2 Initial import from perry
William M. Perry <wmperry@aventail.com>
parents:
diff changeset
19 ;; You should have received a copy of the GNU General Public License
26410
55a234a9fe88 Fix copyright notice. Don't require 'cl at run time.
Gerd Moellmann <gerd@gnu.org>
parents: 26398
diff changeset
20 ;; along with GNU Emacs; see the file COPYING. If not, write to the
26398
7eb699cb9ef2 Initial import from perry
William M. Perry <wmperry@aventail.com>
parents:
diff changeset
21 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
7eb699cb9ef2 Initial import from perry
William M. Perry <wmperry@aventail.com>
parents:
diff changeset
22 ;; Boston, MA 02111-1307, USA.
7eb699cb9ef2 Initial import from perry
William M. Perry <wmperry@aventail.com>
parents:
diff changeset
23
7eb699cb9ef2 Initial import from perry
William M. Perry <wmperry@aventail.com>
parents:
diff changeset
24 ;;; Commentary:
7eb699cb9ef2 Initial import from perry
William M. Perry <wmperry@aventail.com>
parents:
diff changeset
25
7eb699cb9ef2 Initial import from perry
William M. Perry <wmperry@aventail.com>
parents:
diff changeset
26 ;; This code will enable the use of the infamous 'wheel' on the new
7eb699cb9ef2 Initial import from perry
William M. Perry <wmperry@aventail.com>
parents:
diff changeset
27 ;; crop of mice. Under XFree86 and the XSuSE X Servers, the wheel
7eb699cb9ef2 Initial import from perry
William M. Perry <wmperry@aventail.com>
parents:
diff changeset
28 ;; events are sent as button4/button5 events.
7eb699cb9ef2 Initial import from perry
William M. Perry <wmperry@aventail.com>
parents:
diff changeset
29
7eb699cb9ef2 Initial import from perry
William M. Perry <wmperry@aventail.com>
parents:
diff changeset
30 ;; I for one would prefer some way of converting the button4/button5
7eb699cb9ef2 Initial import from perry
William M. Perry <wmperry@aventail.com>
parents:
diff changeset
31 ;; events into different event types, like 'mwheel-up' or
7eb699cb9ef2 Initial import from perry
William M. Perry <wmperry@aventail.com>
parents:
diff changeset
32 ;; 'mwheel-down', but I cannot find a way to do this very easily (or
7eb699cb9ef2 Initial import from perry
William M. Perry <wmperry@aventail.com>
parents:
diff changeset
33 ;; portably), so for now I just live with it.
7eb699cb9ef2 Initial import from perry
William M. Perry <wmperry@aventail.com>
parents:
diff changeset
34
7eb699cb9ef2 Initial import from perry
William M. Perry <wmperry@aventail.com>
parents:
diff changeset
35 ;; To enable this code, simply put this at the top of your .emacs
7eb699cb9ef2 Initial import from perry
William M. Perry <wmperry@aventail.com>
parents:
diff changeset
36 ;; file:
7eb699cb9ef2 Initial import from perry
William M. Perry <wmperry@aventail.com>
parents:
diff changeset
37 ;;
7eb699cb9ef2 Initial import from perry
William M. Perry <wmperry@aventail.com>
parents:
diff changeset
38 ;; (mwheel-install)
7eb699cb9ef2 Initial import from perry
William M. Perry <wmperry@aventail.com>
parents:
diff changeset
39
7eb699cb9ef2 Initial import from perry
William M. Perry <wmperry@aventail.com>
parents:
diff changeset
40 ;;; Code:
7eb699cb9ef2 Initial import from perry
William M. Perry <wmperry@aventail.com>
parents:
diff changeset
41
7eb699cb9ef2 Initial import from perry
William M. Perry <wmperry@aventail.com>
parents:
diff changeset
42 (require 'custom)
7eb699cb9ef2 Initial import from perry
William M. Perry <wmperry@aventail.com>
parents:
diff changeset
43
38582
96ca8702243e (mouse-wheel-down-button, mouse-wheel-up-button):
Gerd Moellmann <gerd@gnu.org>
parents: 33227
diff changeset
44 ;; Setter function for mouse-button user-options. Switch Mouse Wheel
96ca8702243e (mouse-wheel-down-button, mouse-wheel-up-button):
Gerd Moellmann <gerd@gnu.org>
parents: 33227
diff changeset
45 ;; mode off and on again so that the old button is unbound and
96ca8702243e (mouse-wheel-down-button, mouse-wheel-up-button):
Gerd Moellmann <gerd@gnu.org>
parents: 33227
diff changeset
46 ;; new button is bound to mwheel-scroll.
96ca8702243e (mouse-wheel-down-button, mouse-wheel-up-button):
Gerd Moellmann <gerd@gnu.org>
parents: 33227
diff changeset
47
96ca8702243e (mouse-wheel-down-button, mouse-wheel-up-button):
Gerd Moellmann <gerd@gnu.org>
parents: 33227
diff changeset
48 (defun mouse-wheel-change-button (var button)
46066
99487f98aaa7 (mouse-wheel-change-button): Deactivate before changing.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 46001
diff changeset
49 (let ((active mouse-wheel-mode))
99487f98aaa7 (mouse-wheel-change-button): Deactivate before changing.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 46001
diff changeset
50 ;; Deactivate before changing the setting.
99487f98aaa7 (mouse-wheel-change-button): Deactivate before changing.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 46001
diff changeset
51 (when active (mouse-wheel-mode -1))
99487f98aaa7 (mouse-wheel-change-button): Deactivate before changing.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 46001
diff changeset
52 (set-default var button)
99487f98aaa7 (mouse-wheel-change-button): Deactivate before changing.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 46001
diff changeset
53 (when active (mouse-wheel-mode 1))))
38582
96ca8702243e (mouse-wheel-down-button, mouse-wheel-up-button):
Gerd Moellmann <gerd@gnu.org>
parents: 33227
diff changeset
54
96ca8702243e (mouse-wheel-down-button, mouse-wheel-up-button):
Gerd Moellmann <gerd@gnu.org>
parents: 33227
diff changeset
55 (defcustom mouse-wheel-down-button 4
46066
99487f98aaa7 (mouse-wheel-change-button): Deactivate before changing.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 46001
diff changeset
56 "Obsolete. Use `mouse-wheel-down-event'.")
99487f98aaa7 (mouse-wheel-change-button): Deactivate before changing.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 46001
diff changeset
57 (defcustom mouse-wheel-down-event
99487f98aaa7 (mouse-wheel-change-button): Deactivate before changing.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 46001
diff changeset
58 ;; In the latest versions of XEmacs, we could just use mouse-%s as well.
99487f98aaa7 (mouse-wheel-change-button): Deactivate before changing.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 46001
diff changeset
59 (intern (format (if (featurep 'xemacs) "button%s" "mouse-%s")
99487f98aaa7 (mouse-wheel-change-button): Deactivate before changing.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 46001
diff changeset
60 mouse-wheel-down-button))
99487f98aaa7 (mouse-wheel-change-button): Deactivate before changing.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 46001
diff changeset
61 "Event used for scrolling down."
38582
96ca8702243e (mouse-wheel-down-button, mouse-wheel-up-button):
Gerd Moellmann <gerd@gnu.org>
parents: 33227
diff changeset
62 :group 'mouse
46066
99487f98aaa7 (mouse-wheel-change-button): Deactivate before changing.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 46001
diff changeset
63 :type 'symbol
38582
96ca8702243e (mouse-wheel-down-button, mouse-wheel-up-button):
Gerd Moellmann <gerd@gnu.org>
parents: 33227
diff changeset
64 :set 'mouse-wheel-change-button)
96ca8702243e (mouse-wheel-down-button, mouse-wheel-up-button):
Gerd Moellmann <gerd@gnu.org>
parents: 33227
diff changeset
65
96ca8702243e (mouse-wheel-down-button, mouse-wheel-up-button):
Gerd Moellmann <gerd@gnu.org>
parents: 33227
diff changeset
66 (defcustom mouse-wheel-up-button 5
46066
99487f98aaa7 (mouse-wheel-change-button): Deactivate before changing.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 46001
diff changeset
67 "Obsolete. Use `mouse-whell-up-event'.")
99487f98aaa7 (mouse-wheel-change-button): Deactivate before changing.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 46001
diff changeset
68 (defcustom mouse-wheel-up-event
99487f98aaa7 (mouse-wheel-change-button): Deactivate before changing.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 46001
diff changeset
69 ;; In the latest versions of XEmacs, we could just use mouse-%s as well.
99487f98aaa7 (mouse-wheel-change-button): Deactivate before changing.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 46001
diff changeset
70 (intern (format (if (featurep 'xemacs) "button%s" "mouse-%s")
99487f98aaa7 (mouse-wheel-change-button): Deactivate before changing.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 46001
diff changeset
71 mouse-wheel-up-button))
99487f98aaa7 (mouse-wheel-change-button): Deactivate before changing.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 46001
diff changeset
72 "Event used for scrolling down."
38582
96ca8702243e (mouse-wheel-down-button, mouse-wheel-up-button):
Gerd Moellmann <gerd@gnu.org>
parents: 33227
diff changeset
73 :group 'mouse
46066
99487f98aaa7 (mouse-wheel-change-button): Deactivate before changing.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 46001
diff changeset
74 :type 'symbol
38582
96ca8702243e (mouse-wheel-down-button, mouse-wheel-up-button):
Gerd Moellmann <gerd@gnu.org>
parents: 33227
diff changeset
75 :set 'mouse-wheel-change-button)
96ca8702243e (mouse-wheel-down-button, mouse-wheel-up-button):
Gerd Moellmann <gerd@gnu.org>
parents: 33227
diff changeset
76
45994
65253ed28734 Undo last patch for now.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 45947
diff changeset
77 (defcustom mouse-wheel-scroll-amount '(5 ((shift) . 1) ((control) . nil))
26398
7eb699cb9ef2 Initial import from perry
William M. Perry <wmperry@aventail.com>
parents:
diff changeset
78 "Amount to scroll windows by when spinning the mouse wheel.
46001
5133c42d55cc (mouse-wheel-scroll-amount, mwheel-scroll, mouse-wheel-mode):
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 45994
diff changeset
79 This is an alist mapping the modifier key to the amount to scroll when
5133c42d55cc (mouse-wheel-scroll-amount, mwheel-scroll, mouse-wheel-mode):
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 45994
diff changeset
80 the wheel is moved with the modifier key depressed.
5133c42d55cc (mouse-wheel-scroll-amount, mwheel-scroll, mouse-wheel-mode):
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 45994
diff changeset
81 Elements of the list have the form (MODIFIERS . AMOUNT) or just AMOUNT if
5133c42d55cc (mouse-wheel-scroll-amount, mwheel-scroll, mouse-wheel-mode):
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 45994
diff changeset
82 MODIFIERS is nil.
26398
7eb699cb9ef2 Initial import from perry
William M. Perry <wmperry@aventail.com>
parents:
diff changeset
83
46001
5133c42d55cc (mouse-wheel-scroll-amount, mwheel-scroll, mouse-wheel-mode):
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 45994
diff changeset
84 AMOUNT should be the number of lines to scroll, or `nil' for near full
5133c42d55cc (mouse-wheel-scroll-amount, mwheel-scroll, mouse-wheel-mode):
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 45994
diff changeset
85 screen. It can also be a floating point number, specifying the fraction of
5133c42d55cc (mouse-wheel-scroll-amount, mwheel-scroll, mouse-wheel-mode):
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 45994
diff changeset
86 a full screen to scroll. A near full screen is `next-screen-context-lines'
5133c42d55cc (mouse-wheel-scroll-amount, mwheel-scroll, mouse-wheel-mode):
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 45994
diff changeset
87 less than a full screen."
26398
7eb699cb9ef2 Initial import from perry
William M. Perry <wmperry@aventail.com>
parents:
diff changeset
88 :group 'mouse
45994
65253ed28734 Undo last patch for now.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 45947
diff changeset
89 :type '(cons
65253ed28734 Undo last patch for now.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 45947
diff changeset
90 (choice :tag "Normal"
26398
7eb699cb9ef2 Initial import from perry
William M. Perry <wmperry@aventail.com>
parents:
diff changeset
91 (const :tag "Full screen" :value nil)
45994
65253ed28734 Undo last patch for now.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 45947
diff changeset
92 (integer :tag "Specific # of lines")
46001
5133c42d55cc (mouse-wheel-scroll-amount, mwheel-scroll, mouse-wheel-mode):
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 45994
diff changeset
93 (float :tag "Fraction of window")
5133c42d55cc (mouse-wheel-scroll-amount, mwheel-scroll, mouse-wheel-mode):
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 45994
diff changeset
94 (cons
5133c42d55cc (mouse-wheel-scroll-amount, mwheel-scroll, mouse-wheel-mode):
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 45994
diff changeset
95 (repeat (choice :tag "modifier"
5133c42d55cc (mouse-wheel-scroll-amount, mwheel-scroll, mouse-wheel-mode):
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 45994
diff changeset
96 (const alt) (const control) (const hyper)
5133c42d55cc (mouse-wheel-scroll-amount, mwheel-scroll, mouse-wheel-mode):
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 45994
diff changeset
97 (const meta) (const shift) (const super)))
5133c42d55cc (mouse-wheel-scroll-amount, mwheel-scroll, mouse-wheel-mode):
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 45994
diff changeset
98 (choice :tag "scroll amount"
5133c42d55cc (mouse-wheel-scroll-amount, mwheel-scroll, mouse-wheel-mode):
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 45994
diff changeset
99 (const :tag "Full screen" :value nil)
5133c42d55cc (mouse-wheel-scroll-amount, mwheel-scroll, mouse-wheel-mode):
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 45994
diff changeset
100 (integer :tag "Specific # of lines")
5133c42d55cc (mouse-wheel-scroll-amount, mwheel-scroll, mouse-wheel-mode):
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 45994
diff changeset
101 (float :tag "Fraction of window"))))
45994
65253ed28734 Undo last patch for now.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 45947
diff changeset
102 (repeat
65253ed28734 Undo last patch for now.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 45947
diff changeset
103 (cons
46001
5133c42d55cc (mouse-wheel-scroll-amount, mwheel-scroll, mouse-wheel-mode):
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 45994
diff changeset
104 (repeat (choice :tag "modifier"
5133c42d55cc (mouse-wheel-scroll-amount, mwheel-scroll, mouse-wheel-mode):
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 45994
diff changeset
105 (const alt) (const control) (const hyper)
45994
65253ed28734 Undo last patch for now.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 45947
diff changeset
106 (const meta) (const shift) (const super)))
65253ed28734 Undo last patch for now.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 45947
diff changeset
107 (choice :tag "scroll amount"
65253ed28734 Undo last patch for now.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 45947
diff changeset
108 (const :tag "Full screen" :value nil)
65253ed28734 Undo last patch for now.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 45947
diff changeset
109 (integer :tag "Specific # of lines")
65253ed28734 Undo last patch for now.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 45947
diff changeset
110 (float :tag "Fraction of window"))))))
65253ed28734 Undo last patch for now.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 45947
diff changeset
111
65253ed28734 Undo last patch for now.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 45947
diff changeset
112 (defcustom mouse-wheel-progessive-speed t
65253ed28734 Undo last patch for now.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 45947
diff changeset
113 "If non-nil, the faster the user moves the wheel, the faster the scrolling.
65253ed28734 Undo last patch for now.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 45947
diff changeset
114 Note that this has no effect when `mouse-wheel-scroll-amount' specifies
46001
5133c42d55cc (mouse-wheel-scroll-amount, mwheel-scroll, mouse-wheel-mode):
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 45994
diff changeset
115 a \"near full screen\" scroll or when the mouse wheel sends key instead
5133c42d55cc (mouse-wheel-scroll-amount, mwheel-scroll, mouse-wheel-mode):
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 45994
diff changeset
116 of button events."
45994
65253ed28734 Undo last patch for now.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 45947
diff changeset
117 :group 'mouse
65253ed28734 Undo last patch for now.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 45947
diff changeset
118 :type 'boolean)
26398
7eb699cb9ef2 Initial import from perry
William M. Perry <wmperry@aventail.com>
parents:
diff changeset
119
46066
99487f98aaa7 (mouse-wheel-change-button): Deactivate before changing.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 46001
diff changeset
120 (defcustom mouse-wheel-follow-mouse t
26398
7eb699cb9ef2 Initial import from perry
William M. Perry <wmperry@aventail.com>
parents:
diff changeset
121 "Whether the mouse wheel should scroll the window that the mouse is over.
46001
5133c42d55cc (mouse-wheel-scroll-amount, mwheel-scroll, mouse-wheel-mode):
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 45994
diff changeset
122 This can be slightly disconcerting, but some people prefer it."
26398
7eb699cb9ef2 Initial import from perry
William M. Perry <wmperry@aventail.com>
parents:
diff changeset
123 :group 'mouse
7eb699cb9ef2 Initial import from perry
William M. Perry <wmperry@aventail.com>
parents:
diff changeset
124 :type 'boolean)
7eb699cb9ef2 Initial import from perry
William M. Perry <wmperry@aventail.com>
parents:
diff changeset
125
45994
65253ed28734 Undo last patch for now.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 45947
diff changeset
126 (if (not (fboundp 'event-button))
65253ed28734 Undo last patch for now.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 45947
diff changeset
127 (defun mwheel-event-button (event)
46066
99487f98aaa7 (mouse-wheel-change-button): Deactivate before changing.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 46001
diff changeset
128 (let ((x (event-basic-type event)))
45994
65253ed28734 Undo last patch for now.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 45947
diff changeset
129 ;; Map mouse-wheel events to appropriate buttons
46066
99487f98aaa7 (mouse-wheel-change-button): Deactivate before changing.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 46001
diff changeset
130 (if (eq 'mouse-wheel x)
45994
65253ed28734 Undo last patch for now.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 45947
diff changeset
131 (let ((amount (car (cdr (cdr (cdr event))))))
65253ed28734 Undo last patch for now.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 45947
diff changeset
132 (if (< amount 0)
46066
99487f98aaa7 (mouse-wheel-change-button): Deactivate before changing.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 46001
diff changeset
133 mouse-wheel-up-event
99487f98aaa7 (mouse-wheel-change-button): Deactivate before changing.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 46001
diff changeset
134 mouse-wheel-down-event))
99487f98aaa7 (mouse-wheel-change-button): Deactivate before changing.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 46001
diff changeset
135 x)))
45994
65253ed28734 Undo last patch for now.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 45947
diff changeset
136 (fset 'mwheel-event-button 'event-button))
65253ed28734 Undo last patch for now.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 45947
diff changeset
137
65253ed28734 Undo last patch for now.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 45947
diff changeset
138 (if (not (fboundp 'event-window))
65253ed28734 Undo last patch for now.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 45947
diff changeset
139 (defun mwheel-event-window (event)
65253ed28734 Undo last patch for now.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 45947
diff changeset
140 (posn-window (event-start event)))
65253ed28734 Undo last patch for now.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 45947
diff changeset
141 (fset 'mwheel-event-window 'event-window))
26398
7eb699cb9ef2 Initial import from perry
William M. Perry <wmperry@aventail.com>
parents:
diff changeset
142
45994
65253ed28734 Undo last patch for now.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 45947
diff changeset
143 (defun mwheel-scroll (event)
65253ed28734 Undo last patch for now.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 45947
diff changeset
144 "Scroll up or down according to the EVENT.
65253ed28734 Undo last patch for now.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 45947
diff changeset
145 This should only be bound to mouse buttons 4 and 5."
46066
99487f98aaa7 (mouse-wheel-change-button): Deactivate before changing.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 46001
diff changeset
146 (interactive (list last-input-event))
45994
65253ed28734 Undo last patch for now.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 45947
diff changeset
147 (let* ((curwin (if mouse-wheel-follow-mouse
65253ed28734 Undo last patch for now.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 45947
diff changeset
148 (prog1
65253ed28734 Undo last patch for now.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 45947
diff changeset
149 (selected-window)
65253ed28734 Undo last patch for now.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 45947
diff changeset
150 (select-window (mwheel-event-window event)))))
65253ed28734 Undo last patch for now.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 45947
diff changeset
151 (mods
65253ed28734 Undo last patch for now.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 45947
diff changeset
152 (delq 'click (delq 'double (delq 'triple (event-modifiers event)))))
46001
5133c42d55cc (mouse-wheel-scroll-amount, mwheel-scroll, mouse-wheel-mode):
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 45994
diff changeset
153 (amt (assoc mods mouse-wheel-scroll-amount)))
5133c42d55cc (mouse-wheel-scroll-amount, mwheel-scroll, mouse-wheel-mode):
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 45994
diff changeset
154 ;; Extract the actual amount or find the element that has no modifiers.
5133c42d55cc (mouse-wheel-scroll-amount, mwheel-scroll, mouse-wheel-mode):
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 45994
diff changeset
155 (if amt (setq amt (cdr amt))
5133c42d55cc (mouse-wheel-scroll-amount, mwheel-scroll, mouse-wheel-mode):
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 45994
diff changeset
156 (let ((list-elt mouse-wheel-scroll-amount))
5133c42d55cc (mouse-wheel-scroll-amount, mwheel-scroll, mouse-wheel-mode):
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 45994
diff changeset
157 (while (consp (setq amt (pop list-elt))))))
45994
65253ed28734 Undo last patch for now.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 45947
diff changeset
158 (if (floatp amt) (setq amt (1+ (truncate (* amt (window-height))))))
65253ed28734 Undo last patch for now.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 45947
diff changeset
159 (when (and mouse-wheel-progessive-speed (numberp amt))
65253ed28734 Undo last patch for now.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 45947
diff changeset
160 ;; When the double-mouse-N comes in, a mouse-N has been executed already,
46066
99487f98aaa7 (mouse-wheel-change-button): Deactivate before changing.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 46001
diff changeset
161 ;; So by adding things up we get a squaring up (1, 3, 6, 10, 15, ...).
45994
65253ed28734 Undo last patch for now.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 45947
diff changeset
162 (setq amt (* amt (event-click-count event))))
26398
7eb699cb9ef2 Initial import from perry
William M. Perry <wmperry@aventail.com>
parents:
diff changeset
163 (unwind-protect
45994
65253ed28734 Undo last patch for now.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 45947
diff changeset
164 (let ((button (mwheel-event-button event)))
46066
99487f98aaa7 (mouse-wheel-change-button): Deactivate before changing.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 46001
diff changeset
165 (cond ((eq button mouse-wheel-down-event) (scroll-down amt))
99487f98aaa7 (mouse-wheel-change-button): Deactivate before changing.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 46001
diff changeset
166 ((eq button mouse-wheel-up-event) (scroll-up amt))
45994
65253ed28734 Undo last patch for now.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 45947
diff changeset
167 (t (error "Bad binding in mwheel-scroll"))))
26398
7eb699cb9ef2 Initial import from perry
William M. Perry <wmperry@aventail.com>
parents:
diff changeset
168 (if curwin (select-window curwin)))))
7eb699cb9ef2 Initial import from perry
William M. Perry <wmperry@aventail.com>
parents:
diff changeset
169
32867
553975760fe9 (mouse-wheel-mode): New global minor mode.
Miles Bader <miles@gnu.org>
parents: 26410
diff changeset
170
26398
7eb699cb9ef2 Initial import from perry
William M. Perry <wmperry@aventail.com>
parents:
diff changeset
171 ;;;###autoload
32867
553975760fe9 (mouse-wheel-mode): New global minor mode.
Miles Bader <miles@gnu.org>
parents: 26410
diff changeset
172 (define-minor-mode mouse-wheel-mode
553975760fe9 (mouse-wheel-mode): New global minor mode.
Miles Bader <miles@gnu.org>
parents: 26410
diff changeset
173 "Toggle mouse wheel support.
553975760fe9 (mouse-wheel-mode): New global minor mode.
Miles Bader <miles@gnu.org>
parents: 26410
diff changeset
174 With prefix argument ARG, turn on if positive, otherwise off.
553975760fe9 (mouse-wheel-mode): New global minor mode.
Miles Bader <miles@gnu.org>
parents: 26410
diff changeset
175 Returns non-nil if the new state is enabled."
553975760fe9 (mouse-wheel-mode): New global minor mode.
Miles Bader <miles@gnu.org>
parents: 26410
diff changeset
176 :global t
553975760fe9 (mouse-wheel-mode): New global minor mode.
Miles Bader <miles@gnu.org>
parents: 26410
diff changeset
177 :group 'mouse
46066
99487f98aaa7 (mouse-wheel-change-button): Deactivate before changing.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 46001
diff changeset
178 (let* ((dn mouse-wheel-down-event)
99487f98aaa7 (mouse-wheel-change-button): Deactivate before changing.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 46001
diff changeset
179 (up mouse-wheel-up-event)
45994
65253ed28734 Undo last patch for now.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 45947
diff changeset
180 (keys
46001
5133c42d55cc (mouse-wheel-scroll-amount, mwheel-scroll, mouse-wheel-mode):
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 45994
diff changeset
181 (nconc (mapcar (lambda (amt) `[(,@(if (consp amt) (car amt)) ,up)])
5133c42d55cc (mouse-wheel-scroll-amount, mwheel-scroll, mouse-wheel-mode):
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 45994
diff changeset
182 mouse-wheel-scroll-amount)
5133c42d55cc (mouse-wheel-scroll-amount, mwheel-scroll, mouse-wheel-mode):
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 45994
diff changeset
183 (mapcar (lambda (amt) `[(,@(if (consp amt) (car amt)) ,dn)])
5133c42d55cc (mouse-wheel-scroll-amount, mwheel-scroll, mouse-wheel-mode):
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 45994
diff changeset
184 mouse-wheel-scroll-amount))))
45994
65253ed28734 Undo last patch for now.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 45947
diff changeset
185 ;; This condition-case is here because Emacs 19 will throw an error
65253ed28734 Undo last patch for now.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 45947
diff changeset
186 ;; if you try to define a key that it does not know about. I for one
65253ed28734 Undo last patch for now.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 45947
diff changeset
187 ;; prefer to just unconditionally do a mwheel-install in my .emacs, so
65253ed28734 Undo last patch for now.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 45947
diff changeset
188 ;; that if the wheeled-mouse is there, it just works, and this way it
65253ed28734 Undo last patch for now.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 45947
diff changeset
189 ;; doesn't yell at me if I'm on my laptop or another machine, etc.
65253ed28734 Undo last patch for now.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 45947
diff changeset
190 (condition-case ()
65253ed28734 Undo last patch for now.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 45947
diff changeset
191 (dolist (key keys)
65253ed28734 Undo last patch for now.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 45947
diff changeset
192 (cond (mouse-wheel-mode
65253ed28734 Undo last patch for now.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 45947
diff changeset
193 (global-set-key key 'mwheel-scroll))
65253ed28734 Undo last patch for now.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 45947
diff changeset
194 ((eq (lookup-key (current-global-map) key) 'mwheel-scroll)
65253ed28734 Undo last patch for now.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 45947
diff changeset
195 (global-unset-key key))))
65253ed28734 Undo last patch for now.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 45947
diff changeset
196 (error nil))))
32867
553975760fe9 (mouse-wheel-mode): New global minor mode.
Miles Bader <miles@gnu.org>
parents: 26410
diff changeset
197
553975760fe9 (mouse-wheel-mode): New global minor mode.
Miles Bader <miles@gnu.org>
parents: 26410
diff changeset
198 ;;; Compatibility entry point
553975760fe9 (mouse-wheel-mode): New global minor mode.
Miles Bader <miles@gnu.org>
parents: 26410
diff changeset
199 ;;;###autoload
553975760fe9 (mouse-wheel-mode): New global minor mode.
Miles Bader <miles@gnu.org>
parents: 26410
diff changeset
200 (defun mwheel-install (&optional uninstall)
553975760fe9 (mouse-wheel-mode): New global minor mode.
Miles Bader <miles@gnu.org>
parents: 26410
diff changeset
201 "Enable mouse wheel support."
46066
99487f98aaa7 (mouse-wheel-change-button): Deactivate before changing.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 46001
diff changeset
202 (mouse-wheel-mode (if uninstall -1 1)))
32867
553975760fe9 (mouse-wheel-mode): New global minor mode.
Miles Bader <miles@gnu.org>
parents: 26410
diff changeset
203
26398
7eb699cb9ef2 Initial import from perry
William M. Perry <wmperry@aventail.com>
parents:
diff changeset
204 (provide 'mwheel)
7eb699cb9ef2 Initial import from perry
William M. Perry <wmperry@aventail.com>
parents:
diff changeset
205
7eb699cb9ef2 Initial import from perry
William M. Perry <wmperry@aventail.com>
parents:
diff changeset
206 ;;; mwheel.el ends here