From: Stefan Monnier Date: Sat, 12 Sep 2009 04:38:03 +0000 (+0000) Subject: * mwheel.el (mwheel-installed-bindings): New var. X-Git-Tag: emacs-pretest-23.1.90~1355 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=ab5c0fcd35dcdf465a597ed83e5783bbbf70eff1;p=emacs.git * mwheel.el (mwheel-installed-bindings): New var. (mouse-wheel-mode): Use it, so as to make sure we really remove all the bindings we set last time. Use custom-initialize-delay. * loadup.el: Load mwheel after term/*-win.el. * startup.el (command-line): Don't reevaluate mouse-wheel-down-event and mouse-wheel-up-event now that their first evaluation is done sufficiently late to be correct. --- diff --git a/lisp/ChangeLog b/lisp/ChangeLog index ac9426aebe7..9bd63cf99aa 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,5 +1,13 @@ 2009-09-12 Stefan Monnier + * mwheel.el (mwheel-installed-bindings): New var. + (mouse-wheel-mode): Use it, so as to make sure we really remove all + the bindings we set last time. Use custom-initialize-delay. + * loadup.el: Load mwheel after term/*-win.el. + * startup.el (command-line): Don't reevaluate mouse-wheel-down-event + and mouse-wheel-up-event now that their first evaluation is done + sufficiently late to be correct. + * startup.el (tutorial-directory): Make it a defcustom. Use custom-initialize-delay rather than eval-at-startup to set it. * image.el (image-load-path): Make it a defcustom. diff --git a/lisp/loadup.el b/lisp/loadup.el index 8fd2eb90736..da7613bee25 100644 --- a/lisp/loadup.el +++ b/lisp/loadup.el @@ -180,7 +180,6 @@ (load "image") (load "international/fontset") (load "dnd") - (load "mwheel") (load "tool-bar"))) (if (featurep 'x) (progn @@ -213,6 +212,10 @@ (progn (load "emacs-lisp/easymenu") ;; for platform-related menu adjustments (load "term/ns-win"))) +(if (fboundp 'x-create-frame) + ;; Do it after loading term/foo-win.el since the value of the + ;; mouse-wheel-*-event vars depends on those files being loaded or not. + (load "mwheel")) (if (fboundp 'atan) ; preload some constants and (progn ; floating pt. functions if we have float support. (load "emacs-lisp/float-sup"))) diff --git a/lisp/mwheel.el b/lisp/mwheel.el index 37980279a28..d457679d4f2 100644 --- a/lisp/mwheel.el +++ b/lisp/mwheel.el @@ -46,11 +46,9 @@ ;; new button is bound to mwheel-scroll. (defun mouse-wheel-change-button (var button) - (let ((active mouse-wheel-mode)) - ;; Deactivate before changing the setting. - (when active (mouse-wheel-mode -1)) - (set-default var button) - (when active (mouse-wheel-mode 1)))) + (set-default var button) + ;; Sync the bindings. + (when mouse-wheel-mode (mouse-wheel-mode 1))) (defvar mouse-wheel-down-button 4) (make-obsolete-variable 'mouse-wheel-down-button @@ -239,32 +237,33 @@ This should only be bound to mouse buttons 4 and 5." (run-with-timer mouse-wheel-inhibit-click-time nil 'mwheel-inhibit-click-timeout)))) +(defvar mwheel-installed-bindings nil) + ;;;###autoload (define-minor-mode mouse-wheel-mode "Toggle mouse wheel support. With prefix argument ARG, turn on if positive, otherwise off. Return non-nil if the new state is enabled." + :init-value t + ;; We'd like to use custom-initialize-set here so the setup is done + ;; before dumping, but at the point where the defcustom is evaluated, + ;; the corresponding function isn't defined yet, so + ;; custom-initialize-set signals an error. + :initialize 'custom-initialize-delay :global t :group 'mouse - (let* ((dn mouse-wheel-down-event) - (up mouse-wheel-up-event) - (keys - (nconc (mapcar (lambda (amt) `[(,@(if (consp amt) (car amt)) ,up)]) - mouse-wheel-scroll-amount) - (mapcar (lambda (amt) `[(,@(if (consp amt) (car amt)) ,dn)]) - mouse-wheel-scroll-amount)))) - ;; This condition-case is here because Emacs 19 will throw an error - ;; if you try to define a key that it does not know about. I for one - ;; prefer to just unconditionally do a mwheel-install in my .emacs, so - ;; that if the wheeled-mouse is there, it just works, and this way it - ;; doesn't yell at me if I'm on my laptop or another machine, etc. - (condition-case () - (dolist (key keys) - (cond (mouse-wheel-mode - (global-set-key key 'mwheel-scroll)) - ((eq (lookup-key (current-global-map) key) 'mwheel-scroll) - (global-unset-key key)))) - (error nil)))) + ;; Remove previous bindings, if any. + (while mwheel-installed-bindings + (let ((key (pop mwheel-installed-bindings))) + (when (eq (lookup-key (current-global-map) key) 'mwheel-scroll) + (global-unset-key key)))) + ;; Setup bindings as needed. + (when mouse-wheel-mode + (dolist (event (list mouse-wheel-down-event mouse-wheel-up-event)) + (dolist (key (mapcar (lambda (amt) `[(,@(if (consp amt) (car amt)) ,event)]) + mouse-wheel-scroll-amount)) + (global-set-key key 'mwheel-scroll) + (push key mwheel-installed-bindings))))) ;;; Compatibility entry point ;;;###autoload diff --git a/lisp/startup.el b/lisp/startup.el index 5d5f23e4453..d5133290ba8 100644 --- a/lisp/startup.el +++ b/lisp/startup.el @@ -920,8 +920,6 @@ opening the first frame (e.g. open a connection to an X server).") (custom-reevaluate-setting 'blink-cursor-mode) (custom-reevaluate-setting 'tooltip-mode) (custom-reevaluate-setting 'global-font-lock-mode) - (custom-reevaluate-setting 'mouse-wheel-down-event) - (custom-reevaluate-setting 'mouse-wheel-up-event) (custom-reevaluate-setting 'file-name-shadow-mode) (custom-reevaluate-setting 'send-mail-function) (custom-reevaluate-setting 'focus-follows-mouse)