annotate lisp/mwheel.el @ 42336:ee21403198b5

*** empty log message ***
author Kim F. Storm <storm@cua.dk>
date Tue, 25 Dec 2001 23:34:45 +0000
parents 9985a0fdea47
children 3a576cd9f462
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
38582
96ca8702243e (mouse-wheel-down-button, mouse-wheel-up-button):
Gerd Moellmann <gerd@gnu.org>
parents: 33227
diff changeset
3 ;; Copyright (C) 1998, 2000, 2001 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)
96ca8702243e (mouse-wheel-down-button, mouse-wheel-up-button):
Gerd Moellmann <gerd@gnu.org>
parents: 33227
diff changeset
49 (set-default var button)
96ca8702243e (mouse-wheel-down-button, mouse-wheel-up-button):
Gerd Moellmann <gerd@gnu.org>
parents: 33227
diff changeset
50 (when mouse-wheel-mode
96ca8702243e (mouse-wheel-down-button, mouse-wheel-up-button):
Gerd Moellmann <gerd@gnu.org>
parents: 33227
diff changeset
51 (mouse-wheel-mode 0)
96ca8702243e (mouse-wheel-down-button, mouse-wheel-up-button):
Gerd Moellmann <gerd@gnu.org>
parents: 33227
diff changeset
52 (mouse-wheel-mode 1)))
96ca8702243e (mouse-wheel-down-button, mouse-wheel-up-button):
Gerd Moellmann <gerd@gnu.org>
parents: 33227
diff changeset
53
96ca8702243e (mouse-wheel-down-button, mouse-wheel-up-button):
Gerd Moellmann <gerd@gnu.org>
parents: 33227
diff changeset
54 (defcustom mouse-wheel-down-button 4
96ca8702243e (mouse-wheel-down-button, mouse-wheel-up-button):
Gerd Moellmann <gerd@gnu.org>
parents: 33227
diff changeset
55 "Mouse button number for scrolling down."
96ca8702243e (mouse-wheel-down-button, mouse-wheel-up-button):
Gerd Moellmann <gerd@gnu.org>
parents: 33227
diff changeset
56 :group 'mouse
96ca8702243e (mouse-wheel-down-button, mouse-wheel-up-button):
Gerd Moellmann <gerd@gnu.org>
parents: 33227
diff changeset
57 :type 'integer
96ca8702243e (mouse-wheel-down-button, mouse-wheel-up-button):
Gerd Moellmann <gerd@gnu.org>
parents: 33227
diff changeset
58 :set 'mouse-wheel-change-button)
96ca8702243e (mouse-wheel-down-button, mouse-wheel-up-button):
Gerd Moellmann <gerd@gnu.org>
parents: 33227
diff changeset
59
96ca8702243e (mouse-wheel-down-button, mouse-wheel-up-button):
Gerd Moellmann <gerd@gnu.org>
parents: 33227
diff changeset
60 (defcustom mouse-wheel-up-button 5
96ca8702243e (mouse-wheel-down-button, mouse-wheel-up-button):
Gerd Moellmann <gerd@gnu.org>
parents: 33227
diff changeset
61 "Mouse button number for scrolling up."
96ca8702243e (mouse-wheel-down-button, mouse-wheel-up-button):
Gerd Moellmann <gerd@gnu.org>
parents: 33227
diff changeset
62 :group 'mouse
96ca8702243e (mouse-wheel-down-button, mouse-wheel-up-button):
Gerd Moellmann <gerd@gnu.org>
parents: 33227
diff changeset
63 :type 'integer
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
33227
791ce66d397e (mouse-wheel-scroll-amount): Renamed from `mwheel-scroll-amount'.
Miles Bader <miles@gnu.org>
parents: 33193
diff changeset
66 (defcustom mouse-wheel-scroll-amount '(5 . 1)
26398
7eb699cb9ef2 Initial import from perry
William M. Perry <wmperry@aventail.com>
parents:
diff changeset
67 "Amount to scroll windows by when spinning the mouse wheel.
7eb699cb9ef2 Initial import from perry
William M. Perry <wmperry@aventail.com>
parents:
diff changeset
68 This is actually a cons cell, where the first item is the amount to scroll
7eb699cb9ef2 Initial import from perry
William M. Perry <wmperry@aventail.com>
parents:
diff changeset
69 on a normal wheel event, and the second is the amount to scroll when the
7eb699cb9ef2 Initial import from perry
William M. Perry <wmperry@aventail.com>
parents:
diff changeset
70 wheel is moved with the shift key depressed.
7eb699cb9ef2 Initial import from perry
William M. Perry <wmperry@aventail.com>
parents:
diff changeset
71
7eb699cb9ef2 Initial import from perry
William M. Perry <wmperry@aventail.com>
parents:
diff changeset
72 Each item should be the number of lines to scroll, or `nil' for near
41290
9985a0fdea47 (mouse-wheel-scroll-amount): Allow float values.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 38582
diff changeset
73 full screen. It can also be a floating point number, specifying
9985a0fdea47 (mouse-wheel-scroll-amount): Allow float values.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 38582
diff changeset
74 the fraction of the window to scroll.
26398
7eb699cb9ef2 Initial import from perry
William M. Perry <wmperry@aventail.com>
parents:
diff changeset
75 A near full screen is `next-screen-context-lines' less than a full screen."
7eb699cb9ef2 Initial import from perry
William M. Perry <wmperry@aventail.com>
parents:
diff changeset
76 :group 'mouse
7eb699cb9ef2 Initial import from perry
William M. Perry <wmperry@aventail.com>
parents:
diff changeset
77 :type '(cons
7eb699cb9ef2 Initial import from perry
William M. Perry <wmperry@aventail.com>
parents:
diff changeset
78 (choice :tag "Normal"
7eb699cb9ef2 Initial import from perry
William M. Perry <wmperry@aventail.com>
parents:
diff changeset
79 (const :tag "Full screen" :value nil)
41290
9985a0fdea47 (mouse-wheel-scroll-amount): Allow float values.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 38582
diff changeset
80 (integer :tag "Specific # of lines")
9985a0fdea47 (mouse-wheel-scroll-amount): Allow float values.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 38582
diff changeset
81 (float :tag "Fraction of window"))
26398
7eb699cb9ef2 Initial import from perry
William M. Perry <wmperry@aventail.com>
parents:
diff changeset
82 (choice :tag "Shifted"
7eb699cb9ef2 Initial import from perry
William M. Perry <wmperry@aventail.com>
parents:
diff changeset
83 (const :tag "Full screen" :value nil)
41290
9985a0fdea47 (mouse-wheel-scroll-amount): Allow float values.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 38582
diff changeset
84 (integer :tag "Specific # of lines")
9985a0fdea47 (mouse-wheel-scroll-amount): Allow float values.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 38582
diff changeset
85 (float :tag "Fraction of window"))))
9985a0fdea47 (mouse-wheel-scroll-amount): Allow float values.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 38582
diff changeset
86
9985a0fdea47 (mouse-wheel-scroll-amount): Allow float values.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 38582
diff changeset
87 (defcustom mouse-wheel-progessive-speed t
9985a0fdea47 (mouse-wheel-scroll-amount): Allow float values.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 38582
diff changeset
88 "If non-nil, the faster the user moves the wheel, the faster the scrolling.
9985a0fdea47 (mouse-wheel-scroll-amount): Allow float values.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 38582
diff changeset
89 Note that this has no effect when `mouse-wheel-scroll-amount' specifies
9985a0fdea47 (mouse-wheel-scroll-amount): Allow float values.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 38582
diff changeset
90 a \"near full screen\" scroll."
9985a0fdea47 (mouse-wheel-scroll-amount): Allow float values.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 38582
diff changeset
91 :group 'mouse
9985a0fdea47 (mouse-wheel-scroll-amount): Allow float values.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 38582
diff changeset
92 :type 'boolean)
26398
7eb699cb9ef2 Initial import from perry
William M. Perry <wmperry@aventail.com>
parents:
diff changeset
93
33227
791ce66d397e (mouse-wheel-scroll-amount): Renamed from `mwheel-scroll-amount'.
Miles Bader <miles@gnu.org>
parents: 33193
diff changeset
94 (defcustom mouse-wheel-follow-mouse nil
26398
7eb699cb9ef2 Initial import from perry
William M. Perry <wmperry@aventail.com>
parents:
diff changeset
95 "Whether the mouse wheel should scroll the window that the mouse is over.
7eb699cb9ef2 Initial import from perry
William M. Perry <wmperry@aventail.com>
parents:
diff changeset
96 This can be slightly disconcerting, but some people may prefer it."
7eb699cb9ef2 Initial import from perry
William M. Perry <wmperry@aventail.com>
parents:
diff changeset
97 :group 'mouse
7eb699cb9ef2 Initial import from perry
William M. Perry <wmperry@aventail.com>
parents:
diff changeset
98 :type 'boolean)
7eb699cb9ef2 Initial import from perry
William M. Perry <wmperry@aventail.com>
parents:
diff changeset
99
7eb699cb9ef2 Initial import from perry
William M. Perry <wmperry@aventail.com>
parents:
diff changeset
100 (if (not (fboundp 'event-button))
7eb699cb9ef2 Initial import from perry
William M. Perry <wmperry@aventail.com>
parents:
diff changeset
101 (defun mwheel-event-button (event)
7eb699cb9ef2 Initial import from perry
William M. Perry <wmperry@aventail.com>
parents:
diff changeset
102 (let ((x (symbol-name (event-basic-type event))))
7eb699cb9ef2 Initial import from perry
William M. Perry <wmperry@aventail.com>
parents:
diff changeset
103 (if (not (string-match "^mouse-\\([0-9]+\\)" x))
7eb699cb9ef2 Initial import from perry
William M. Perry <wmperry@aventail.com>
parents:
diff changeset
104 (error "Not a button event: %S" event))
7eb699cb9ef2 Initial import from perry
William M. Perry <wmperry@aventail.com>
parents:
diff changeset
105 (string-to-int (substring x (match-beginning 1) (match-end 1)))))
7eb699cb9ef2 Initial import from perry
William M. Perry <wmperry@aventail.com>
parents:
diff changeset
106 (fset 'mwheel-event-button 'event-button))
7eb699cb9ef2 Initial import from perry
William M. Perry <wmperry@aventail.com>
parents:
diff changeset
107
7eb699cb9ef2 Initial import from perry
William M. Perry <wmperry@aventail.com>
parents:
diff changeset
108 (if (not (fboundp 'event-window))
7eb699cb9ef2 Initial import from perry
William M. Perry <wmperry@aventail.com>
parents:
diff changeset
109 (defun mwheel-event-window (event)
7eb699cb9ef2 Initial import from perry
William M. Perry <wmperry@aventail.com>
parents:
diff changeset
110 (posn-window (event-start event)))
7eb699cb9ef2 Initial import from perry
William M. Perry <wmperry@aventail.com>
parents:
diff changeset
111 (fset 'mwheel-event-window 'event-window))
7eb699cb9ef2 Initial import from perry
William M. Perry <wmperry@aventail.com>
parents:
diff changeset
112
7eb699cb9ef2 Initial import from perry
William M. Perry <wmperry@aventail.com>
parents:
diff changeset
113 (defun mwheel-scroll (event)
41290
9985a0fdea47 (mouse-wheel-scroll-amount): Allow float values.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 38582
diff changeset
114 "Scroll up or down according to the EVENT.
9985a0fdea47 (mouse-wheel-scroll-amount): Allow float values.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 38582
diff changeset
115 This should only be bound to mouse buttons 4 and 5."
26398
7eb699cb9ef2 Initial import from perry
William M. Perry <wmperry@aventail.com>
parents:
diff changeset
116 (interactive "e")
33227
791ce66d397e (mouse-wheel-scroll-amount): Renamed from `mwheel-scroll-amount'.
Miles Bader <miles@gnu.org>
parents: 33193
diff changeset
117 (let ((curwin (if mouse-wheel-follow-mouse
26398
7eb699cb9ef2 Initial import from perry
William M. Perry <wmperry@aventail.com>
parents:
diff changeset
118 (prog1
7eb699cb9ef2 Initial import from perry
William M. Perry <wmperry@aventail.com>
parents:
diff changeset
119 (selected-window)
7eb699cb9ef2 Initial import from perry
William M. Perry <wmperry@aventail.com>
parents:
diff changeset
120 (select-window (mwheel-event-window event)))))
7eb699cb9ef2 Initial import from perry
William M. Perry <wmperry@aventail.com>
parents:
diff changeset
121 (amt (if (memq 'shift (event-modifiers event))
33227
791ce66d397e (mouse-wheel-scroll-amount): Renamed from `mwheel-scroll-amount'.
Miles Bader <miles@gnu.org>
parents: 33193
diff changeset
122 (cdr mouse-wheel-scroll-amount)
791ce66d397e (mouse-wheel-scroll-amount): Renamed from `mwheel-scroll-amount'.
Miles Bader <miles@gnu.org>
parents: 33193
diff changeset
123 (car mouse-wheel-scroll-amount))))
41290
9985a0fdea47 (mouse-wheel-scroll-amount): Allow float values.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 38582
diff changeset
124 (if (floatp amt) (setq amt (1+ (truncate (* amt (window-height))))))
9985a0fdea47 (mouse-wheel-scroll-amount): Allow float values.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 38582
diff changeset
125 (when (and mouse-wheel-progessive-speed (numberp amt))
9985a0fdea47 (mouse-wheel-scroll-amount): Allow float values.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 38582
diff changeset
126 ;; When the double-mouse-N comes in, a mouse-N has been executed already,
9985a0fdea47 (mouse-wheel-scroll-amount): Allow float values.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 38582
diff changeset
127 ;; So by adding things up we get a squaring up (1, 3, 6, 10, 16, ...).
9985a0fdea47 (mouse-wheel-scroll-amount): Allow float values.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 38582
diff changeset
128 (setq amt (* amt (event-click-count event))))
26398
7eb699cb9ef2 Initial import from perry
William M. Perry <wmperry@aventail.com>
parents:
diff changeset
129 (unwind-protect
26410
55a234a9fe88 Fix copyright notice. Don't require 'cl at run time.
Gerd Moellmann <gerd@gnu.org>
parents: 26398
diff changeset
130 (let ((button (mwheel-event-button event)))
38582
96ca8702243e (mouse-wheel-down-button, mouse-wheel-up-button):
Gerd Moellmann <gerd@gnu.org>
parents: 33227
diff changeset
131 (cond ((= button mouse-wheel-down-button) (scroll-down amt))
96ca8702243e (mouse-wheel-down-button, mouse-wheel-up-button):
Gerd Moellmann <gerd@gnu.org>
parents: 33227
diff changeset
132 ((= button mouse-wheel-up-button) (scroll-up amt))
26410
55a234a9fe88 Fix copyright notice. Don't require 'cl at run time.
Gerd Moellmann <gerd@gnu.org>
parents: 26398
diff changeset
133 (t (error "Bad binding in mwheel-scroll"))))
26398
7eb699cb9ef2 Initial import from perry
William M. Perry <wmperry@aventail.com>
parents:
diff changeset
134 (if curwin (select-window curwin)))))
7eb699cb9ef2 Initial import from perry
William M. Perry <wmperry@aventail.com>
parents:
diff changeset
135
32867
553975760fe9 (mouse-wheel-mode): New global minor mode.
Miles Bader <miles@gnu.org>
parents: 26410
diff changeset
136
26398
7eb699cb9ef2 Initial import from perry
William M. Perry <wmperry@aventail.com>
parents:
diff changeset
137 ;;;###autoload
32867
553975760fe9 (mouse-wheel-mode): New global minor mode.
Miles Bader <miles@gnu.org>
parents: 26410
diff changeset
138 (define-minor-mode mouse-wheel-mode
553975760fe9 (mouse-wheel-mode): New global minor mode.
Miles Bader <miles@gnu.org>
parents: 26410
diff changeset
139 "Toggle mouse wheel support.
553975760fe9 (mouse-wheel-mode): New global minor mode.
Miles Bader <miles@gnu.org>
parents: 26410
diff changeset
140 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
141 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
142 :global t
553975760fe9 (mouse-wheel-mode): New global minor mode.
Miles Bader <miles@gnu.org>
parents: 26410
diff changeset
143 :group 'mouse
26398
7eb699cb9ef2 Initial import from perry
William M. Perry <wmperry@aventail.com>
parents:
diff changeset
144 ;; In the latest versions of XEmacs, we could just use
7eb699cb9ef2 Initial import from perry
William M. Perry <wmperry@aventail.com>
parents:
diff changeset
145 ;; (S-)*mouse-[45], since those are aliases for the button
7eb699cb9ef2 Initial import from perry
William M. Perry <wmperry@aventail.com>
parents:
diff changeset
146 ;; equivalents in XEmacs, but I want this to work in as many
7eb699cb9ef2 Initial import from perry
William M. Perry <wmperry@aventail.com>
parents:
diff changeset
147 ;; versions of XEmacs as it can.
33227
791ce66d397e (mouse-wheel-scroll-amount): Renamed from `mwheel-scroll-amount'.
Miles Bader <miles@gnu.org>
parents: 33193
diff changeset
148 (let ((keys
791ce66d397e (mouse-wheel-scroll-amount): Renamed from `mwheel-scroll-amount'.
Miles Bader <miles@gnu.org>
parents: 33193
diff changeset
149 (if (featurep 'xemacs)
38582
96ca8702243e (mouse-wheel-down-button, mouse-wheel-up-button):
Gerd Moellmann <gerd@gnu.org>
parents: 33227
diff changeset
150 (let ((down (intern (format "button%d" mouse-wheel-down-button)))
96ca8702243e (mouse-wheel-down-button, mouse-wheel-up-button):
Gerd Moellmann <gerd@gnu.org>
parents: 33227
diff changeset
151 (up (intern (format "button%d" mouse-wheel-up-button))))
96ca8702243e (mouse-wheel-down-button, mouse-wheel-up-button):
Gerd Moellmann <gerd@gnu.org>
parents: 33227
diff changeset
152 `(,down [(shift ,down)] ,up [(shift ,up)]))
96ca8702243e (mouse-wheel-down-button, mouse-wheel-up-button):
Gerd Moellmann <gerd@gnu.org>
parents: 33227
diff changeset
153 (let ((down (intern (format "mouse-%d" mouse-wheel-down-button)))
96ca8702243e (mouse-wheel-down-button, mouse-wheel-up-button):
Gerd Moellmann <gerd@gnu.org>
parents: 33227
diff changeset
154 (s-down (intern (format "S-mouse-%d" mouse-wheel-down-button)))
96ca8702243e (mouse-wheel-down-button, mouse-wheel-up-button):
Gerd Moellmann <gerd@gnu.org>
parents: 33227
diff changeset
155 (up (intern (format "mouse-%d" mouse-wheel-up-button)))
96ca8702243e (mouse-wheel-down-button, mouse-wheel-up-button):
Gerd Moellmann <gerd@gnu.org>
parents: 33227
diff changeset
156 (s-up (intern (format "S-mouse-%d" mouse-wheel-up-button))))
96ca8702243e (mouse-wheel-down-button, mouse-wheel-up-button):
Gerd Moellmann <gerd@gnu.org>
parents: 33227
diff changeset
157 `([,down] [,s-down] [,up] [,s-up])))))
26398
7eb699cb9ef2 Initial import from perry
William M. Perry <wmperry@aventail.com>
parents:
diff changeset
158 ;; This condition-case is here because Emacs 19 will throw an error
7eb699cb9ef2 Initial import from perry
William M. Perry <wmperry@aventail.com>
parents:
diff changeset
159 ;; if you try to define a key that it does not know about. I for one
7eb699cb9ef2 Initial import from perry
William M. Perry <wmperry@aventail.com>
parents:
diff changeset
160 ;; prefer to just unconditionally do a mwheel-install in my .emacs, so
7eb699cb9ef2 Initial import from perry
William M. Perry <wmperry@aventail.com>
parents:
diff changeset
161 ;; that if the wheeled-mouse is there, it just works, and this way it
7eb699cb9ef2 Initial import from perry
William M. Perry <wmperry@aventail.com>
parents:
diff changeset
162 ;; doesn't yell at me if I'm on my laptop or another machine, etc.
7eb699cb9ef2 Initial import from perry
William M. Perry <wmperry@aventail.com>
parents:
diff changeset
163 (condition-case ()
32867
553975760fe9 (mouse-wheel-mode): New global minor mode.
Miles Bader <miles@gnu.org>
parents: 26410
diff changeset
164 (dolist (key keys)
553975760fe9 (mouse-wheel-mode): New global minor mode.
Miles Bader <miles@gnu.org>
parents: 26410
diff changeset
165 (cond (mouse-wheel-mode
553975760fe9 (mouse-wheel-mode): New global minor mode.
Miles Bader <miles@gnu.org>
parents: 26410
diff changeset
166 (define-key global-map key 'mwheel-scroll))
553975760fe9 (mouse-wheel-mode): New global minor mode.
Miles Bader <miles@gnu.org>
parents: 26410
diff changeset
167 ((eq (lookup-key global-map key) 'mwheel-scroll)
553975760fe9 (mouse-wheel-mode): New global minor mode.
Miles Bader <miles@gnu.org>
parents: 26410
diff changeset
168 (define-key global-map key nil))))
26398
7eb699cb9ef2 Initial import from perry
William M. Perry <wmperry@aventail.com>
parents:
diff changeset
169 (error nil))))
32867
553975760fe9 (mouse-wheel-mode): New global minor mode.
Miles Bader <miles@gnu.org>
parents: 26410
diff changeset
170
553975760fe9 (mouse-wheel-mode): New global minor mode.
Miles Bader <miles@gnu.org>
parents: 26410
diff changeset
171 ;;; Compatibility entry point
553975760fe9 (mouse-wheel-mode): New global minor mode.
Miles Bader <miles@gnu.org>
parents: 26410
diff changeset
172 ;;;###autoload
553975760fe9 (mouse-wheel-mode): New global minor mode.
Miles Bader <miles@gnu.org>
parents: 26410
diff changeset
173 (defun mwheel-install (&optional uninstall)
553975760fe9 (mouse-wheel-mode): New global minor mode.
Miles Bader <miles@gnu.org>
parents: 26410
diff changeset
174 "Enable mouse wheel support."
553975760fe9 (mouse-wheel-mode): New global minor mode.
Miles Bader <miles@gnu.org>
parents: 26410
diff changeset
175 (mouse-wheel-mode t))
553975760fe9 (mouse-wheel-mode): New global minor mode.
Miles Bader <miles@gnu.org>
parents: 26410
diff changeset
176
26398
7eb699cb9ef2 Initial import from perry
William M. Perry <wmperry@aventail.com>
parents:
diff changeset
177 (provide 'mwheel)
7eb699cb9ef2 Initial import from perry
William M. Perry <wmperry@aventail.com>
parents:
diff changeset
178
7eb699cb9ef2 Initial import from perry
William M. Perry <wmperry@aventail.com>
parents:
diff changeset
179 ;;; mwheel.el ends here