Update to emacs-21-branch of the Gnus CVS repository.

lisp/gnus/earcon.el

 ;;; earcon.el --- Sound effects for messages
-;; Copyright (C) 1996 Free Software Foundation
+
+;; Copyright (C) 1996, 2000 Free Software Foundation
 
 ;; Author: Steven L. Baur <steve@miranova.com>
+
+;; 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)
@@ -16,8 +20,10 @@
 ;; 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.
+;; This file is part of GNU Emacs.
 
 ;;; Commentary:
+
 ;; This file provides access to sound effects in Gnus.
 
 ;;; Code:
@@ -74,8 +80,6 @@
 (defvar earcon-button-marker-list nil)
 (make-variable-buffer-local 'earcon-button-marker-list)
 
-
-
 ;;; FIXME!! clone of code from gnus-vis.el FIXME!!
 (defun earcon-article-push-button (event)
   "Check text under the mouse pointer for a callback function.
@@ -156,7 +160,6 @@ If N is negative, move backward instead."
 	(setq entry nil)))
     entry))
 
-
 (defun earcon-button-push (marker)
   ;; Push button starting at MARKER.
   (save-excursion

lisp/gnus/gnus-async.el

 ;;; gnus-async.el --- asynchronous support for Gnus
-;; Copyright (C) 1996,97,98 Free Software Foundation, Inc.
+;; Copyright (C) 1996, 1997, 1998, 1999, 2000 Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;; Keywords: news
@@ -27,8 +27,6 @@
 
 (eval-when-compile (require 'cl))
 
-(eval-when-compile (require 'cl))
-
 (require 'gnus)
 (require 'gnus-sum)
 (require 'nntp)
@@ -37,7 +35,7 @@
   "Support for asynchronous operations."
   :group 'gnus)
 
-(defcustom gnus-asynchronous t
+(defcustom gnus-asynchronous nil
   "*If nil, inhibit all Gnus asynchronicity.
 If non-nil, let the other asynch variables be heeded."
   :group 'gnus-asynchronous
@@ -49,8 +47,8 @@ If a number, prefetch only that many articles forward;
 if t, prefetch as many articles as possible."
   :group 'gnus-asynchronous
   :type '(choice (const :tag "off" nil)
-		 (integer :tag "some" 0)
-		 (other :tag "all" t)))
+		 (const :tag "all" t)
+		 (integer :tag "some" 0)))
 
 (defcustom gnus-prefetched-article-deletion-strategy '(read exit)
   "List of symbols that say when to remove articles from the prefetch buffer.
@@ -79,7 +77,10 @@ It should return non-nil if the article is to be prefetched."
 (defvar gnus-async-article-alist nil)
 (defvar gnus-async-article-semaphore '(nil))
 (defvar gnus-async-fetch-list nil)
-(defvar gnus-asynch-obarray nil)
+(defvar gnus-async-hashtb nil)
+(defvar gnus-async-current-prefetch-group nil)
+(defvar gnus-async-current-prefetch-article nil)
+(defvar gnus-async-timer nil)
 
 (defvar gnus-async-prefetch-headers-buffer " *Async Prefetch Headers*")
 (defvar gnus-async-header-prefetched nil)
@@ -108,8 +109,8 @@ It should return non-nil if the article is to be prefetched."
 	 ,@forms)
      (gnus-async-release-semaphore 'gnus-async-article-semaphore)))
 
-(put 'gnus-asynch-with-semaphore 'lisp-indent-function 0)
-(put 'gnus-asynch-with-semaphore 'edebug-form-spec '(body))
+(put 'gnus-async-with-semaphore 'lisp-indent-function 0)
+(put 'gnus-async-with-semaphore 'edebug-form-spec '(body))
 
 ;;;
 ;;; Article prefetch
@@ -119,14 +120,14 @@ It should return non-nil if the article is to be prefetched."
 (defun gnus-async-close ()
   (gnus-kill-buffer gnus-async-prefetch-article-buffer)
   (gnus-kill-buffer gnus-async-prefetch-headers-buffer)
-  (setq gnus-async-article-alist nil
+  (setq gnus-async-hashtb nil
+	gnus-async-article-alist nil
 	gnus-async-header-prefetched nil))
 
 (defun gnus-async-set-buffer ()
   (nnheader-set-temp-buffer gnus-async-prefetch-article-buffer t)
-  (unless gnus-asynch-obarray
-    (set (make-local-variable 'gnus-asynch-obarray)
-	 (gnus-make-hashtable 1023))))
+  (unless gnus-async-hashtb
+    (setq gnus-async-hashtb (gnus-make-hashtable 1023))))
 
 (defun gnus-async-halt-prefetch ()
   "Stop prefetching."
@@ -146,49 +147,54 @@ It should return non-nil if the article is to be prefetched."
 	      ;; do this, which leads to slightly slower article
 	      ;; buffer display.
 	      (gnus-async-prefetch-article group next summary)
-	    (run-with-idle-timer
-	     0.1 nil 'gnus-async-prefetch-article group next summary)))))))
+	    (when gnus-async-timer
+	      (ignore-errors
+		(nnheader-cancel-timer 'gnus-async-timer)))
+	    (setq gnus-async-timer
+		  (run-with-idle-timer
+		   0.1 nil 'gnus-async-prefetch-article
+		   group next summary))))))))
 
 (defun gnus-async-prefetch-article (group article summary &optional next)
   "Possibly prefetch several articles starting with ARTICLE."
   (if (not (gnus-buffer-live-p summary))
       (gnus-async-with-semaphore
-       (setq gnus-async-fetch-list nil))
+	(setq gnus-async-fetch-list nil))
     (when (and gnus-asynchronous
 	       (gnus-alive-p))
       (when next
 	(gnus-async-with-semaphore
-	 (pop gnus-async-fetch-list)))
+	  (pop gnus-async-fetch-list)))
       (let ((do-fetch next)
-	    (do-message t)) ;(eq major-mode 'gnus-summary-mode)))
+	    (do-message t))		;(eq major-mode 'gnus-summary-mode)))
 	(when (and (gnus-group-asynchronous-p group)
 		   (gnus-buffer-live-p summary)
 		   (or (not next)
 		       gnus-async-fetch-list))
 	  (gnus-async-with-semaphore
-	   (unless next
-	     (setq do-fetch (not gnus-async-fetch-list))
-	     ;; Nix out any outstanding requests.
-	     (setq gnus-async-fetch-list nil)
-	     ;; Fill in the new list.
-	     (let ((n gnus-use-article-prefetch)
-		   (data (gnus-data-find-list article))
-		   d)
-	       (while (and (setq d (pop data))
-			   (if (numberp n)
-			       (natnump (decf n))
-			     n))
-		 (unless (or (gnus-async-prefetched-article-entry
-			      group (setq article (gnus-data-number d)))
-			     (not (natnump article))
-			     (not (funcall gnus-async-prefetch-article-p d)))
-		   ;; Not already fetched -- so we add it to the list.
-		   (push article gnus-async-fetch-list)))
-	       (setq gnus-async-fetch-list
-		     (nreverse gnus-async-fetch-list))))
-
-	   (when do-fetch
-	     (setq article (car gnus-async-fetch-list))))
+	    (unless next
+	      (setq do-fetch (not gnus-async-fetch-list))
+	      ;; Nix out any outstanding requests.
+	      (setq gnus-async-fetch-list nil)
+	      ;; Fill in the new list.
+	      (let ((n gnus-use-article-prefetch)
+		    (data (gnus-data-find-list article))
+		    d)
+		(while (and (setq d (pop data))
+			    (if (numberp n)
+				(natnump (decf n))
+			      n))
+		  (unless (or (gnus-async-prefetched-article-entry
+			       group (setq article (gnus-data-number d)))
+			      (not (natnump article))
+			      (not (funcall gnus-async-prefetch-article-p d)))
+		    ;; Not already fetched -- so we add it to the list.
+		    (push article gnus-async-fetch-list)))
+		(setq gnus-async-fetch-list
+		      (nreverse gnus-async-fetch-list))))
+
+	    (when do-fetch
+	      (setq article (car gnus-async-fetch-list))))
 
 	  (when (and do-fetch article)
 	    ;; We want to fetch some more articles.
@@ -206,26 +212,33 @@ It should return non-nil if the article is to be prefetched."
 		  (when do-message
 		    (gnus-message 9 "Prefetching article %d in group %s"
 				  article group))
+		  (setq gnus-async-current-prefetch-group group)
+		  (setq gnus-async-current-prefetch-article article)
 		  (gnus-request-article article group))))))))))
 
 (defun gnus-make-async-article-function (group article mark summary next)
   "Return a callback function."
   `(lambda (arg)
-     (save-excursion
-       (when arg
-	 (gnus-async-set-buffer)
-	 (gnus-async-with-semaphore
-	  (setq
-	   gnus-async-article-alist
-	   (cons (list ',(intern (format "%s-%d" group article)
-				 gnus-asynch-obarray)
-		       ,mark (set-marker (make-marker) (point-max))
-		       ,group ,article)
-		 gnus-async-article-alist))))
-       (if (not (gnus-buffer-live-p ,summary))
-	   (gnus-async-with-semaphore
-	    (setq gnus-async-fetch-list nil))
-	 (gnus-async-prefetch-article ,group ,next ,summary t)))))
+     (gnus-async-article-callback arg ,group ,article ,mark ,summary ,next)))
+
+(defun gnus-async-article-callback (arg group article mark summary next)
+  "Function called when an async article is done being fetched."
+  (save-excursion
+    (setq gnus-async-current-prefetch-article nil)
+    (when arg
+      (gnus-async-set-buffer)
+      (gnus-async-with-semaphore
+	(setq
+	 gnus-async-article-alist
+	 (cons (list (intern (format "%s-%d" group article)
+			     gnus-async-hashtb)
+		     mark (set-marker (make-marker) (point-max))
+		     group article)
+	       gnus-async-article-alist))))
+    (if (not (gnus-buffer-live-p summary))
+	(gnus-async-with-semaphore
+	  (setq gnus-async-fetch-list nil))
+      (gnus-async-prefetch-article group next summary t))))
 
 (defun gnus-async-unread-p (data)
   "Return non-nil if DATA represents an unread article."
@@ -234,6 +247,9 @@ It should return non-nil if the article is to be prefetched."
 (defun gnus-async-request-fetched-article (group article buffer)
   "See whether we have ARTICLE from GROUP and put it in BUFFER."
   (when (numberp article)
+    (when (and (equal group gnus-async-current-prefetch-group)
+	       (eq article gnus-async-current-prefetch-article))
+      (gnus-async-wait-for-article article))
     (let ((entry (gnus-async-prefetched-article-entry group article)))
       (when entry
 	(save-excursion
@@ -241,18 +257,48 @@ It should return non-nil if the article is to be prefetched."
 	  (copy-to-buffer buffer (cadr entry) (caddr entry))
 	  ;; Remove the read article from the prefetch buffer.
 	  (when (memq 'read gnus-prefetched-article-deletion-strategy)
-	    (gnus-async-delete-prefected-entry entry))
+	    (gnus-async-delete-prefetched-entry entry))
 	  t)))))
 
-(defun gnus-async-delete-prefected-entry (entry)
+(defun gnus-async-wait-for-article (article)
+  "Wait until ARTICLE is no longer the currently-being-fetched article."
+  (save-excursion
+    (gnus-async-set-buffer)
+    (let ((proc (nntp-find-connection (current-buffer)))
+	  (nntp-server-buffer (current-buffer))
+	  (nntp-have-messaged nil)
+	  (tries 0))
+      (condition-case nil
+	  ;; FIXME: we could stop waiting after some
+	  ;; timeout, but this is the wrong place to do it.
+	  ;; rather than checking time-spent-waiting, we
+	  ;; should check time-since-last-output, which
+	  ;; needs to be done in nntp.el.
+	  (while (eq article gnus-async-current-prefetch-article)
+	    (incf tries)
+	    (when (nntp-accept-process-output proc 1)
+	      (setq tries 0))
+	    (when (and (not nntp-have-messaged) (eq 3 tries))
+	      (gnus-message 5 "Waiting for async article...")
+	      (setq nntp-have-messaged t)))
+	(quit
+	 ;; if the user interrupted on a slow/hung connection,
+	 ;; do something friendly.
+	 (when (< 3 tries)
+	   (setq gnus-async-current-prefetch-article nil))
+	 (signal 'quit nil)))
+      (when nntp-have-messaged
+	(gnus-message 5 "")))))
+
+(defun gnus-async-delete-prefetched-entry (entry)
   "Delete ENTRY from buffer and alist."
   (ignore-errors
     (delete-region (cadr entry) (caddr entry))
     (set-marker (cadr entry) nil)
     (set-marker (caddr entry) nil))
   (gnus-async-with-semaphore
-   (setq gnus-async-article-alist
-	 (delq entry gnus-async-article-alist))))
+    (setq gnus-async-article-alist
+	  (delq entry gnus-async-article-alist))))
 
 (defun gnus-async-prefetch-remove-group (group)
   "Remove all articles belonging to GROUP from the prefetch buffer."
@@ -263,7 +309,7 @@ It should return non-nil if the article is to be prefetched."
 	(gnus-async-set-buffer)
 	(while alist
 	  (when (equal group (nth 3 (car alist)))
-	    (gnus-async-delete-prefected-entry (car alist)))
+	    (gnus-async-delete-prefetched-entry (car alist)))
 	  (pop alist))))))
 
 (defun gnus-async-prefetched-article-entry (group article)
@@ -271,7 +317,7 @@ It should return non-nil if the article is to be prefetched."
   (let ((entry (save-excursion
 		 (gnus-async-set-buffer)
 		 (assq (intern (format "%s-%d" group article)
-			       gnus-asynch-obarray)
+			       gnus-async-hashtb)
 		       gnus-async-article-alist))))
     ;; Perhaps something has emptied the buffer?
     (if (and entry

lisp/gnus/gnus-audio.el

@@ -47,37 +47,37 @@
   "Executable program for playing WAV files.")
 
 ;;; The following isn't implemented yet.  Wait for Millennium Gnus.
-;(defvar gnus-audio-effects-enabled t
-;  "When t, Gnus will use sound effects.")
-;(defvar gnus-audio-enable-hooks nil
-;  "Functions run when enabling sound effects.")
-;(defvar gnus-audio-disable-hooks nil
-;  "Functions run when disabling sound effects.")
-;(defvar gnus-audio-theme-song nil
-;  "Theme song for Gnus.")
-;(defvar gnus-audio-enter-group nil
-;  "Sound effect played when selecting a group.")
-;(defvar gnus-audio-exit-group nil
-;  "Sound effect played when exiting a group.")
-;(defvar gnus-audio-score-group nil
-;  "Sound effect played when scoring a group.")
-;(defvar gnus-audio-busy-sound nil
-;  "Sound effect played when going into a ... sequence.")
+;;(defvar gnus-audio-effects-enabled t
+;;  "When t, Gnus will use sound effects.")
+;;(defvar gnus-audio-enable-hooks nil
+;;  "Functions run when enabling sound effects.")
+;;(defvar gnus-audio-disable-hooks nil
+;;  "Functions run when disabling sound effects.")
+;;(defvar gnus-audio-theme-song nil
+;;  "Theme song for Gnus.")
+;;(defvar gnus-audio-enter-group nil
+;;  "Sound effect played when selecting a group.")
+;;(defvar gnus-audio-exit-group nil
+;;  "Sound effect played when exiting a group.")
+;;(defvar gnus-audio-score-group nil
+;;  "Sound effect played when scoring a group.")
+;;(defvar gnus-audio-busy-sound nil
+;;  "Sound effect played when going into a ... sequence.")
 
 
 ;;;###autoload
-					;(defun gnus-audio-enable-sound ()
-;  "Enable Sound Effects for Gnus."
-;  (interactive)
-;  (setq gnus-audio-effects-enabled t)
-;  (gnus-run-hooks gnus-audio-enable-hooks))
+;;(defun gnus-audio-enable-sound ()
+;;  "Enable Sound Effects for Gnus."
+;;  (interactive)
+;;  (setq gnus-audio-effects-enabled t)
+;;  (gnus-run-hooks gnus-audio-enable-hooks))
 
 ;;;###autoload
 					;(defun gnus-audio-disable-sound ()
-;  "Disable Sound Effects for Gnus."
-;  (interactive)
-;  (setq gnus-audio-effects-enabled nil)
-;  (gnus-run-hooks gnus-audio-disable-hooks))
+;;  "Disable Sound Effects for Gnus."
+;;  (interactive)
+;;  (setq gnus-audio-effects-enabled nil)
+;;  (gnus-run-hooks gnus-audio-disable-hooks))
 
 ;;;###autoload
 (defun gnus-audio-play (file)
@@ -104,16 +104,16 @@
 
 
 ;;; The following isn't implemented yet, wait for Red Gnus
-					;(defun gnus-audio-startrek-sounds ()
-;  "Enable sounds from Star Trek the original series."
-;  (interactive)
-;  (setq gnus-audio-busy-sound "working.au")
-;  (setq gnus-audio-enter-group "bulkhead_door.au")
-;  (setq gnus-audio-exit-group "bulkhead_door.au")
-;  (setq gnus-audio-score-group "ST_laser.au")
-;  (setq gnus-audio-theme-song "startrek.au")
-;  (add-hook 'gnus-select-group-hook 'gnus-audio-startrek-select-group)
-;  (add-hook 'gnus-exit-group-hook 'gnus-audio-startrek-exit-group))
+;;(defun gnus-audio-startrek-sounds ()
+;;  "Enable sounds from Star Trek the original series."
+;;  (interactive)
+;;  (setq gnus-audio-busy-sound "working.au")
+;;  (setq gnus-audio-enter-group "bulkhead_door.au")
+;;  (setq gnus-audio-exit-group "bulkhead_door.au")
+;;  (setq gnus-audio-score-group "ST_laser.au")
+;;  (setq gnus-audio-theme-song "startrek.au")
+;;  (add-hook 'gnus-select-group-hook 'gnus-audio-startrek-select-group)
+;;  (add-hook 'gnus-exit-group-hook 'gnus-audio-startrek-exit-group))
 ;;;***
 
 (defvar gnus-startup-jingle "Tuxedomoon.Jingle4.au"

lisp/gnus/gnus-dup.el

 ;;; gnus-dup.el --- suppression of duplicate articles in Gnus
-;; Copyright (C) 1996,97,98 Free Software Foundation, Inc.
+;; Copyright (C) 1996, 1997, 1998, 1999, 2000
+;;        Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;; Keywords: news
@@ -32,8 +33,6 @@
 
 (eval-when-compile (require 'cl))
 
-(eval-when-compile (require 'cl))
-
 (require 'gnus)
 (require 'gnus-art)
 
@@ -100,7 +99,7 @@ seen in the same session."
   "Save the duplicate suppression list."
   (when (and gnus-save-duplicate-list
 	     gnus-dup-list-dirty)
-    (nnheader-temp-write gnus-duplicate-file
+    (with-temp-file gnus-duplicate-file
       (gnus-prin1 `(setq gnus-dup-list ',gnus-dup-list))))
   (setq gnus-dup-list-dirty nil))
 
@@ -138,6 +137,8 @@ seen in the same session."
     (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)
@@ -145,8 +146,10 @@ seen in the same session."
 	(setq gnus-newsgroup-unreads
 	      (delq (setq number (mail-header-number header))
 		    gnus-newsgroup-unreads))
-	(push (cons number gnus-duplicate-mark)
-	      gnus-newsgroup-reads))))
+	(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)