view lisp/gnus/gnus-dup.el @ 17623:a09fd9348b0d

Support compilers that give a message each time the file being compiled changes but don't include a file name each error message. Speed up by searching for regexps one by one instead of combining. (compile-internal): Takes more optional arguments. All five regexp alists can be given as argument. Change name of variable regexp-alist to error-regexp-alist. Change some local variables directly by setq instead of rebinding by let. (compilation-shell-minor-mode): New minor mode. Similar to compilation-minor-mode, but key bindings don't collide with shell mode. (compilation-shell-minor-mode-map, compilation-shell-minor-mode): New variables. (compile-auto-highlight): Doc fix. (compilation-error-regexp-alist): Removed unnecessary line break in first regexp. Replaced \\(\\|.* on \\) by \\(.* on \\)? in regexp for Absoft FORTRAN 77 Compiler 3.1.3. Added regexp for SPARCcompiler Pascal. Divided long line in regexp for Cray C compiler error messages. Made comment fit in line at regexp for Sun Ada (VADS, Solaris). FILE-IDX may be nil, meaning an error message with no file name, so the file name must be taken from an earlier message. LINE-IDX may be a function which is called with two arguments the file name and column strings and returns an error position descriptor. (compilation-enter-directory-regexp-alist) (compilation-leave-directory-regexp-alist): New variables. (compilation-file-regexp-alist) (compilation-nomessage-regexp-alist): New variables. (grep-regexp-alist): Removed unnecessary ^ at beginning of regexp. (compilation-enter-directory-regexp) (compilation-leave-directory-regexp): Variables deleted. Replaced by compilation-enter-directory-regexp-alist and compilation-leave-directory-regexp-alist. (compilation-buffer-p): Return true also for buffer in compilation-shell-minor-mode. (compilation-next-error-locus): Split a long line. (count-regexp-groupings): Comment about this function not being needed any more. (compilation-current-file, compilation-regexps); New variables. (compilation-parse-errors): Large parts rewritten. Don't put the regexps together in one large regexp, instead match them one by one. Support the generalized subexpression indices. (compile-collect-regexps, compile-buffer-substring): New functions supporting compilation-parse-errors.

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