annotate lisp/mwheel.el @ 38580:446aa2cd256e

More information about how to find the Meta keys.
author Eli Zaretskii <eliz@gnu.org>
date Thu, 26 Jul 2001 15:43:08 +0000
parents 791ce66d397e
children 96ca8702243e
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
33227
791ce66d397e (mouse-wheel-scroll-amount): Renamed from `mwheel-scroll-amount'.
Miles Bader <miles@gnu.org>
parents: 33193
diff changeset
3 ;; Copyright (C) 1998, 2000, 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
33227
791ce66d397e (mouse-wheel-scroll-amount): Renamed from `mwheel-scroll-amount'.
Miles Bader <miles@gnu.org>
parents: 33193
diff changeset
44 (defcustom mouse-wheel-scroll-amount '(5 . 1)
26398
7eb699cb9ef2 Initial import from perry
William M. Perry <wmperry@aventail.com>
parents:
diff changeset
45 "Amount to scroll windows by when spinning the mouse wheel.
7eb699cb9ef2 Initial import from perry
William M. Perry <wmperry@aventail.com>
parents:
diff changeset
46 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
47 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
48 wheel is moved with the shift key depressed.
7eb699cb9ef2 Initial import from perry
William M. Perry <wmperry@aventail.com>
parents:
diff changeset
49
7eb699cb9ef2 Initial import from perry
William M. Perry <wmperry@aventail.com>
parents:
diff changeset
50 Each item should be the number of lines to scroll, or `nil' for near
7eb699cb9ef2 Initial import from perry
William M. Perry <wmperry@aventail.com>
parents:
diff changeset
51 full screen.
7eb699cb9ef2 Initial import from perry
William M. Perry <wmperry@aventail.com>
parents:
diff changeset
52 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
53 :group 'mouse
7eb699cb9ef2 Initial import from perry
William M. Perry <wmperry@aventail.com>
parents:
diff changeset
54 :type '(cons
7eb699cb9ef2 Initial import from perry
William M. Perry <wmperry@aventail.com>
parents:
diff changeset
55 (choice :tag "Normal"
7eb699cb9ef2 Initial import from perry
William M. Perry <wmperry@aventail.com>
parents:
diff changeset
56 (const :tag "Full screen" :value nil)
7eb699cb9ef2 Initial import from perry
William M. Perry <wmperry@aventail.com>
parents:
diff changeset
57 (integer :tag "Specific # of lines"))
7eb699cb9ef2 Initial import from perry
William M. Perry <wmperry@aventail.com>
parents:
diff changeset
58 (choice :tag "Shifted"
7eb699cb9ef2 Initial import from perry
William M. Perry <wmperry@aventail.com>
parents:
diff changeset
59 (const :tag "Full screen" :value nil)
7eb699cb9ef2 Initial import from perry
William M. Perry <wmperry@aventail.com>
parents:
diff changeset
60 (integer :tag "Specific # of lines"))))
7eb699cb9ef2 Initial import from perry
William M. Perry <wmperry@aventail.com>
parents:
diff changeset
61
33227
791ce66d397e (mouse-wheel-scroll-amount): Renamed from `mwheel-scroll-amount'.
Miles Bader <miles@gnu.org>
parents: 33193
diff changeset
62 (defcustom mouse-wheel-follow-mouse nil
26398
7eb699cb9ef2 Initial import from perry
William M. Perry <wmperry@aventail.com>
parents:
diff changeset
63 "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
64 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
65 :group 'mouse
7eb699cb9ef2 Initial import from perry
William M. Perry <wmperry@aventail.com>
parents:
diff changeset
66 :type 'boolean)
7eb699cb9ef2 Initial import from perry
William M. Perry <wmperry@aventail.com>
parents:
diff changeset
67
7eb699cb9ef2 Initial import from perry
William M. Perry <wmperry@aventail.com>
parents:
diff changeset
68 (if (not (fboundp 'event-button))
7eb699cb9ef2 Initial import from perry
William M. Perry <wmperry@aventail.com>
parents:
diff changeset
69 (defun mwheel-event-button (event)
7eb699cb9ef2 Initial import from perry
William M. Perry <wmperry@aventail.com>
parents:
diff changeset
70 (let ((x (symbol-name (event-basic-type event))))
7eb699cb9ef2 Initial import from perry
William M. Perry <wmperry@aventail.com>
parents:
diff changeset
71 (if (not (string-match "^mouse-\\([0-9]+\\)" x))
7eb699cb9ef2 Initial import from perry
William M. Perry <wmperry@aventail.com>
parents:
diff changeset
72 (error "Not a button event: %S" event))
7eb699cb9ef2 Initial import from perry
William M. Perry <wmperry@aventail.com>
parents:
diff changeset
73 (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
74 (fset 'mwheel-event-button 'event-button))
7eb699cb9ef2 Initial import from perry
William M. Perry <wmperry@aventail.com>
parents:
diff changeset
75
7eb699cb9ef2 Initial import from perry
William M. Perry <wmperry@aventail.com>
parents:
diff changeset
76 (if (not (fboundp 'event-window))
7eb699cb9ef2 Initial import from perry
William M. Perry <wmperry@aventail.com>
parents:
diff changeset
77 (defun mwheel-event-window (event)
7eb699cb9ef2 Initial import from perry
William M. Perry <wmperry@aventail.com>
parents:
diff changeset
78 (posn-window (event-start event)))
7eb699cb9ef2 Initial import from perry
William M. Perry <wmperry@aventail.com>
parents:
diff changeset
79 (fset 'mwheel-event-window 'event-window))
7eb699cb9ef2 Initial import from perry
William M. Perry <wmperry@aventail.com>
parents:
diff changeset
80
7eb699cb9ef2 Initial import from perry
William M. Perry <wmperry@aventail.com>
parents:
diff changeset
81 (defun mwheel-scroll (event)
7eb699cb9ef2 Initial import from perry
William M. Perry <wmperry@aventail.com>
parents:
diff changeset
82 (interactive "e")
33227
791ce66d397e (mouse-wheel-scroll-amount): Renamed from `mwheel-scroll-amount'.
Miles Bader <miles@gnu.org>
parents: 33193
diff changeset
83 (let ((curwin (if mouse-wheel-follow-mouse
26398
7eb699cb9ef2 Initial import from perry
William M. Perry <wmperry@aventail.com>
parents:
diff changeset
84 (prog1
7eb699cb9ef2 Initial import from perry
William M. Perry <wmperry@aventail.com>
parents:
diff changeset
85 (selected-window)
7eb699cb9ef2 Initial import from perry
William M. Perry <wmperry@aventail.com>
parents:
diff changeset
86 (select-window (mwheel-event-window event)))))
7eb699cb9ef2 Initial import from perry
William M. Perry <wmperry@aventail.com>
parents:
diff changeset
87 (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
88 (cdr mouse-wheel-scroll-amount)
791ce66d397e (mouse-wheel-scroll-amount): Renamed from `mwheel-scroll-amount'.
Miles Bader <miles@gnu.org>
parents: 33193
diff changeset
89 (car mouse-wheel-scroll-amount))))
26398
7eb699cb9ef2 Initial import from perry
William M. Perry <wmperry@aventail.com>
parents:
diff changeset
90 (unwind-protect
26410
55a234a9fe88 Fix copyright notice. Don't require 'cl at run time.
Gerd Moellmann <gerd@gnu.org>
parents: 26398
diff changeset
91 (let ((button (mwheel-event-button event)))
55a234a9fe88 Fix copyright notice. Don't require 'cl at run time.
Gerd Moellmann <gerd@gnu.org>
parents: 26398
diff changeset
92 (cond ((= button 4) (scroll-down amt))
55a234a9fe88 Fix copyright notice. Don't require 'cl at run time.
Gerd Moellmann <gerd@gnu.org>
parents: 26398
diff changeset
93 ((= button 5) (scroll-up amt))
55a234a9fe88 Fix copyright notice. Don't require 'cl at run time.
Gerd Moellmann <gerd@gnu.org>
parents: 26398
diff changeset
94 (t (error "Bad binding in mwheel-scroll"))))
26398
7eb699cb9ef2 Initial import from perry
William M. Perry <wmperry@aventail.com>
parents:
diff changeset
95 (if curwin (select-window curwin)))))
7eb699cb9ef2 Initial import from perry
William M. Perry <wmperry@aventail.com>
parents:
diff changeset
96
32867
553975760fe9 (mouse-wheel-mode): New global minor mode.
Miles Bader <miles@gnu.org>
parents: 26410
diff changeset
97
553975760fe9 (mouse-wheel-mode): New global minor mode.
Miles Bader <miles@gnu.org>
parents: 26410
diff changeset
98 ;;; Note this definition must be at the end of the file, because
553975760fe9 (mouse-wheel-mode): New global minor mode.
Miles Bader <miles@gnu.org>
parents: 26410
diff changeset
99 ;;; `define-minor-mode' actually calls the mode-function if the
553975760fe9 (mouse-wheel-mode): New global minor mode.
Miles Bader <miles@gnu.org>
parents: 26410
diff changeset
100 ;;; associated variable is non-nil, which requires that all needed
33193
d70bb5e33b91 (mouse-wheel-mode): Drop unneeded positional args.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 32867
diff changeset
101 ;;; functions be already defined.
26398
7eb699cb9ef2 Initial import from perry
William M. Perry <wmperry@aventail.com>
parents:
diff changeset
102 ;;;###autoload
32867
553975760fe9 (mouse-wheel-mode): New global minor mode.
Miles Bader <miles@gnu.org>
parents: 26410
diff changeset
103 (define-minor-mode mouse-wheel-mode
553975760fe9 (mouse-wheel-mode): New global minor mode.
Miles Bader <miles@gnu.org>
parents: 26410
diff changeset
104 "Toggle mouse wheel support.
553975760fe9 (mouse-wheel-mode): New global minor mode.
Miles Bader <miles@gnu.org>
parents: 26410
diff changeset
105 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
106 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
107 :global t
553975760fe9 (mouse-wheel-mode): New global minor mode.
Miles Bader <miles@gnu.org>
parents: 26410
diff changeset
108 :group 'mouse
26398
7eb699cb9ef2 Initial import from perry
William M. Perry <wmperry@aventail.com>
parents:
diff changeset
109 ;; In the latest versions of XEmacs, we could just use
7eb699cb9ef2 Initial import from perry
William M. Perry <wmperry@aventail.com>
parents:
diff changeset
110 ;; (S-)*mouse-[45], since those are aliases for the button
7eb699cb9ef2 Initial import from perry
William M. Perry <wmperry@aventail.com>
parents:
diff changeset
111 ;; 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
112 ;; 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
113 (let ((keys
791ce66d397e (mouse-wheel-scroll-amount): Renamed from `mwheel-scroll-amount'.
Miles Bader <miles@gnu.org>
parents: 33193
diff changeset
114 (if (featurep 'xemacs)
791ce66d397e (mouse-wheel-scroll-amount): Renamed from `mwheel-scroll-amount'.
Miles Bader <miles@gnu.org>
parents: 33193
diff changeset
115 '(button4 [(shift button4)] button5 [(shift button5)])
791ce66d397e (mouse-wheel-scroll-amount): Renamed from `mwheel-scroll-amount'.
Miles Bader <miles@gnu.org>
parents: 33193
diff changeset
116 '([mouse-4] [S-mouse-4] [mouse-5] [S-mouse-5]))))
26398
7eb699cb9ef2 Initial import from perry
William M. Perry <wmperry@aventail.com>
parents:
diff changeset
117 ;; 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
118 ;; 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
119 ;; 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
120 ;; 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
121 ;; 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
122 (condition-case ()
32867
553975760fe9 (mouse-wheel-mode): New global minor mode.
Miles Bader <miles@gnu.org>
parents: 26410
diff changeset
123 (dolist (key keys)
553975760fe9 (mouse-wheel-mode): New global minor mode.
Miles Bader <miles@gnu.org>
parents: 26410
diff changeset
124 (cond (mouse-wheel-mode
553975760fe9 (mouse-wheel-mode): New global minor mode.
Miles Bader <miles@gnu.org>
parents: 26410
diff changeset
125 (define-key global-map key 'mwheel-scroll))
553975760fe9 (mouse-wheel-mode): New global minor mode.
Miles Bader <miles@gnu.org>
parents: 26410
diff changeset
126 ((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
127 (define-key global-map key nil))))
26398
7eb699cb9ef2 Initial import from perry
William M. Perry <wmperry@aventail.com>
parents:
diff changeset
128 (error nil))))
32867
553975760fe9 (mouse-wheel-mode): New global minor mode.
Miles Bader <miles@gnu.org>
parents: 26410
diff changeset
129
553975760fe9 (mouse-wheel-mode): New global minor mode.
Miles Bader <miles@gnu.org>
parents: 26410
diff changeset
130 ;;; Compatibility entry point
553975760fe9 (mouse-wheel-mode): New global minor mode.
Miles Bader <miles@gnu.org>
parents: 26410
diff changeset
131 ;;;###autoload
553975760fe9 (mouse-wheel-mode): New global minor mode.
Miles Bader <miles@gnu.org>
parents: 26410
diff changeset
132 (defun mwheel-install (&optional uninstall)
553975760fe9 (mouse-wheel-mode): New global minor mode.
Miles Bader <miles@gnu.org>
parents: 26410
diff changeset
133 "Enable mouse wheel support."
553975760fe9 (mouse-wheel-mode): New global minor mode.
Miles Bader <miles@gnu.org>
parents: 26410
diff changeset
134 (mouse-wheel-mode t))
553975760fe9 (mouse-wheel-mode): New global minor mode.
Miles Bader <miles@gnu.org>
parents: 26410
diff changeset
135
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 (provide 'mwheel)
7eb699cb9ef2 Initial import from perry
William M. Perry <wmperry@aventail.com>
parents:
diff changeset
138
7eb699cb9ef2 Initial import from perry
William M. Perry <wmperry@aventail.com>
parents:
diff changeset
139 ;;; mwheel.el ends here