view lisp/gnus/gnus-dup.el @ 18092:8428d56cd207

(smtpmail-via-smtp): Recognize XVRB as a synonym for VERB and XONE as a synonym for ONEX. (smtpmail-read-response): Add "%s" to `message' calls to avoid problems with percent signs in strings. (smtpmail-read-response): Return all lines of the response text as a list of strings. Formerly only the first line was returned. This is insufficient when one wants to parse e.g. an EHLO response. Ignore responses starting with "0". This is necessary to support the VERB SMTP extension. (smtpmail-via-smtp): Try EHLO and find out which SMTP service extensions the receiving mailer supports. Issue the ONEX and XUSR commands if the corresponding extensions are supported. Issue VERB if supported and `smtpmail-debug-info' is non-nil. Add SIZE attribute to MAIL FROM: command if SIZE extension is supported. Add code that could set the BODY= attribute to MAIL FROM: if the receiving mailer supports 8BITMIME. This is currently disabled, since doing it right might involve adding MIME headers to, and in some cases reencoding, the message.

;;; gnus-dup.el --- suppression of duplicate articles in Gnus
;; Copyright (C) 1996,97 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., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, 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:

(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)
    (nnheader-temp-write 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)
		 (gnus-data-read-p datum)
		 (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)
	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))
	(push (cons number gnus-duplicate-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)

;;; gnus-dup.el ends here