Commit ab5c0fcd authored by Stefan Monnier's avatar Stefan Monnier
Browse files

* 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.
parent 45448e64
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.
......
......@@ -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")))
......
......@@ -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
......
......@@ -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)
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment