+;;;
+;;; 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 (- (* (static-if (featurep 'xemacs)
+ (event-button event)
+ (cond ((eq 'mouse-4 (event-basic-type event))
+ 4)
+ ((eq 'mouse-5 (event-basic-type event))
+ 5)))
+ 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)
+ (let ((buffer-read-only nil)
+ (inhibit-read-only t))
+ (put-text-property (point-min) (point-max)
+ 'gnus-wheel-edge direction)
+ nil))
+ (or (> edge gnus-wheel-edge-resistance)
+ (let ((buffer-read-only nil)
+ (inhibit-read-only t))
+ (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)
+
+;;;
+;;; Traditional PGP commmands
+;;;
+
+(defun gnus-summary-decrypt-article (&optional force)
+ "Decrypt the current article in traditional PGP way.
+This will have permanent effect only in mail groups.
+If FORCE is non-nil, allow editing of articles even in read-only
+groups."
+ (interactive "P")
+ (gnus-summary-select-article t)
+ (gnus-eval-in-buffer-window gnus-article-buffer
+ (save-excursion
+ (save-restriction
+ (widen)
+ (goto-char (point-min))
+ (unless (re-search-forward (car pgg-armor-header-lines) nil t)
+ (error "Not a traditional PGP message!"))
+ (let ((armor-start (match-beginning 0)))
+ (if (and (pgg-decrypt-region armor-start (point-max))
+ (or force (not (gnus-group-read-only-p))))
+ (let ((inhibit-read-only t)
+ buffer-read-only)
+ (delete-region armor-start
+ (progn
+ (re-search-forward "^-+END PGP" nil t)
+ (beginning-of-line 2)
+ (point)))
+ (insert-buffer-substring pgg-output-buffer))))))))
+
+(defun gnus-summary-verify-article ()
+ "Verify the current article in traditional PGP way."
+ (interactive)
+ (save-excursion
+ (set-buffer gnus-original-article-buffer)
+ (goto-char (point-min))
+ (unless (re-search-forward "^-+BEGIN PGP SIGNED MESSAGE" nil t)
+ (error "Not a traditional PGP message!"))
+ (re-search-forward "^-+END PGP" nil t)
+ (beginning-of-line 2)
+ (call-interactively (function pgg-verify-region))))
+
+;;;
+;;; Generic summary marking commands
+;;;
+
+(defvar gnus-summary-marking-alist
+ '((read gnus-del-mark "d")
+ (unread gnus-unread-mark "u")
+ (ticked gnus-ticked-mark "!")
+ (dormant gnus-dormant-mark "?")
+ (expirable gnus-expirable-mark "e"))
+ "An alist of names/marks/keystrokes.")
+
+(defvar gnus-summary-generic-mark-map (make-sparse-keymap))
+(defvar gnus-summary-mark-map)
+
+(defun gnus-summary-make-all-marking-commands ()
+ (define-key gnus-summary-mark-map "M" gnus-summary-generic-mark-map)
+ (dolist (elem gnus-summary-marking-alist)
+ (apply 'gnus-summary-make-marking-command elem)))
+
+(defun gnus-summary-make-marking-command (name mark keystroke)
+ (let ((map (make-sparse-keymap)))
+ (define-key gnus-summary-generic-mark-map keystroke map)
+ (dolist (lway `((next "next" next nil "n")
+ (next-unread "next unread" next t "N")
+ (prev "previous" prev nil "p")
+ (prev-unread "previous unread" prev t "P")
+ (nomove "" nil nil ,keystroke)))
+ (let ((func (gnus-summary-make-marking-command-1
+ mark (car lway) lway name)))
+ (setq func (eval func))
+ (define-key map (nth 4 lway) func)))))
+
+(defun gnus-summary-make-marking-command-1 (mark way lway name)
+ `(defun ,(intern
+ (format "gnus-summary-put-mark-as-%s%s"
+ name (if (eq way 'nomove)
+ ""
+ (concat "-" (symbol-name way)))))
+ (n)
+ ,(format
+ "Mark the current article as %s%s.
+If N, the prefix, then repeat N times.
+If N is negative, move in reverse order.
+The difference between N and the actual number of articles marked is
+returned."
+ name (car (cdr lway)))
+ (interactive "p")
+ (gnus-summary-generic-mark n ,mark ',(nth 2 lway) ,(nth 3 lway))))
+
+(defun gnus-summary-generic-mark (n mark move unread)
+ "Mark N articles with MARK."
+ (unless (eq major-mode 'gnus-summary-mode)
+ (error "This command can only be used in the summary buffer"))
+ (gnus-summary-show-thread)
+ (let ((nummove
+ (cond
+ ((eq move 'next) 1)
+ ((eq move 'prev) -1)
+ (t 0))))
+ (if (zerop nummove)
+ (setq n 1)
+ (when (< n 0)
+ (setq n (abs n)
+ nummove (* -1 nummove))))
+ (while (and (> n 0)
+ (gnus-summary-mark-article nil mark)
+ (zerop (gnus-summary-next-subject nummove unread t)))
+ (setq n (1- n)))
+ (when (/= 0 n)
+ (gnus-message 7 "No more %sarticles" (if mark "" "unread ")))
+ (gnus-summary-recenter)
+ (gnus-summary-position-point)
+ (gnus-set-mode-line 'summary)
+ n))
+
+(gnus-summary-make-all-marking-commands)
+