Mercurial > emacs

--- a/lisp/ChangeLog	Sat Sep 12 03:55:46 2009 +0000
+++ b/lisp/ChangeLog	Sat Sep 12 04:38:03 2009 +0000
@@ -1,5 +1,13 @@
 2009-09-12  Stefan Monnier  <monnier@iro.umontreal.ca>

+	* 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.
--- a/lisp/loadup.el	Sat Sep 12 03:55:46 2009 +0000
+++ b/lisp/loadup.el	Sat Sep 12 04:38:03 2009 +0000
@@ -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")))
--- a/lisp/mwheel.el	Sat Sep 12 03:55:46 2009 +0000
+++ b/lisp/mwheel.el	Sat Sep 12 04:38:03 2009 +0000
@@ -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 @@
 	  (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
--- a/lisp/startup.el	Sat Sep 12 03:55:46 2009 +0000
+++ b/lisp/startup.el	Sat Sep 12 04:38:03 2009 +0000
@@ -920,8 +920,6 @@
   (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)