1;;; gnus-dup.el --- suppression of duplicate articles in Gnus
2
3;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
4;;   2005, 2006, 2007 Free Software Foundation, Inc.
5
6;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
7;; Keywords: news
8
9;; This file is part of GNU Emacs.
10
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)
14;; any later version.
15
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.
20
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.
25
26;;; Commentary:
27
28;; This package tries to mark articles as read the second time the
29;; user reads a copy.  This is useful if the server doesn't support
30;; Xref properly, or if the user reads the same group from several
31;; servers.
32
33;;; Code:
34
35(eval-when-compile (require 'cl))
36
37(require 'gnus)
38(require 'gnus-art)
39
40(defgroup gnus-duplicate nil
41  "Suppression of duplicate articles."
42  :group 'gnus)
43
44(defcustom gnus-save-duplicate-list nil
45  "*If non-nil, save the duplicate list when shutting down Gnus.
46If nil, duplicate suppression will only work on duplicates
47seen in the same session."
48  :group 'gnus-duplicate
49  :type 'boolean)
50
51(defcustom gnus-duplicate-list-length 10000
52  "*The number of Message-IDs to keep in the duplicate suppression list."
53  :group 'gnus-duplicate
54  :type 'integer)
55
56(defcustom gnus-duplicate-file (nnheader-concat gnus-directory "suppression")
57  "*The name of the file to store the duplicate suppression list."
58  :group 'gnus-duplicate
59  :type 'file)
60
61;;; Internal variables
62
63(defvar gnus-dup-list nil)
64(defvar gnus-dup-hashtb nil)
65
66(defvar gnus-dup-list-dirty nil)
67
68;;;
69;;; Starting and stopping
70;;;
71
72(gnus-add-shutdown 'gnus-dup-close 'gnus)
73
74(defun gnus-dup-close ()
75  "Possibly save the duplicate suppression list and shut down the subsystem."
76  (gnus-dup-save)
77  (setq gnus-dup-list nil
78	gnus-dup-hashtb nil
79	gnus-dup-list-dirty nil))
80
81(defun gnus-dup-open ()
82  "Possibly read the duplicate suppression list and start the subsystem."
83  (if gnus-save-duplicate-list
84      (gnus-dup-read)
85    (setq gnus-dup-list nil))
86  (setq gnus-dup-hashtb (gnus-make-hashtable gnus-duplicate-list-length))
87  ;; Enter all Message-IDs into the hash table.
88  (let ((list gnus-dup-list)
89	(obarray gnus-dup-hashtb))
90    (while list
91      (intern (pop list)))))
92
93(defun gnus-dup-read ()
94  "Read the duplicate suppression list."
95  (setq gnus-dup-list nil)
96  (when (file-exists-p gnus-duplicate-file)
97    (load gnus-duplicate-file t t t)))
98
99(defun gnus-dup-save ()
100  "Save the duplicate suppression list."
101  (when (and gnus-save-duplicate-list
102	     gnus-dup-list-dirty)
103    (with-temp-file gnus-duplicate-file
104      (gnus-prin1 `(setq gnus-dup-list ',gnus-dup-list))))
105  (setq gnus-dup-list-dirty nil))
106
107;;;
108;;; Interface functions
109;;;
110
111(defun gnus-dup-enter-articles ()
112  "Enter articles from the current group for future duplicate suppression."
113  (unless gnus-dup-list
114    (gnus-dup-open))
115  (setq gnus-dup-list-dirty t)		; mark list for saving
116  (let ((data gnus-newsgroup-data)
117	datum msgid)
118    ;; Enter the Message-IDs of all read articles into the list
119    ;; and hash table.
120    (while (setq datum (pop data))
121      (when (and (not (gnus-data-pseudo-p datum))
122		 (> (gnus-data-number datum) 0)
123		 (not (memq (gnus-data-number datum) gnus-newsgroup-unreads))
124		 (not (= (gnus-data-mark datum) gnus-canceled-mark))
125		 (setq msgid (mail-header-id (gnus-data-header datum)))
126		 (not (nnheader-fake-message-id-p msgid))
127		 (not (intern-soft msgid gnus-dup-hashtb)))
128	(push msgid gnus-dup-list)
129	(intern msgid gnus-dup-hashtb))))
130  ;; Chop off excess Message-IDs from the list.
131  (let ((end (nthcdr gnus-duplicate-list-length gnus-dup-list)))
132    (when end
133      (setcdr end nil))))
134
135(defun gnus-dup-suppress-articles ()
136  "Mark duplicate articles as read."
137  (unless gnus-dup-list
138    (gnus-dup-open))
139  (gnus-message 6 "Suppressing duplicates...")
140  (let ((headers gnus-newsgroup-headers)
141	(auto (and gnus-newsgroup-auto-expire
142		   (memq gnus-duplicate-mark gnus-auto-expirable-marks)))
143	number header)
144    (while (setq header (pop headers))
145      (when (and (intern-soft (mail-header-id header) gnus-dup-hashtb)
146		 (gnus-summary-article-unread-p (mail-header-number header)))
147	(setq gnus-newsgroup-unreads
148	      (delq (setq number (mail-header-number header))
149		    gnus-newsgroup-unreads))
150	(if (not auto)
151	    (push (cons number gnus-duplicate-mark) gnus-newsgroup-reads)
152	  (push number gnus-newsgroup-expirable)
153	  (push (cons number gnus-expirable-mark) gnus-newsgroup-reads)))))
154  (gnus-message 6 "Suppressing duplicates...done"))
155
156(defun gnus-dup-unsuppress-article (article)
157  "Stop suppression of ARTICLE."
158  (let ((id (mail-header-id (gnus-data-header (gnus-data-find article)))))
159    (when id
160      (setq gnus-dup-list-dirty t)
161      (setq gnus-dup-list (delete id gnus-dup-list))
162      (unintern id gnus-dup-hashtb))))
163
164(provide 'gnus-dup)
165
166;;; arch-tag: 903e94db-7b00-4d19-83ee-cf34a81fa5fb
167;;; gnus-dup.el ends here
168