1 ;;; gnus-salt.el --- alternate summary mode interfaces for Gnus
3 ;; Copyright (C) 1996, 1997, 1998, 1999, 2001, 2002, 2003, 2004,
4 ;; 2005 Free Software Foundation, Inc.
6 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
9 ;; This file is part of GNU Emacs.
11 ;; GNU Emacs is free software; you can redistribute it and/or modify
12 ;; it under the terms of the GNU General Public License as published by
13 ;; the Free Software Foundation; either version 2, or (at your option)
16 ;; GNU Emacs is distributed in the hope that it will be useful,
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19 ;; GNU General Public License for more details.
21 ;; You should have received a copy of the GNU General Public License
22 ;; along with GNU Emacs; see the file COPYING. If not, write to the
23 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
24 ;; Boston, MA 02110-1301, USA.
30 (eval-when-compile (require 'cl))
40 (defvar gnus-pick-mode nil
41 "Minor mode for providing a pick-and-read interface in Gnus
44 (defcustom gnus-pick-display-summary nil
45 "*Display summary while reading."
47 :group 'gnus-summary-pick)
49 (defcustom gnus-pick-mode-hook nil
50 "Hook run in summary pick mode buffers."
52 :group 'gnus-summary-pick)
54 (when (featurep 'xemacs)
55 (add-hook 'gnus-pick-mode-hook 'gnus-xmas-pick-menu-add))
57 (defcustom gnus-mark-unpicked-articles-as-read nil
58 "*If non-nil, mark all unpicked articles as read."
60 :group 'gnus-summary-pick)
62 (defcustom gnus-pick-elegant-flow t
63 "If non-nil, `gnus-pick-start-reading' runs
64 `gnus-summary-next-group' when no articles have been picked."
66 :group 'gnus-summary-pick)
68 (defcustom gnus-summary-pick-line-format
69 "%-5P %U\%R\%z\%I\%(%[%4L: %-23,23n%]%) %s\n"
70 "*The format specification of the lines in pick buffers.
71 It accepts the same format specs that `gnus-summary-line-format' does."
73 :group 'gnus-summary-pick)
75 ;;; Internal variables.
77 (defvar gnus-pick-mode-map nil)
79 (unless gnus-pick-mode-map
80 (setq gnus-pick-mode-map (make-sparse-keymap))
82 (gnus-define-keys gnus-pick-mode-map
83 " " gnus-pick-next-page
84 "u" gnus-pick-unmark-article-or-thread
85 "." gnus-pick-article-or-thread
86 gnus-down-mouse-2 gnus-pick-mouse-pick-region
87 "\r" gnus-pick-start-reading))
89 (defun gnus-pick-make-menu-bar ()
90 (unless (boundp 'gnus-pick-menu)
92 gnus-pick-menu gnus-pick-mode-map ""
95 ["Article" gnus-summary-mark-as-processable t]
96 ["Thread" gnus-uu-mark-thread t]
97 ["Region" gnus-uu-mark-region t]
98 ["Regexp" gnus-uu-mark-by-regexp t]
99 ["Buffer" gnus-uu-mark-buffer t])
101 ["Article" gnus-summary-unmark-as-processable t]
102 ["Thread" gnus-uu-unmark-thread t]
103 ["Region" gnus-uu-unmark-region t]
104 ["Regexp" gnus-uu-unmark-by-regexp t]
105 ["Buffer" gnus-summary-unmark-all-processable t])
106 ["Start reading" gnus-pick-start-reading t]
107 ["Switch pick mode off" gnus-pick-mode gnus-pick-mode]))))
109 (defun gnus-pick-mode (&optional arg)
110 "Minor mode for providing a pick-and-read interface in Gnus summary buffers.
112 \\{gnus-pick-mode-map}"
114 (when (eq major-mode 'gnus-summary-mode)
115 (if (not (set (make-local-variable 'gnus-pick-mode)
116 (if (null arg) (not gnus-pick-mode)
117 (> (prefix-numeric-value arg) 0))))
118 (remove-hook 'gnus-message-setup-hook 'gnus-pick-setup-message)
119 ;; Make sure that we don't select any articles upon group entry.
120 (set (make-local-variable 'gnus-auto-select-first) nil)
121 ;; Change line format.
122 (setq gnus-summary-line-format gnus-summary-pick-line-format)
123 (setq gnus-summary-line-format-spec nil)
124 (gnus-update-format-specifications nil 'summary)
125 (gnus-update-summary-mark-positions)
126 (add-hook 'gnus-message-setup-hook 'gnus-pick-setup-message)
127 (set (make-local-variable 'gnus-summary-goto-unread) 'never)
129 (when (gnus-visual-p 'pick-menu 'menu)
130 (gnus-pick-make-menu-bar))
131 (add-minor-mode 'gnus-pick-mode " Pick" gnus-pick-mode-map)
132 (gnus-run-hooks 'gnus-pick-mode-hook))))
134 (defun gnus-pick-setup-message ()
135 "Make Message do the right thing on exit."
136 (when (and (gnus-buffer-live-p gnus-summary-buffer)
138 (set-buffer gnus-summary-buffer)
141 '(gnus-configure-windows ,gnus-current-window-configuration t)
142 'send 'exit 'postpone 'kill)))
144 (defvar gnus-pick-line-number 1)
145 (defun gnus-pick-line-number ()
146 "Return the current line number."
148 (setq gnus-pick-line-number 1)
149 (incf gnus-pick-line-number)))
151 (defun gnus-pick-start-reading (&optional catch-up)
152 "Start reading the picked articles.
153 If given a prefix, mark all unpicked articles as read."
155 (if gnus-newsgroup-processable
157 (gnus-summary-limit-to-articles nil)
158 (when (or catch-up gnus-mark-unpicked-articles-as-read)
159 (gnus-summary-limit-mark-excluded-as-read))
160 (gnus-summary-first-article)
161 (gnus-configure-windows
162 (if gnus-pick-display-summary 'article 'pick) t))
163 (if gnus-pick-elegant-flow
165 (when (or catch-up gnus-mark-unpicked-articles-as-read)
166 (gnus-summary-catchup nil t))
167 (if (gnus-group-quit-config gnus-newsgroup-name)
169 (gnus-summary-next-group)))
170 (error "No articles have been picked"))))
172 (defun gnus-pick-goto-article (arg)
173 "Go to the article number indicated by ARG.
174 If ARG is an invalid article number, then stay on current line."
177 (goto-char (point-min))
178 (when (zerop (forward-line (1- (prefix-numeric-value arg))))
181 (gnus-error 2 "No such line: %s" arg)
184 (defun gnus-pick-article (&optional arg)
185 "Pick the article on the current line.
186 If ARG, pick the article on that line instead."
189 (gnus-pick-goto-article arg))
190 (gnus-summary-mark-as-processable 1))
192 (defun gnus-pick-article-or-thread (&optional arg)
193 "If `gnus-thread-hide-subtree' is t, then pick the thread on the current line.
194 Otherwise pick the article on the current line.
195 If ARG, pick the article/thread on that line instead."
198 (gnus-pick-goto-article arg))
199 (if gnus-thread-hide-subtree
202 (gnus-uu-mark-thread))
204 (gnus-summary-mark-as-processable 1)))
206 (defun gnus-pick-unmark-article-or-thread (&optional arg)
207 "If `gnus-thread-hide-subtree' is t, then unmark the thread on current line.
208 Otherwise unmark the article on current line.
209 If ARG, unmark thread/article on that line instead."
212 (gnus-pick-goto-article arg))
213 (if gnus-thread-hide-subtree
215 (gnus-uu-unmark-thread))
216 (gnus-summary-unmark-as-processable 1)))
218 (defun gnus-pick-mouse-pick (e)
222 (gnus-summary-mark-as-processable 1)))
224 (defun gnus-pick-mouse-pick-region (start-event)
225 "Pick articles that the mouse is dragged over.
226 This must be bound to a button-down mouse event."
228 (mouse-minibuffer-check start-event)
229 (let* ((echo-keystrokes 0)
230 (start-posn (event-start start-event))
231 (start-point (posn-point start-posn))
232 (start-line (1+ (count-lines (point-min) start-point)))
233 (start-window (posn-window start-posn))
234 (bounds (gnus-window-edges start-window))
236 (bottom (if (window-minibuffer-p start-window)
238 ;; Don't count the mode line.
239 (1- (nth 3 bounds))))
240 (click-count (1- (event-click-count start-event))))
241 (setq mouse-selection-click-count click-count)
242 (setq mouse-selection-click-count-buffer (current-buffer))
243 (mouse-set-point start-event)
244 ;; In case the down click is in the middle of some intangible text,
245 ;; use the end of that text, and put it in START-POINT.
246 (when (< (point) start-point)
247 (goto-char start-point))
249 (setq start-point (point))
250 ;; end-of-range is used only in the single-click case.
251 ;; It is the place where the drag has reached so far
252 ;; (but not outside the window where the drag started).
253 (let (event end end-point (end-of-range (point)))
256 (setq event (cdr (gnus-read-event-char)))
257 (or (mouse-movement-p event)
258 (eq (car-safe event) 'switch-frame)))
259 (if (eq (car-safe event) 'switch-frame)
261 (setq end (event-end event)
262 end-point (posn-point end))
265 ;; Are we moving within the original window?
266 ((and (eq (posn-window end) start-window)
267 (integer-or-marker-p end-point))
268 ;; Go to START-POINT first, so that when we move to END-POINT,
269 ;; if it's in the middle of intangible text,
270 ;; point jumps in the direction away from START-POINT.
271 (goto-char start-point)
272 (goto-char end-point)
274 ;; In case the user moved his mouse really fast, pick
275 ;; articles on the line between this one and the last one.
276 (let* ((this-line (1+ (count-lines (point-min) end-point)))
277 (min-line (min this-line start-line))
278 (max-line (max this-line start-line)))
279 ;; Why not use `forward-line'? --Stef
280 (while (< min-line max-line)
283 (setq min-line (1+ min-line)))
284 (setq start-line this-line))
285 (when (zerop (% click-count 3))
286 (setq end-of-range (point))))
288 (let ((mouse-row (cdr (cdr (mouse-position)))))
292 (mouse-scroll-subr start-window (- mouse-row top)))
293 ((>= mouse-row bottom)
294 (mouse-scroll-subr start-window