Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Revision: emacs@sv.gnu.org/emacs--devo--0--patch-911

1 files changed, 259 insertions, 69 deletions

diff --git a/lisp/gnus/nntp.el b/lisp/gnus/nntp.el
index 2623df58e4d..c8c14da4df7 100644
--- a/lisp/gnus/nntp.el
+++ b/lisp/gnus/nntp.el
@@ -31,6 +31,8 @@
 (require 'nnheader)
 (require 'nnoo)
 (require 'gnus-util)
+(require 'gnus)
+(require 'gnus-group) ;; gnus-group-name-charset
 
 (nnoo-declare nntp)
 
@@ -86,6 +88,7 @@ Direct connections:
 
 Indirect connections:
 - `nntp-open-via-rlogin-and-telnet',
+- `nntp-open-via-rlogin-and-netcat',
 - `nntp-open-via-telnet-and-telnet'.")
 
 (defvoo nntp-never-echoes-commands nil
@@ -109,20 +112,22 @@ This is where you would put \"runsocks\" or stuff like that.")
 
 (defvoo nntp-telnet-command "telnet"
   "*Telnet command used to connect to the nntp server.
-This command is used by the various nntp-open-via-* methods.")
+This command is used by the methods `nntp-open-telnet-stream',
+`nntp-open-via-rlogin-and-telnet' and `nntp-open-via-telnet-and-telnet'.")
 
 (defvoo nntp-telnet-switches '("-8")
   "*Switches given to the telnet command `nntp-telnet-command'.")
 
 (defvoo nntp-end-of-line "\r\n"
   "*String to use on the end of lines when talking to the NNTP server.
-This is \"\\r\\n\" by default, but should be \"\\n\" when
-using an indirect connection method (nntp-open-via-*).")
+This is \"\\r\\n\" by default, but should be \"\\n\" when using an indirect
+connection method (nntp-open-via-*).")
 
 (defvoo nntp-via-rlogin-command "rsh"
   "*Rlogin command used to connect to an intermediate host.
-This command is used by the `nntp-open-via-rlogin-and-telnet' method.
-The default is \"rsh\", but \"ssh\" is a popular alternative.")
+This command is used by the methods `nntp-open-via-rlogin-and-telnet'
+and `nntp-open-via-rlogin-and-netcat'.  The default is \"rsh\", but \"ssh\"
+is a popular alternative.")
 
 (defvoo nntp-via-rlogin-command-switches nil
   "*Switches given to the rlogin command `nntp-via-rlogin-command'.
@@ -138,9 +143,16 @@ This command is used by the `nntp-open-via-telnet-and-telnet' method.")
 (defvoo nntp-via-telnet-switches '("-8")
   "*Switches given to the telnet command `nntp-via-telnet-command'.")
 
+(defvoo nntp-via-netcat-command "nc"
+  "*Netcat command used to connect to the nntp server.
+This command is used by the `nntp-open-via-rlogin-and-netcat' method.")
+
+(defvoo nntp-via-netcat-switches nil
+  "*Switches given to the netcat command `nntp-via-netcat-command'.")
+
 (defvoo nntp-via-user-name nil
   "*User name to log in on an intermediate host with.
-This variable is used by the `nntp-open-via-telnet-and-telnet' method.")
+This variable is used by the various nntp-open-via-* methods.")
 
 (defvoo nntp-via-user-password nil
   "*Password to use to log in on an intermediate host with.
@@ -148,8 +160,7 @@ This variable is used by the `nntp-open-via-telnet-and-telnet' method.")
 
 (defvoo nntp-via-address nil
   "*Address of an intermediate host to connect to.
-This variable is used by the `nntp-open-via-rlogin-and-telnet' and
-`nntp-open-via-telnet-and-telnet' methods.")
+This variable is used by the various nntp-open-via-* methods.")
 
 (defvoo nntp-via-envuser nil
   "*Whether both telnet client and server support the ENVIRON option.
@@ -206,6 +217,21 @@ server there that you can connect to.  See also
 (defvoo nntp-coding-system-for-write 'binary
   "*Coding system to write to NNTP.")
 
+;; Marks
+(defvoo nntp-marks-is-evil nil
+  "*If non-nil, Gnus will never generate and use marks file for nntp groups.
+See `nnml-marks-is-evil' for more information.")
+
+(defvoo nntp-marks-file-name ".marks")
+(defvoo nntp-marks nil)
+(defvar nntp-marks-modtime (gnus-make-hashtable))
+
+(defcustom nntp-marks-directory
+  (nnheader-concat gnus-directory "marks/")
+  "*The directory where marks for nntp groups will be stored."
+  :group 'nntp
+  :type 'directory)
+
 (defcustom nntp-authinfo-file "~/.authinfo"
   ".netrc-like file that holds nntp authinfo passwords."
   :group 'nntp
@@ -252,6 +278,7 @@ to insert Cancel-Lock headers.")
 (defvoo nntp-last-command nil)
 (defvoo nntp-authinfo-password nil)
 (defvoo nntp-authinfo-user nil)
+(defvoo nntp-authinfo-force nil)
 
 (defvar nntp-connection-list nil)
 
@@ -339,14 +366,16 @@ be restored and the command retried."
 
 (defsubst nntp-wait-for (process wait-for buffer &optional decode discard)
   "Wait for WAIT-FOR to arrive from PROCESS."
+
   (save-excursion
     (set-buffer (process-buffer process))
     (goto-char (point-min))
+
     (while (and (or (not (memq (char-after (point)) '(?2 ?3 ?4 ?5)))
 		    (looking-at "48[02]"))
 		(memq (process-status process) '(open run)))
       (cond ((looking-at "480")
-	(nntp-handle-authinfo process))
+	     (nntp-handle-authinfo process))
 	    ((looking-at "482")
 	     (nnheader-report 'nntp (get 'nntp-authinfo-rejected 'error-message))
 	     (signal 'nntp-authinfo-rejected nil))
@@ -394,6 +423,11 @@ be restored and the command retried."
     (kill-buffer buffer)
     (nnheader-init-server-buffer)))
 
+(defun nntp-erase-buffer (buffer)
+  "Erase contents of BUFFER."
+  (with-current-buffer buffer
+    (erase-buffer)))
+
 (defsubst nntp-find-connection (buffer)
   "Find the connection delivering to BUFFER."
   (let ((alist nntp-connection-alist)
@@ -428,9 +462,7 @@ be restored and the command retried."
     (if process
         (progn
           (unless (or nntp-inhibit-erase nnheader-callback-function)
-            (save-excursion
-              (set-buffer (process-buffer process))
-              (erase-buffer)))
+	    (nntp-erase-buffer (process-buffer process)))
           (condition-case err
               (progn
                 (when command
@@ -459,9 +491,7 @@ be restored and the command retried."
   "Send STRINGS to server and wait until WAIT-FOR returns."
   (when (and (not nnheader-callback-function)
 	     (not nntp-inhibit-output))
-    (save-excursion
-      (set-buffer nntp-server-buffer)
-      (erase-buffer)))
+    (nntp-erase-buffer nntp-server-buffer))
   (let* ((command (mapconcat 'identity strings " "))
 	 (process (nntp-find-connection nntp-server-buffer))
 	 (buffer (and process (process-buffer process)))
@@ -488,8 +518,7 @@ be restored and the command retried."
 	      (goto-char pos)
 	      (if (looking-at (regexp-quote command))
 		  (delete-region pos (progn (forward-line 1)
-					    (gnus-point-at-bol))))
-	      )))
+					    (point-at-bol)))))))
       (nnheader-report 'nntp "Couldn't open connection to %s."
 		       nntp-address))))
 
@@ -513,7 +542,7 @@ be restored and the command retried."
 	      (goto-char pos)
 	      (if (looking-at (regexp-quote command))
 		  (delete-region pos (progn (forward-line 1)
-					    (gnus-point-at-bol)))))))
+					    (point-at-bol)))))))
       (nnheader-report 'nntp "Couldn't open connection to %s."
 		       nntp-address))))
 
@@ -521,9 +550,7 @@ be restored and the command retried."
   "Send STRINGS to server and wait until WAIT-FOR returns."
   (when (and (not nnheader-callback-function)
 	     (not nntp-inhibit-output))
-    (save-excursion
-      (set-buffer nntp-server-buffer)
-      (erase-buffer)))
+    (nntp-erase-buffer nntp-server-buffer))
   (let* ((command (mapconcat 'identity strings " "))
 	 (process (nntp-find-connection nntp-server-buffer))
 	 (buffer (and process (process-buffer process)))
@@ -538,11 +565,11 @@ be restored and the command retried."
 	  (unless wait-for
 	    (nntp-accept-response)
 	    (save-excursion
-	  (set-buffer buffer)
-	  (goto-char pos)
-	  (if (looking-at (regexp-quote command))
-	      (delete-region pos (progn (forward-line 1) (gnus-point-at-bol))))
-	  )))
+	      (set-buffer buffer)
+	      (goto-char pos)
+	      (if (looking-at (regexp-quote command))
+		  (delete-region pos (progn (forward-line 1) (point-at-bol))))
+	      )))
       (nnheader-report 'nntp "Couldn't open connection to %s."
 		       nntp-address))))
 
@@ -551,9 +578,8 @@ be restored and the command retried."
   "Send the current buffer to server and wait until WAIT-FOR returns."
   (when (and (not nnheader-callback-function)
 	     (not nntp-inhibit-output))
-    (save-excursion
-      (set-buffer (nntp-find-connection-buffer nntp-server-buffer))
-      (erase-buffer)))
+    (nntp-erase-buffer
+     (nntp-find-connection-buffer nntp-server-buffer)))
   (nntp-encode-text)
   (mm-with-unibyte-current-buffer
     ;; Some encoded unicode text contains character 0x80-0x9f e.g. Euro.
@@ -575,7 +601,12 @@ be restored and the command retried."
    ;; a line with only a "." on it.
    ((eq (char-after) ?2)
     (if (re-search-forward "\n\\.\r?\n" nil t)
-	t
+	(progn
+	  ;; Some broken news servers add another dot at the end.
+	  ;; Protect against inflooping there.
+	  (while (looking-at "^\\.\r?\n")
+	    (forward-line 1))
+	  t)
       nil))
    ;; A result that starts with a 3xx or 4xx code is terminated
    ;; by a newline.
@@ -615,7 +646,7 @@ command whose response triggered the error."
 
 	      (let ((timer
 		     (and nntp-connection-timeout
-			  (nnheader-run-at-time
+			  (run-at-time
 			   nntp-connection-timeout nil
 			   '(lambda ()
 			      (let ((process (nntp-find-connection
@@ -637,7 +668,8 @@ command whose response triggered the error."
                           (condition-case nil
 			      (progn ,@forms)
 			    (quit
-			     (nntp-close-server)
+			     (unless debug-on-quit
+			       (nntp-close-server))
                              (signal 'quit nil))))
 		  (when timer
 		    (nnheader-cancel-timer timer)))
@@ -717,8 +749,7 @@ command whose response triggered the error."
      (catch 'done
        (save-excursion
          ;; Erase nntp-server-buffer before nntp-inhibit-erase.
-         (set-buffer nntp-server-buffer)
-         (erase-buffer)
+	 (nntp-erase-buffer nntp-server-buffer)
          (set-buffer (nntp-find-connection-buffer nntp-server-buffer))
          ;; The first time this is run, this variable is `try'.  So we
          ;; try.
@@ -1046,6 +1077,54 @@ command whose response triggered the error."
 (deffoo nntp-asynchronous-p ()
   t)
 
+(deffoo nntp-request-set-mark (group actions &optional server)
+  (unless nntp-marks-is-evil
+    (nntp-possibly-create-directory group server)
+    (nntp-open-marks group server)
+    (dolist (action actions)
+      (let ((range (nth 0 action))
+	    (what  (nth 1 action))
+	    (marks (nth 2 action)))
+	(assert (or (eq what 'add) (eq what 'del)) nil
+		"Unknown request-set-mark action: %s" what)
+	(dolist (mark marks)
+	  (setq nntp-marks (gnus-update-alist-soft
+			    mark
+			    (funcall (if (eq what 'add) 'gnus-range-add
+				       'gnus-remove-from-range)
+				     (cdr (assoc mark nntp-marks)) range)
+			    nntp-marks)))))
+    (nntp-save-marks group server))
+  nil)
+
+(deffoo nntp-request-update-info (group info &optional server)
+  (unless nntp-marks-is-evil
+    (nntp-possibly-create-directory group server)
+    (when (nntp-marks-changed-p group server)
+      (nnheader-message 8 "Updating marks for %s..." group)
+      (nntp-open-marks group server)
+      ;; Update info using `nntp-marks'.
+      (mapc (lambda (pred)
+	      (unless (memq (cdr pred) gnus-article-unpropagated-mark-lists)
+		(gnus-info-set-marks
+		 info
+		 (gnus-update-alist-soft
+		  (cdr pred)
+		  (cdr (assq (cdr pred) nntp-marks))
+		  (gnus-info-marks info))
+		 t)))
+	    gnus-article-mark-lists)
+      (let ((seen (cdr (assq 'read nntp-marks))))
+	(gnus-info-set-read info
+			    (if (and (integerp (car seen))
+				     (null (cdr seen)))
+				(list (cons (car seen) (car seen)))
+			      seen)))
+      (nnheader-message 8 "Updating marks for %s...done" group)))
+  nil)
+
+
+
 ;;; Hooky functions.
 
 (defun nntp-send-mode-reader ()
@@ -1063,11 +1142,11 @@ and a password.
 
 If SEND-IF-FORCE, only send authinfo to the server if the
 .authinfo file has the FORCE token."
-  (let* ((list (gnus-parse-netrc nntp-authinfo-file))
-	 (alist (gnus-netrc-machine list nntp-address "nntp"))
-	 (force (gnus-netrc-get alist "force"))
-	 (user (or (gnus-netrc-get alist "login") nntp-authinfo-user))
-	 (passwd (gnus-netrc-get alist "password")))
+  (let* ((list (netrc-parse nntp-authinfo-file))
+	 (alist (netrc-machine list nntp-address "nntp"))
+	 (force (or (netrc-get alist "force") nntp-authinfo-force))
+	 (user (or (netrc-get alist "login") nntp-authinfo-user))
+	 (passwd (netrc-get alist "password")))
     (when (or (not send-if-force)
 	      force)
       (unless user
@@ -1106,7 +1185,7 @@ password contained in '~/.nntp-authinfo'."
       (nntp-send-command "^3.*\r?\n" "AUTHINFO USER" (user-login-name))
       (nntp-send-command
        "^2.*\r?\n" "AUTHINFO PASS"
-       (buffer-substring (point) (gnus-point-at-eol))))))
+       (buffer-substring (point) (point-at-eol))))))
 
 ;;; Internal functions.
 
@@ -1116,9 +1195,7 @@ password contained in '~/.nntp-authinfo'."
     (funcall nntp-authinfo-function)
     ;; We have to re-send the function that was interrupted by
     ;; the authinfo request.
-    (save-excursion
-      (set-buffer nntp-server-buffer)
-      (erase-buffer))
+    (nntp-erase-buffer nntp-server-buffer)
     (nntp-send-string process last)))
 
 (defun nntp-make-process-buffer (buffer)
@@ -1144,7 +1221,7 @@ password contained in '~/.nntp-authinfo'."
   (let* ((pbuffer (nntp-make-process-buffer buffer))
 	 (timer
 	  (and nntp-connection-timeout
-	       (nnheader-run-at-time
+	       (run-at-time
 		nntp-connection-timeout nil
 		`(lambda ()
 		   (nntp-kill-buffer ,pbuffer)))))
@@ -1155,7 +1232,7 @@ password contained in '~/.nntp-authinfo'."
 		(funcall nntp-open-connection-function pbuffer))
 	    (error nil)
 	    (quit
-	     (message "Quit opening connection")
+	     (message "Quit opening connection to %s" nntp-address)
 	     (nntp-kill-buffer pbuffer)
 	     (signal 'quit nil)
 	     nil))))
@@ -1223,12 +1300,9 @@ password contained in '~/.nntp-authinfo'."
   "Find out what the name of the server we have connected to is."
   ;; Wait for the status string to arrive.
   (setq nntp-server-type (buffer-string))
-  (let ((alist nntp-server-action-alist)
-	(case-fold-search t)
-	entry)
+  (let ((case-fold-search t))
     ;; Run server-specific commands.
-    (while alist
-      (setq entry (pop alist))
+    (dolist (entry nntp-server-action-alist)
       (when (string-match (car entry) nntp-server-type)
 	(if (and (listp (cadr entry))
 		 (not (eq 'lambda (caadr entry))))
@@ -1254,7 +1328,7 @@ password contained in '~/.nntp-authinfo'."
   ;; doesn't trigger after-change-functions.
   (unless nntp-async-timer
     (setq nntp-async-timer
-	  (nnheader-run-at-time 1 1 'nntp-async-timer-handler)))
+	  (run-at-time 1 1 'nntp-async-timer-handler)))
   (add-to-list 'nntp-async-process-list process))
 
 (defun nntp-async-timer-handler ()
@@ -1340,22 +1414,22 @@ password contained in '~/.nntp-authinfo'."
 
 (defun nntp-accept-process-output (process)
   "Wait for output from PROCESS and message some dots."
-  (save-excursion
-    (set-buffer (or (nntp-find-connection-buffer nntp-server-buffer)
-		    nntp-server-buffer))
+  (with-current-buffer (or (nntp-find-connection-buffer nntp-server-buffer)
+                           nntp-server-buffer)
     (let ((len (/ (buffer-size) 1024))
 	  message-log-max)
       (unless (< len 10)
 	(setq nntp-have-messaged t)
 	(nnheader-message 7 "nntp read: %dk" len)))
-    (nnheader-accept-process-output process)
-    ;; accept-process-output may update status of process to indicate
-    ;; that the server has closed the connection.  This MUST be
-    ;; handled here as the buffer restored by the save-excursion may
-    ;; be the process's former output buffer (i.e. now killed)
-    (or (and process
-	     (memq (process-status process) '(open run)))
-        (nntp-report "Server closed connection"))))
+    (prog1
+	(nnheader-accept-process-output process)
+      ;; accept-process-output may update status of process to indicate
+      ;; that the server has closed the connection.  This MUST be
+      ;; handled here as the buffer restored by the save-excursion may
+      ;; be the process's former output buffer (i.e. now killed)
+      (or (and process
+	       (memq (process-status process) '(open run)))
+          (nntp-report "Server closed connection")))))
 
 (defun nntp-accept-response ()
   "Wait for output from the process that outputs to BUFFER."
@@ -1382,9 +1456,7 @@ password contained in '~/.nntp-authinfo'."
                (nntp-send-command "^[245].*\n" "GROUP" group)
                (setcar (cddr entry) group)
                (erase-buffer)
-               (save-excursion
-                 (set-buffer nntp-server-buffer)
-                 (erase-buffer))))))))
+	       (nntp-erase-buffer nntp-server-buffer)))))))
 
 (defun nntp-decode-text (&optional cr-only)
   "Decode the text in the current buffer."
@@ -1594,10 +1666,8 @@ password contained in '~/.nntp-authinfo'."
 	  (setq commands (cdr commands)))
 	;; If none of the commands worked, we disable XOVER.
 	(when (eq nntp-server-xover 'try)
-	  (save-excursion
-	    (set-buffer nntp-server-buffer)
-	    (erase-buffer)
-	    (setq nntp-server-xover nil)))
+	  (nntp-erase-buffer nntp-server-buffer)
+	  (setq nntp-server-xover nil))
         nntp-server-xover))))
 
 (defun nntp-find-group-and-number (&optional group)
@@ -1847,6 +1917,36 @@ Please refer to the following variables to customize the connection:
       (delete-region (point) (point-max)))
     proc))
 
+(defun nntp-open-via-rlogin-and-netcat (buffer)
+  "Open a connection to an nntp server through an intermediate host.
+First rlogin to the remote host, and then connect to the real news
+server from there using the netcat command.
+
+Please refer to the following variables to customize the connection:
+- `nntp-pre-command',
+- `nntp-via-rlogin-command',
+- `nntp-via-rlogin-command-switches',
+- `nntp-via-user-name',
+- `nntp-via-address',
+- `nntp-via-netcat-command',
+- `nntp-via-netcat-switches',
+- `nntp-address',
+- `nntp-port-number',
+- `nntp-end-of-line'."
+  (let ((command `(,@(when nntp-pre-command
+		       (list nntp-pre-command))
+		   ,nntp-via-rlogin-command
+		   ,@(when nntp-via-rlogin-command-switches
+		       nntp-via-rlogin-command-switches)
+		   ,@(when nntp-via-user-name
+		       (list "-l" nntp-via-user-name))
+		   ,nntp-via-address
+		   ,nntp-via-netcat-command
+		   ,@nntp-via-netcat-switches
+		   ,nntp-address
+		   ,nntp-port-number)))
+    (apply 'start-process "nntpd" buffer command)))
+
 (defun nntp-open-via-telnet-and-telnet (buffer)
   "Open a connection to an nntp server through an intermediate host.
 First telnet the remote host, and then telnet the real news server
@@ -1922,6 +2022,96 @@ Please refer to the following variables to customize the connection:
 	(delete-region (point) (point-max)))
       proc)))
 
+;; Marks handling
+
+(defun nntp-marks-directory (server)
+  (expand-file-name server nntp-marks-directory))
+
+(defvar nntp-server-to-method-cache nil
+  "Alist of servers and select methods.")
+
+(defun nntp-group-pathname (server group &optional file)
+  "Return an absolute file name of FILE for GROUP on SERVER."
+  (let ((method (cdr (assoc server nntp-server-to-method-cache))))
+    (unless method
+      (push (cons server (setq method (or (gnus-server-to-method server)
+					  (gnus-find-method-for-group group))))
+	    nntp-server-to-method-cache))
+    (nnmail-group-pathname
+     (mm-decode-coding-string group
+			      (inline (gnus-group-name-charset method group)))
+     (nntp-marks-directory server)
+     file)))
+
+(defun nntp-possibly-create-directory (group server)
+  (let ((dir (nntp-group-pathname server group))
+	(file-name-coding-system nnmail-pathname-coding-system))
+    (unless (file-exists-p dir)
+      (make-directory (directory-file-name dir) t)
+      (nnheader-message 5 "Creating nntp marks directory %s" dir))))
+
+(eval-and-compile
+  (autoload 'time-less-p "time-date"))
+
+(defun nntp-marks-changed-p (group server)
+  (let ((file (nntp-group-pathname server group nntp-marks-file-name))
+	(file-name-coding-system nnmail-pathname-coding-system))
+    (if (null (gnus-gethash file nntp-marks-modtime))
+	t ;; never looked at marks file, assume it has changed
+      (time-less-p (gnus-gethash file nntp-marks-modtime)
+		   (nth 5 (file-attributes file))))))
+
+(defun nntp-save-marks (group server)
+  (let ((file-name-coding-system nnmail-pathname-coding-system)
+	(file (nntp-group-pathname server group nntp-marks-file-name)))
+    (condition-case err
+	(progn
+	  (nntp-possibly-create-directory group server)
+	  (with-temp-file file
+	    (erase-buffer)
+	    (gnus-prin1 nntp-marks)
+	    (insert "\n"))
+	  (gnus-sethash file
+			(nth 5 (file-attributes file))
+			nntp-marks-modtime))
+      (error (or (gnus-yes-or-no-p
+		  (format "Could not write to %s (%s).  Continue? " file err))
+		 (error "Cannot write to %s (%s)" file err))))))
+
+(defun nntp-open-marks (group server)
+  (let ((file (nntp-group-pathname server group nntp-marks-file-name))
+	(file-name-coding-system nnmail-pathname-coding-system))
+    (if (file-exists-p file)
+	(condition-case err
+	    (with-temp-buffer
+	      (gnus-sethash file (nth 5 (file-attributes file))
+			    nntp-marks-modtime)
+	      (nnheader-insert-file-contents file)
+	      (setq nntp-marks (read (current-buffer)))
+	      (dolist (el gnus-article-unpropagated-mark-lists)
+		(setq nntp-marks (gnus-remassoc el nntp-marks))))
+	  (error (or (gnus-yes-or-no-p
+		      (format "Error reading nntp marks file %s (%s).  Continuing will use marks from .newsrc.eld.  Continue? " file err))
+		     (error "Cannot read nntp marks file %s (%s)" file err))))
+      ;; User didn't have a .marks file.  Probably first time
+      ;; user of the .marks stuff.  Bootstrap it from .newsrc.eld.
+      (let ((info (gnus-get-info
+		   (gnus-group-prefixed-name
+		    group
+		    (gnus-server-to-method (format "nntp:%s" server)))))
+	    (decoded-name (mm-decode-coding-string
+			   group
+			   (gnus-group-name-charset
+			    (gnus-server-to-method server) group))))
+	(nnheader-message 7 "Bootstrapping marks for %s..." decoded-name)
+	(setq nntp-marks (gnus-info-marks info))
+	(push (cons 'read (gnus-info-read info)) nntp-marks)
+	(dolist (el gnus-article-unpropagated-mark-lists)
+	  (setq nntp-marks (gnus-remassoc el nntp-marks)))
+	(nntp-save-marks group server)
+	(nnheader-message 7 "Bootstrapping marks for %s...done"
+			  decoded-name)))))
+
 (provide 'nntp)
 
 ;;; arch-tag: 8655466a-b1b5-4929-9c45-7b1b2e767271