view lisp/gnus/gnus-dup.el @ 66573:e65b759c6906

Revision: [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-630 Merge from gnus--rel--5.10 Patches applied: * gnus--rel--5.10 (patch 149-151) - Merge from emacs--cvs-trunk--0 - Update from CVS 2005-10-27 Reiner Steib <[e-mail]> * lisp/gnus/flow-fill.el (fill-flowed-encode-tests): Restore trailing whitespace removed in revision 7.8. Use concatenated string to protect trailing whitespace. 2005-10-27 Jouni K Seppanen <[e-mail]> (tiny change) * lisp/gnus/nnimap.el (nnimap-search-uids-not-since-is-evil): Add variable. (nnimap-request-expire-articles): Use it to avoid sending 'UID SEARCH UID ... NOT SINCE' queries, for inefficient servers like Courier IMAP ("some version from 2004"). Mostly based on similar code in the same function. 2005-10-26 Katsumi Yamaoka <[e-mail]> * lisp/gnus/message.el (message-display-completion-list): New function. (message-expand-group): Use it; make sure the Completions buffer is modifiable.

;;; gnus-dup.el --- suppression of duplicate articles in Gnus

;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2002, 2003, 2004,
;;   2005 Free Software Foundation, Inc.

;; Author: Lars Magne Ingebrigtsen <[e-mail]>
;; 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
;; the Free Software Foundation; either version 2, or (at your option)
;; 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
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.

;;; 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:

(eval-when-compile (require 'cl))

(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
      (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)
    ;; 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)
		 (not (memq (gnus-data-number datum) gnus-newsgroup-unreads))
		 (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)))
	(push msgid gnus-dup-list)
	(intern msgid gnus-dup-hashtb))))
  ;; 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)))
	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)))))
  (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)

;;; arch-tag: 903e94db-7b00-4d19-83ee-cf34a81fa5fb
;;; gnus-dup.el ends here