cgit.sxemacs.org Git - gnus/blob - lisp/gnus-dup.el

   1 ;;; gnus-dup.el --- suppression of duplicate articles in Gnus
   2 ;; Copyright (C) 1996 Free Software Foundation, Inc.
   3
   4 ;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
   5 ;; Keywords: news
   6
   7 ;; This file is part of GNU Emacs.
   8
   9 ;; GNU Emacs is free software; you can redistribute it and/or modify
  10 ;; it under the terms of the GNU General Public License as published by
  11 ;; the Free Software Foundation; either version 2, or (at your option)
  12 ;; any later version.
  13
  14 ;; GNU Emacs is distributed in the hope that it will be useful,
  15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17 ;; GNU General Public License for more details.
  18
  19 ;; You should have received a copy of the GNU General Public License
  20 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  21 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  22 ;; Boston, MA 02111-1307, USA.
  23
  24 ;;; Commentary:
  25
  26 ;; This package tries to mark articles as read the second time the
  27 ;; user reads a copy.  This is useful if the server doesn't support
  28 ;; Xref properly, or if the user reads the same group from several
  29 ;; servers.
  30
  31 ;;; Code:
  32
  33 (require 'gnus)
  34 (require 'gnus-art)
  35
  36 (defgroup gnus-duplicate nil
  37   "Suppression of duplicate articles."
  38   :group 'gnus)
  39
  40 (defcustom gnus-save-duplicate-list nil
  41   "*If non-nil, save the duplicate list when shutting down Gnus.
  42 If nil, duplicate suppression will only work on duplicates
  43 seen in the same session."
  44   :group 'gnus-duplicate
  45   :type 'boolean)
  46
  47 (defcustom gnus-duplicate-list-length 10000
  48   "*The number of Message-IDs to keep in the duplicate suppression list."
  49   :group 'gnus-duplicate
  50   :type 'integer)
  51
  52 (defcustom gnus-duplicate-file (nnheader-concat gnus-directory "suppression")
  53   "*The name of the file to store the duplicate suppression list."
  54   :group 'gnus-duplicate
  55   :type 'file)
  56
  57 ;;; Internal variables
  58
  59 (defvar gnus-dup-list nil)
  60 (defvar gnus-dup-hashtb nil)
  61
  62 (defvar gnus-dup-list-dirty nil)
  63
  64 ;;;
  65 ;;; Starting and stopping
  66 ;;;
  67
  68 (gnus-add-shutdown 'gnus-dup-close 'gnus)
  69
  70 (defun gnus-dup-close ()
  71   "Possibly save the duplicate suppression list and shut down the subsystem."
  72   (gnus-dup-save)
  73   (setq gnus-dup-list nil
  74         gnus-dup-hashtb nil
  75         gnus-dup-list-dirty nil))
  76
  77 (defun gnus-dup-open ()
  78   "Possibly read the duplicate suppression list and start the subsystem."
  79   (if gnus-save-duplicate-list
  80       (gnus-dup-read)
  81     (setq gnus-dup-list nil))
  82   (setq gnus-dup-hashtb (gnus-make-hashtable gnus-duplicate-list-length))
  83   ;; Enter all Message-IDs into the hash table.
  84   (let ((list gnus-dup-list)
  85         (obarray gnus-dup-hashtb))
  86     (while list
  87       (intern (pop list)))))
  88
  89 (defun gnus-dup-read ()
  90   "Read the duplicate suppression list."
  91   (setq gnus-dup-list nil)
  92   (when (file-exists-p gnus-duplicate-file)
  93     (load gnus-duplicate-file t t t)))
  94
  95 (defun gnus-dup-save ()
  96   "Save the duplicate suppression list."
  97   (when (and gnus-save-duplicate-list
  98              gnus-dup-list-dirty)
  99     (nnheader-temp-write gnus-duplicate-file
 100       (gnus-prin1 `(setq gnus-dup-list ',gnus-dup-list))))
 101   (setq gnus-dup-list-dirty nil))
 102
 103 ;;;
 104 ;;; Interface functions
 105 ;;;
 106
 107 (defun gnus-dup-enter-articles ()
 108   "Enter articles from the current group for future duplicate suppression."
 109   (unless gnus-dup-list
 110     (gnus-dup-open))
 111   (setq gnus-dup-list-dirty t)          ; mark list for saving
 112   (let ((data gnus-newsgroup-data)
 113         datum)
 114     ;; Enter the Message-IDs of all read articles into the list
 115     ;; and hash table.
 116     (while (setq datum (pop data))
 117       (when (and (not (gnus-data-pseudo-p datum))
 118                  (gnus-data-read-p datum)
 119                  (not (intern-soft (mail-header-id (gnus-data-header datum))
 120                                    gnus-dup-hashtb)))
 121         (intern (car (push (mail-header-id (gnus-data-header datum))
 122                            gnus-dup-list))
 123                 gnus-dup-hashtb))))
 124   ;; Chop off excess Message-IDs from the list.
 125   (let ((end (nthcdr gnus-duplicate-list-length gnus-dup-list)))
 126     (when end
 127       (setcdr end nil))))
 128
 129 (defun gnus-dup-suppress-articles ()
 130   "Mark duplicate articles as read."
 131   (unless gnus-dup-list
 132     (gnus-dup-open))
 133   (gnus-message 6 "Suppressing duplicates...")
 134   (let ((headers gnus-newsgroup-headers)
 135         number header)
 136     (while (setq header (pop headers))
 137       (when (intern-soft (mail-header-id header) gnus-dup-hashtb)
 138         (setq gnus-newsgroup-unreads
 139               (delq (setq number (mail-header-number header))
 140                     gnus-newsgroup-unreads))
 141         (push (cons number gnus-duplicate-mark)
 142               gnus-newsgroup-reads))))
 143   (gnus-message 6 "Suppressing duplicates...done"))
 144
 145 (defun gnus-dup-unsuppress-article (article)
 146   "Stop suppression of ARTICLE."
 147   (let ((id (mail-header-id (gnus-data-header (gnus-data-find article)))))
 148     (when id
 149       (setq gnus-dup-list-dirty t)
 150       (setq gnus-dup-list (delete id gnus-dup-list))
 151       (unintern id gnus-dup-hashtb))))
 152
 153 (provide 'gnus-dup)
 154
 155 ;;; gnus-dup.el ends here