[Emacs-diffs] emacs/lisp ChangeLog loadup.el mwheel.el startu...

[Stefan Monnier]

CVSROOT:        /sources/emacs
Module name:    emacs
Changes by:     Stefan Monnier <monnier>        09/09/12 04:38:06

Modified files:
        lisp           : ChangeLog loadup.el mwheel.el startup.el 

Log message:
        * 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.

CVSWeb URLs:
http://cvs.savannah.gnu.org/viewcvs/emacs/lisp/ChangeLog?cvsroot=emacs&r1=1.16145&r2=1.16146
http://cvs.savannah.gnu.org/viewcvs/emacs/lisp/loadup.el?cvsroot=emacs&r1=1.182&r2=1.183
http://cvs.savannah.gnu.org/viewcvs/emacs/lisp/mwheel.el?cvsroot=emacs&r1=1.53&r2=1.54
http://cvs.savannah.gnu.org/viewcvs/emacs/lisp/startup.el?cvsroot=emacs&r1=1.541&r2=1.542

Patches:
Index: ChangeLog
===================================================================
RCS file: /sources/emacs/emacs/lisp/ChangeLog,v
retrieving revision 1.16145
retrieving revision 1.16146
diff -u -b -r1.16145 -r1.16146
--- ChangeLog   12 Sep 2009 03:55:46 -0000      1.16145
+++ ChangeLog   12 Sep 2009 04:38:03 -0000      1.16146
@@ -1,5 +1,13 @@
 2009-09-12  Stefan Monnier  <address@hidden>
 
+       * 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.

Index: loadup.el
===================================================================
RCS file: /sources/emacs/emacs/lisp/loadup.el,v
retrieving revision 1.182
retrieving revision 1.183
diff -u -b -r1.182 -r1.183
--- loadup.el   11 Sep 2009 06:39:21 -0000      1.182
+++ loadup.el   12 Sep 2009 04:38:06 -0000      1.183
@@ -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")))

Index: mwheel.el
===================================================================
RCS file: /sources/emacs/emacs/lisp/mwheel.el,v
retrieving revision 1.53
retrieving revision 1.54
diff -u -b -r1.53 -r1.54
--- mwheel.el   16 Aug 2009 05:49:29 -0000      1.53
+++ mwheel.el   12 Sep 2009 04:38:06 -0000      1.54
@@ -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))))
+  ;; 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)
+  ;; 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))))
-      (error nil))))
+  ;; 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

Index: startup.el
===================================================================
RCS file: /sources/emacs/emacs/lisp/startup.el,v
retrieving revision 1.541
retrieving revision 1.542
diff -u -b -r1.541 -r1.542
--- startup.el  12 Sep 2009 03:55:50 -0000      1.541
+++ startup.el  12 Sep 2009 04:38:06 -0000      1.542
@@ -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)