lisp/gnus/gnus-dup.el

0 ;;; gnus-dup.el --- suppression of duplicate articles in Gnus
6 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
37 (require 'gnus)
38 (require 'gnus-art)
40 (defgroup gnus-duplicate nil
42   :group 'gnus)
44 (defcustom gnus-save-duplicate-list nil
48   :group 'gnus-duplicate
51 (defcustom gnus-duplicate-list-length 10000
53   :group 'gnus-duplicate
56 (defcustom gnus-duplicate-file (nnheader-concat gnus-directory "suppression")
58   :group 'gnus-duplicate
63 (defvar gnus-dup-list nil)
64 (defvar gnus-dup-hashtb nil)
66 (defvar gnus-dup-list-dirty nil)
72 (gnus-add-shutdown 'gnus-dup-close 'gnus)
74 (defun gnus-dup-close ()
76   (gnus-dup-save)
77   (setq gnus-dup-list nil
78 	gnus-dup-hashtb nil
79 	gnus-dup-list-dirty nil))
81 (defun gnus-dup-open ()
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))
88   (let ((list gnus-dup-list)
89 	(obarray gnus-dup-hashtb))
93 (defun gnus-dup-read ()
95   (setq gnus-dup-list nil)
96   (when (file-exists-p gnus-duplicate-file)
97     (load gnus-duplicate-file t t t)))
99 (defun gnus-dup-save ()
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))
111 (defun gnus-dup-enter-articles ()
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)
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)))
127 		 (not (intern-soft msgid gnus-dup-hashtb)))
128 	(push msgid gnus-dup-list)
129 	(intern msgid gnus-dup-hashtb))))
131   (let ((end (nthcdr gnus-duplicate-list-length gnus-dup-list)))
135 (defun gnus-dup-suppress-articles ()
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)))
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
149 		    gnus-newsgroup-unreads))
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"))
156 (defun gnus-dup-unsuppress-article (article)
158   (let ((id (mail-header-id (gnus-data-header (gnus-data-find article)))))
160       (setq gnus-dup-list-dirty t)
161       (setq gnus-dup-list (delete id gnus-dup-list))
162       (unintern id gnus-dup-hashtb))))
164 (provide 'gnus-dup)
167 ;;; gnus-dup.el ends here