/[emacs]/emacs/lisp/mwheel.el
ViewVC logotype

Diff of /emacs/lisp/mwheel.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.6 by gerd, Fri Jul 27 08:41:12 2001 UTC revision 1.7 by monnier, Mon Nov 19 21:57:30 2001 UTC
# Line 70  on a normal wheel event, and the second Line 70  on a normal wheel event, and the second
70  wheel is moved with the shift key depressed.  wheel is moved with the shift key depressed.
71    
72  Each item should be the number of lines to scroll, or `nil' for near  Each item should be the number of lines to scroll, or `nil' for near
73  full screen.  full screen.  It can also be a floating point number, specifying
74    the fraction of the window to scroll.
75  A near full screen is `next-screen-context-lines' less than a full screen."  A near full screen is `next-screen-context-lines' less than a full screen."
76    :group 'mouse    :group 'mouse
77    :type '(cons    :type '(cons
78            (choice :tag "Normal"            (choice :tag "Normal"
79                    (const :tag "Full screen" :value nil)                    (const :tag "Full screen" :value nil)
80                    (integer :tag "Specific # of lines"))                    (integer :tag "Specific # of lines")
81                      (float :tag "Fraction of window"))
82            (choice :tag "Shifted"            (choice :tag "Shifted"
83                    (const :tag "Full screen" :value nil)                    (const :tag "Full screen" :value nil)
84                    (integer :tag "Specific # of lines"))))                    (integer :tag "Specific # of lines")
85                      (float :tag "Fraction of window"))))
86    
87    (defcustom mouse-wheel-progessive-speed t
88      "If non-nil, the faster the user moves the wheel, the faster the scrolling.
89    Note that this has no effect when `mouse-wheel-scroll-amount' specifies
90    a \"near full screen\" scroll."
91      :group 'mouse
92      :type 'boolean)
93    
94  (defcustom mouse-wheel-follow-mouse nil  (defcustom mouse-wheel-follow-mouse nil
95    "Whether the mouse wheel should scroll the window that the mouse is over.    "Whether the mouse wheel should scroll the window that the mouse is over.
# Line 101  This can be slightly disconcerting, but Line 111  This can be slightly disconcerting, but
111    (fset 'mwheel-event-window 'event-window))    (fset 'mwheel-event-window 'event-window))
112    
113  (defun mwheel-scroll (event)  (defun mwheel-scroll (event)
114      "Scroll up or down according to the EVENT.
115    This should only be bound to mouse buttons 4 and 5."
116    (interactive "e")    (interactive "e")
117    (let ((curwin (if mouse-wheel-follow-mouse    (let ((curwin (if mouse-wheel-follow-mouse
118                      (prog1                      (prog1
# Line 109  This can be slightly disconcerting, but Line 121  This can be slightly disconcerting, but
121          (amt (if (memq 'shift (event-modifiers event))          (amt (if (memq 'shift (event-modifiers event))
122                   (cdr mouse-wheel-scroll-amount)                   (cdr mouse-wheel-scroll-amount)
123                 (car mouse-wheel-scroll-amount))))                 (car mouse-wheel-scroll-amount))))
124        (if (floatp amt) (setq amt (1+ (truncate (* amt (window-height))))))
125        (when (and mouse-wheel-progessive-speed (numberp amt))
126          ;; When the double-mouse-N comes in, a mouse-N has been executed already,
127          ;; So by adding things up we get a squaring up (1, 3, 6, 10, 16, ...).
128          (setq amt (* amt (event-click-count event))))
129      (unwind-protect      (unwind-protect
130          (let ((button (mwheel-event-button event)))          (let ((button (mwheel-event-button event)))
131            (cond ((= button mouse-wheel-down-button) (scroll-down amt))            (cond ((= button mouse-wheel-down-button) (scroll-down amt))
# Line 117  This can be slightly disconcerting, but Line 134  This can be slightly disconcerting, but
134        (if curwin (select-window curwin)))))        (if curwin (select-window curwin)))))
135    
136    
 ;;; Note this definition must be at the end of the file, because  
 ;;; `define-minor-mode' actually calls the mode-function if the  
 ;;; associated variable is non-nil, which requires that all needed  
 ;;; functions be already defined.  
137  ;;;###autoload  ;;;###autoload
138  (define-minor-mode mouse-wheel-mode  (define-minor-mode mouse-wheel-mode
139    "Toggle mouse wheel support.    "Toggle mouse wheel support.

Legend:
Removed from v.1.6  
changed lines
  Added in v.1.7

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26