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-load)
  34 (require 'gnus-art)
  35 (require 'gnus)
  36
  37 (defvar gnus-save-duplicate-list nil
  38   "*If non-nil, save the duplicate list when shutting down Gnus.
  39 If nil, duplicate suppression will only work on duplicates
  40 seen in the same session.")
  41
  42 (defvar gnus-duplicate-list-length 10000
  43   "*The number of Message-IDs to keep in the duplicate suppression list.")
  44
  45 (defvar gnus-duplicate-file (nnheader-concat gnus-directory "suppression")
  46   "*The name of the file to store the duplicate suppression list.")
  47
  48 ;;; Internal variables
  49
  50 (defvar gnus-dup-list nil)
  51 (defvar gnus-dup-hashtb nil)
  52
  53 ;;;
  54 ;;; Starting and stopping
  55 ;;;
  56
  57 (gnus-add-shutdown 'gnus-dup-close 'gnus)
  58
  59 (defun gnus-dup-close ()
  60   "Possibly save the duplicate suppression list and shut down the subsystem."
  61   (when gnus-save-duplicate-list
  62     (gnus-dup-save))
  63   (setq gnus-dup-list nil
  64         gnus-dup-hashtb nil))
  65
  66 (defun gnus-dup-open ()
  67   "Possibly read the duplicate suppression list and start the subsystem."
  68   (if gnus-save-duplicate-list
  69       (gnus-dup-read)
  70     (setq gnus-dup-list nil))
  71   (setq gnus-dup-hashtb (gnus-make-hashtable gnus-duplicate-list-length))
  72   ;; Enter all Message-IDs into the hash table.
  73   (let ((list gnus-dup-list)
  74         (obarray gnus-dup-hashtb))
  75     (while list
  76       (intern (pop list)))))
  77
  78 (defun gnus-dup-read ()
  79   "Read the duplicate suppression list."
  80   (setq gnus-dup-list nil)
  81   (when (file-exists-p gnus-duplicate-file)
  82     (load gnus-duplicate-file t t t)))
  83
  84 (defun gnus-dup-save ()
  85   "Save the duplicate suppression list."
  86   (nnheader-temp-write gnus-duplicate-file
  87     (prin1 `(setq gnus-duplicate-file ',gnus-duplicate-file)
  88            (current-buffer))))
  89
  90 ;;;
  91 ;;; Interface functions
  92 ;;;
  93
  94 (defun gnus-dup-enter-articles ()
  95   "Enter articles from the current group for future duplicate suppression."
  96   (unless gnus-dup-list
  97     (gnus-dup-open))
  98   (let ((data gnus-newsgroup-data)
  99         id)
 100     ;; Enter the Message-IDs of all read articles into the list
 101     ;; and hash table.
 102     (while data
 103       (when (gnus-data-read-p (car data))
 104         (intern (car (push (mail-header-id (gnus-data-header (car data)))
 105                            gnus-dup-list))
 106                 gnus-dup-hashtb))
 107       (pop data))
 108     ;; Chop off excess Message-IDs from the list.
 109     (let ((end (nthcdr gnus-duplicate-list-length gnus-dup-list)))
 110       (when end
 111         (setcdr end nil)))))
 112
 113 (defun gnus-dup-suppress-articles ()
 114   "Mark duplicate articles as read."
 115   (unless gnus-dup-list
 116     (gnus-dup-open))
 117   (gnus-message 6 "Suppressing duplicates...")
 118   (let ((headers gnus-newsgroup-headers)
 119         number)
 120     (while headers
 121       (when (intern-soft (mail-header-id (car headers)) gnus-dup-hashtb)
 122         (setq gnus-newsgroup-unreads
 123               (delq (setq number (mail-header-number (car headers)))
 124                     gnus-newsgroup-unreads))
 125         (push (cons number gnus-duplicate-mark)
 126               gnus-newsgroup-reads))
 127       (pop headers)))
 128   (gnus-message 6 "Suppressing duplicates...done"))
 129
 130 (provide 'gnus-dup)
 131
 132 ;;; gnus-dup.el ends here