Mercurial > hg > xemacs-beta

comparison lisp/mwheel.el @ 458:c33ae14dd6d0 r21-2-44

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-44
author cvs
date Mon, 13 Aug 2007 11:42:25 +0200
parents 576fb035e263
children 7039e6323819
comparison
equal deleted inserted replaced
457:4b9290a33024 458:c33ae14dd6d0
15 ;; WITHOUT ANY WARRANTY; without even the implied warranty of 15 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
17 ;; General Public License for more details. 17 ;; General Public License for more details.
18 18
19 ;; You should have received a copy of the GNU General Public License 19 ;; You should have received a copy of the GNU General Public License
20 ;; along with XEmacs; see the file COPYING. If not, write to the 20 ;; along with XEmacs; see the file COPYING. If not, write to the
21 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, 21 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
22 ;; Boston, MA 02111-1307, USA. 22 ;; Boston, MA 02111-1307, USA.
23 23
24 ;;; Synched up with: Not synched. 24 ;;; Synched up with: Not synched.
25 25
89 (selected-window) 89 (selected-window)
90 (select-window (mwheel-event-window event))))) 90 (select-window (mwheel-event-window event)))))
91 (amt (if (memq 'shift (event-modifiers event)) 91 (amt (if (memq 'shift (event-modifiers event))
92 (cdr mwheel-scroll-amount) 92 (cdr mwheel-scroll-amount)
93 (car mwheel-scroll-amount)))) 93 (car mwheel-scroll-amount))))
94 (case (mwheel-event-button event) 94 (unwind-protect
95 (4 (scroll-down amt)) 95 (case (mwheel-event-button event)
96 (5 (scroll-up amt)) 96 (4 (scroll-down amt))
97 (otherwise (error "Bad binding in mwheel-scroll"))) 97 (5 (scroll-up amt))
98 (if curwin (select-window curwin)))) 98 (otherwise (error "Bad binding in mwheel-scroll")))
99 (if curwin (select-window curwin)))
100 ))
99 101
100 ;;;###autoload 102 ;;;###autoload
101 (defun mwheel-install () 103 (defun mwheel-install ()
102 "Enable mouse wheel support." 104 "Enable mouse wheel support."
103 (interactive) 105 (interactive)
110 (condition-case () 112 (condition-case ()
111 (while keys 113 (while keys
112 (define-key global-map (car keys) 'mwheel-scroll) 114 (define-key global-map (car keys) 'mwheel-scroll)
113 (setq keys (cdr keys))) 115 (setq keys (cdr keys)))
114 (error nil)))) 116 (error nil))))
115 117
116 (provide 'mwheel) 118 (provide 'mwheel)
117 119
118 ;;; mwheel.el ends here 120 ;;; mwheel.el ends here