1
0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2024-12-06 08:54:05 +00:00
emacs/lisp/gnus/gnus-dup.el

168 lines
5.3 KiB
EmacsLisp
Raw Normal View History

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)
(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)
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))
(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)
(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)
(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))
(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