1997-04-16 22:13:18 +00:00
|
|
|
;;; gnus-dup.el --- suppression of duplicate articles in Gnus
|
2005-08-06 19:51:42 +00:00
|
|
|
|
2006-12-10 01:48:52 +00:00
|
|
|
;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
|
2007-01-21 03:53:13 +00:00
|
|
|
;; 2005, 2006, 2007 Free Software Foundation, Inc.
|
1997-04-16 22:13:18 +00:00
|
|
|
|
1999-02-20 14:05:57 +00:00
|
|
|
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
|
1997-04-16 22:13:18 +00:00
|
|
|
;; Keywords: news
|
|
|
|
|
|
|
|
;; This file is part of GNU Emacs.
|
|
|
|
|
|
|
|
;; GNU Emacs is free software; you can redistribute it and/or modify
|
|
|
|
;; it under the terms of the GNU General Public License as published by
|
2007-07-25 04:24:43 +00:00
|
|
|
;; the Free Software Foundation; either version 3, or (at your option)
|
1997-04-16 22:13:18 +00:00
|
|
|
;; any later version.
|
|
|
|
|
|
|
|
;; GNU Emacs is distributed in the hope that it will be useful,
|
|
|
|
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
|
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
|
|
;; GNU General Public License for more details.
|
|
|
|
|
|
|
|
;; You should have received a copy of the GNU General Public License
|
|
|
|
;; along with GNU Emacs; see the file COPYING. If not, write to the
|
2005-07-04 17:55:18 +00:00
|
|
|
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
|
|
|
|
;; Boston, MA 02110-1301, USA.
|
1997-04-16 22:13:18 +00:00
|
|
|
|
|
|
|
;;; Commentary:
|
|
|
|
|
|
|
|
;; This package tries to mark articles as read the second time the
|
|
|
|
;; user reads a copy. This is useful if the server doesn't support
|
|
|
|
;; Xref properly, or if the user reads the same group from several
|
|
|
|
;; servers.
|
|
|
|
|
|
|
|
;;; Code:
|
|
|
|
|
1997-08-23 20:23:37 +00:00
|
|
|
(eval-when-compile (require 'cl))
|
|
|
|
|
1997-04-16 22:13:18 +00:00
|
|
|
(require 'gnus)
|
|
|
|
(require 'gnus-art)
|
|
|
|
|
|
|
|
(defgroup gnus-duplicate nil
|
|
|
|
"Suppression of duplicate articles."
|
|
|
|
:group 'gnus)
|
|
|
|
|
|
|
|
(defcustom gnus-save-duplicate-list nil
|
|
|
|
"*If non-nil, save the duplicate list when shutting down Gnus.
|
|
|
|
If nil, duplicate suppression will only work on duplicates
|
|
|
|
seen in the same session."
|
|
|
|
:group 'gnus-duplicate
|
|
|
|
:type 'boolean)
|
|
|
|
|
|
|
|
(defcustom gnus-duplicate-list-length 10000
|
|
|
|
"*The number of Message-IDs to keep in the duplicate suppression list."
|
|
|
|
:group 'gnus-duplicate
|
|
|
|
:type 'integer)
|
|
|
|
|
|
|
|
(defcustom gnus-duplicate-file (nnheader-concat gnus-directory "suppression")
|
|
|
|
"*The name of the file to store the duplicate suppression list."
|
|
|
|
:group 'gnus-duplicate
|
|
|
|
:type 'file)
|
|
|
|
|
|
|
|
;;; Internal variables
|
|
|
|
|
|
|
|
(defvar gnus-dup-list nil)
|
|
|
|
(defvar gnus-dup-hashtb nil)
|
|
|
|
|
|
|
|
(defvar gnus-dup-list-dirty nil)
|
|
|
|
|
|
|
|
;;;
|
|
|
|
;;; Starting and stopping
|
|
|
|
;;;
|
|
|
|
|
|
|
|
(gnus-add-shutdown 'gnus-dup-close 'gnus)
|
|
|
|
|
|
|
|
(defun gnus-dup-close ()
|
|
|
|
"Possibly save the duplicate suppression list and shut down the subsystem."
|
|
|
|
(gnus-dup-save)
|
|
|
|
(setq gnus-dup-list nil
|
|
|
|
gnus-dup-hashtb nil
|
|
|
|
gnus-dup-list-dirty nil))
|
|
|
|
|
|
|
|
(defun gnus-dup-open ()
|
|
|
|
"Possibly read the duplicate suppression list and start the subsystem."
|
|
|
|
(if gnus-save-duplicate-list
|
|
|
|
(gnus-dup-read)
|
|
|
|
(setq gnus-dup-list nil))
|
|
|
|
(setq gnus-dup-hashtb (gnus-make-hashtable gnus-duplicate-list-length))
|
|
|
|
;; Enter all Message-IDs into the hash table.
|
|
|
|
(let ((list gnus-dup-list)
|
|
|
|
(obarray gnus-dup-hashtb))
|
|
|
|
(while list
|
|
|
|
(intern (pop list)))))
|
|
|
|
|
|
|
|
(defun gnus-dup-read ()
|
|
|
|
"Read the duplicate suppression list."
|
|
|
|
(setq gnus-dup-list nil)
|
|
|
|
(when (file-exists-p gnus-duplicate-file)
|
|
|
|
(load gnus-duplicate-file t t t)))
|
|
|
|
|
|
|
|
(defun gnus-dup-save ()
|
|
|
|
"Save the duplicate suppression list."
|
|
|
|
(when (and gnus-save-duplicate-list
|
|
|
|
gnus-dup-list-dirty)
|
2000-09-19 13:37:09 +00:00
|
|
|
(with-temp-file gnus-duplicate-file
|
1997-04-16 22:13:18 +00:00
|
|
|
(gnus-prin1 `(setq gnus-dup-list ',gnus-dup-list))))
|
|
|
|
(setq gnus-dup-list-dirty nil))
|
|
|
|
|
|
|
|
;;;
|
|
|
|
;;; Interface functions
|
|
|
|
;;;
|
|
|
|
|
|
|
|
(defun gnus-dup-enter-articles ()
|
|
|
|
"Enter articles from the current group for future duplicate suppression."
|
|
|
|
(unless gnus-dup-list
|
|
|
|
(gnus-dup-open))
|
|
|
|
(setq gnus-dup-list-dirty t) ; mark list for saving
|
|
|
|
(let ((data gnus-newsgroup-data)
|
2004-09-04 13:13:48 +00:00
|
|
|
datum msgid)
|
1997-04-16 22:13:18 +00:00
|
|
|
;; Enter the Message-IDs of all read articles into the list
|
|
|
|
;; and hash table.
|
|
|
|
(while (setq datum (pop data))
|
|
|
|
(when (and (not (gnus-data-pseudo-p datum))
|
|
|
|
(> (gnus-data-number datum) 0)
|
1999-02-20 14:05:57 +00:00
|
|
|
(not (memq (gnus-data-number datum) gnus-newsgroup-unreads))
|
1997-04-16 22:13:18 +00:00
|
|
|
(not (= (gnus-data-mark datum) gnus-canceled-mark))
|
2004-09-04 13:13:48 +00:00
|
|
|
(setq msgid (mail-header-id (gnus-data-header datum)))
|
|
|
|
(not (nnheader-fake-message-id-p msgid))
|
|
|
|
(not (intern-soft msgid gnus-dup-hashtb)))
|
1997-04-16 22:13:18 +00:00
|
|
|
(push msgid gnus-dup-list)
|
2004-09-04 13:13:48 +00:00
|
|
|
(intern msgid gnus-dup-hashtb))))
|
1997-04-16 22:13:18 +00:00
|
|
|
;; Chop off excess Message-IDs from the list.
|
|
|
|
(let ((end (nthcdr gnus-duplicate-list-length gnus-dup-list)))
|
|
|
|
(when end
|
|
|
|
(setcdr end nil))))
|
|
|
|
|
|
|
|
(defun gnus-dup-suppress-articles ()
|
|
|
|
"Mark duplicate articles as read."
|
|
|
|
(unless gnus-dup-list
|
|
|
|
(gnus-dup-open))
|
|
|
|
(gnus-message 6 "Suppressing duplicates...")
|
|
|
|
(let ((headers gnus-newsgroup-headers)
|
2000-09-19 13:37:09 +00:00
|
|
|
(auto (and gnus-newsgroup-auto-expire
|
|
|
|
(memq gnus-duplicate-mark gnus-auto-expirable-marks)))
|
1997-04-16 22:13:18 +00:00
|
|
|
number header)
|
|
|
|
(while (setq header (pop headers))
|
|
|
|
(when (and (intern-soft (mail-header-id header) gnus-dup-hashtb)
|
|
|
|
(gnus-summary-article-unread-p (mail-header-number header)))
|
|
|
|
(setq gnus-newsgroup-unreads
|
|
|
|
(delq (setq number (mail-header-number header))
|
|
|
|
gnus-newsgroup-unreads))
|
2000-09-19 13:37:09 +00:00
|
|
|
(if (not auto)
|
|
|
|
(push (cons number gnus-duplicate-mark) gnus-newsgroup-reads)
|
|
|
|
(push number gnus-newsgroup-expirable)
|
|
|
|
(push (cons number gnus-expirable-mark) gnus-newsgroup-reads)))))
|
1997-04-16 22:13:18 +00:00
|
|
|
(gnus-message 6 "Suppressing duplicates...done"))
|
|
|
|
|
|
|
|
(defun gnus-dup-unsuppress-article (article)
|
|
|
|
"Stop suppression of ARTICLE."
|
|
|
|
(let ((id (mail-header-id (gnus-data-header (gnus-data-find article)))))
|
|
|
|
(when id
|
|
|
|
(setq gnus-dup-list-dirty t)
|
|
|
|
(setq gnus-dup-list (delete id gnus-dup-list))
|
|
|
|
(unintern id gnus-dup-hashtb))))
|
|
|
|
|
|
|
|
(provide 'gnus-dup)
|
|
|
|
|
2003-09-01 15:45:59 +00:00
|
|
|
;;; arch-tag: 903e94db-7b00-4d19-83ee-cf34a81fa5fb
|
1997-04-16 22:13:18 +00:00
|
|
|
;;; gnus-dup.el ends here
|