From: yamaoka <yamaoka>
Date: Mon, 16 Aug 1999 22:26:05 +0000 (+0000)
Subject: (TopLevel): Add `gnus-wheel-install' to `gnus-summary-mode-hook'.
X-Git-Tag: t-gnus-6_13_0-03~2
X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=d77c8ed258bf78141ba367702acd8051571e1b4c;p=elisp%2Fgnus.git-

(TopLevel): Add `gnus-wheel-install' to `gnus-summary-mode-hook'.
(gnus-use-wheel): New variable.
(gnus-wheel-scroll-amount): New variable.
(gnus-wheel-edge-resistance): New variable.
(gnus-wheel-summary-scroll): New function.
(gnus-wheel-install): New function.
---

diff --git a/lisp/gnus-sum.el b/lisp/gnus-sum.el
index 0b0f674..08afcdf 100644
--- a/lisp/gnus-sum.el
+++ b/lisp/gnus-sum.el
@@ -866,6 +866,25 @@ This variable uses the same syntax as `gnus-emphasis-alist'."
 					     gnus-emphasis-highlight-words)))))
   :group 'gnus-summary-visual)
 
+(defcustom gnus-use-wheel nil
+  "Use Intelli-mouse on summary movement"
+  :type 'boolean
+  :group 'gnus-summary-maneuvering)
+
+(defcustom gnus-wheel-scroll-amount '(5 . 1)
+  "Amount to scroll messages by spinning the mouse wheel.
+This is actually a cons cell, where the first item is the amount to scroll
+on a normal wheel event, and the second is the amount to scroll when the
+wheel is moved with the shift key depressed."
+  :type '(cons (integer :tag "Shift") integer)
+  :group 'gnus-summary-maneuvering)
+
+(defcustom gnus-wheel-edge-resistance 2
+  "How hard it should be to change the current article
+by moving the mouse over the edge of the article window."
+  :type 'integer
+  :group 'gnus-summary-maneuvering)
+
 ;;; Internal variables
 
 (defvar gnus-scores-exclude-files nil)
@@ -9512,6 +9531,56 @@ treated as multipart/mixed."
     (gnus-summary-show-article)))
 
 ;;;
+;;; Intelli-mouse commmands
+;;;
+
+(defun gnus-wheel-summary-scroll (event)
+  (interactive "e")
+  (let ((amount (if (memq 'shift (event-modifiers event))
+		    (car gnus-wheel-scroll-amount)
+		  (cdr gnus-wheel-scroll-amount)))
+	(direction (- (* (event-button event) 2) 9))
+	edge)
+    (gnus-summary-scroll-up (* amount direction))
+    (when (gnus-eval-in-buffer-window gnus-article-buffer
+	    (save-restriction 
+	      (widen) 
+	      (and (if (< 0 direction)
+		       (gnus-article-next-page 0)
+		     (gnus-article-prev-page 0)
+		     (bobp))
+		   (if (setq edge (get-text-property 
+				   (point-min) 'gnus-wheel-edge))
+		       (setq edge (* edge direction))
+		     (setq edge -1))
+		   (or (plusp edge)
+		       (progn
+			 (put-text-property (point-min) (point-max) 
+					    'gnus-wheel-edge direction)
+			 nil))
+		   (or (> edge gnus-wheel-edge-resistance)
+		       (progn
+			 (put-text-property (point-min) (point-max) 
+					    'gnus-wheel-edge 
+					    (* (1+ edge) direction))
+			 nil))
+		   (eq last-command 'gnus-wheel-summary-scroll))
+	      ))
+      (gnus-summary-next-article nil nil (minusp direction)))
+    ))
+
+(defun gnus-wheel-install ()
+  "Enable mouse wheel support on summary window."
+  (when gnus-use-wheel
+    (let ((keys 
+	   '([(mouse-4)] [(shift mouse-4)] [(mouse-5)] [(shift mouse-5)])))
+      (dolist (key keys)
+	(define-key gnus-summary-mode-map key
+	  'gnus-wheel-summary-scroll)))))
+
+(add-hook 'gnus-summary-mode-hook 'gnus-wheel-install)
+
+;;;
 ;;; with article
 ;;;