2001-10-30 Katsumi Yamaoka <yamaoka@jpl.org>

	* gnus-art.el (article-verify-cancel-lock): New function.

	* nnheader.el (nntp-process-response): New variable.
	(nnheader-init-server-buffer): Make `nntp-process-response'
	buffer-local in `nntp-server-buffer'.

	* nntp.el (nntp-prepare-post-hook): New hook.
	(nntp-wait-for): Save a server's ID in `nntp-process-response'.
	(nntp-async-trigger): Ditto.
	(nntp-request-post): Insert a server's ID if there's no Message-ID
	header; run `nntp-prepare-post-hook'.

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 85f19bb..80b3fb0 100644 (file)
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,17 @@
+2001-10-30  Katsumi Yamaoka  <yamaoka@jpl.org>
+
+       * gnus-art.el (article-verify-cancel-lock): New function.
+
+       * nnheader.el (nntp-process-response): New variable.
+       (nnheader-init-server-buffer): Make `nntp-process-response'
+       buffer-local in `nntp-server-buffer'.
+
+       * nntp.el (nntp-prepare-post-hook): New hook.
+       (nntp-wait-for): Save a server's ID in `nntp-process-response'.
+       (nntp-async-trigger): Ditto.
+       (nntp-request-post): Insert a server's ID if there's no Message-ID
+       header; run `nntp-prepare-post-hook'.
+       
 2001-10-30 04:00:00  ShengHuo ZHU  <zsh@cs.rochester.edu>
 
        * gnus-art.el (article-decode-group-name): Use nnmail-fetch-field

diff --git a/lisp/gnus-art.el b/lisp/gnus-art.el
index f0a02ff..87bd950 100644 (file)
--- a/lisp/gnus-art.el
+++ b/lisp/gnus-art.el
@@ -2899,6 +2899,14 @@ If variable `gnus-use-long-file-name' is non-nil, it is
                  (put-text-property (match-end 0) (point-max)
                                     'face eface)))))))))
 
+(autoload 'canlock-verify "canlock")
+
+(defun article-verify-cancel-lock ()
+  "Verify Cancel-Lock header."
+  (interactive)
+  (if (gnus-buffer-live-p gnus-original-article-buffer)
+      (canlock-verify gnus-original-article-buffer)))
+
 (eval-and-compile
   (mapcar
    (lambda (func)
@@ -2920,6 +2928,7 @@ If variable `gnus-use-long-file-name' is non-nil, it is
                  (apply ',afunc args))))))))
    '(article-hide-headers
      article-verify-x-pgp-sig
+     article-verify-cancel-lock
      article-hide-boring-headers
      article-treat-overstrike
      article-fill-long-lines

diff --git a/lisp/nnheader.el b/lisp/nnheader.el
index b335f22..ed74363 100644 (file)
--- a/lisp/nnheader.el
+++ b/lisp/nnheader.el
@@ -482,6 +482,7 @@ the line could be found."
 ;; Various cruft the backends and Gnus need to communicate.
 
 (defvar nntp-server-buffer nil)
+(defvar nntp-process-response nil)
 (defvar news-reply-yank-from nil)
 (defvar news-reply-yank-message-id nil)
 
@@ -497,6 +498,7 @@ the line could be found."
     (erase-buffer)
     (kill-all-local-variables)
     (setq case-fold-search t)          ;Should ignore case.
+    (set (make-local-variable 'nntp-process-response) nil)
     t))
 
 ;;; Various functions the backends use.

diff --git a/lisp/nntp.el b/lisp/nntp.el
index c82285f..ac2362c 100644 (file)
--- a/lisp/nntp.el
+++ b/lisp/nntp.el
@@ -196,6 +196,10 @@ server there that you can connect to.  See also
 If this variable is nil, which is the default, no timers are set.
 NOTE: This variable is never seen to work in Emacs 20 and XEmacs 21.")
 
+(defvoo nntp-prepare-post-hook nil
+  "*Hook run just before posting an article.  It is supposed to be used
+to insert Cancel-Lock headers.")
+
 ;;; Internal variables.
 
 (defvar nntp-record-commands nil
@@ -289,19 +293,23 @@ noticing asynchronous data.")
          (nnheader-report 'nntp "Server closed connection"))
         (t
          (goto-char (point-max))
-         (let ((limit (point-min)))
+         (let ((limit (point-min))
+               response)
            (while (not (re-search-backward wait-for limit t))
              (nntp-accept-process-output process)
              ;; We assume that whatever we wait for is less than 1000
              ;; characters long.
              (setq limit (max (- (point-max) 1000) (point-min)))
-             (goto-char (point-max))))
+             (goto-char (point-max)))
+           (setq response (match-string 0))
+           (with-current-buffer nntp-server-buffer
+             (setq nntp-process-response response)))
          (nntp-decode-text (not decode))
          (unless discard
            (save-excursion
-             (set-buffer buffer)
-             (goto-char (point-max))
-             (insert-buffer-substring (process-buffer process))
+             (set-buffer buffer)
+             (goto-char (point-max))
+             (insert-buffer-substring (process-buffer process))
              ;; Nix out "nntp reading...." message.
              (when nntp-have-messaged
                (setq nntp-have-messaged nil)
@@ -837,7 +845,23 @@ noticing asynchronous data.")
 (deffoo nntp-request-post (&optional server)
   (nntp-possibly-change-group nil server)
   (when (nntp-send-command "^[23].*\r?\n" "POST")
-    (nntp-send-buffer "^[23].*\n")))
+    (let ((response (with-current-buffer nntp-server-buffer
+                     nntp-process-response))
+         server-id)
+      (when (and response
+                (string-match "^[23].*\\(<[^\t\n @<>]+@[^\t\n @<>]+>\\)"
+                              response))
+       (setq server-id (match-string 1 response))
+       (narrow-to-region (goto-char (point-min))
+                         (if (search-forward "\n\n" nil t)
+                             (1- (point))
+                           (point-max)))
+       (unless (mail-fetch-field "Message-ID")
+         (goto-char (point-min))
+         (insert "Message-ID: " server-id "\n"))
+       (widen))
+      (run-hooks 'nntp-prepare-post-hook)
+      (nntp-send-buffer "^[23].*\n"))))
 
 (deffoo nntp-request-type (group article)
   'news)
@@ -1077,6 +1101,9 @@ password contained in '~/.nntp-authinfo'."
        (goto-char (point-max))
        (when (re-search-backward
               nntp-process-wait-for nntp-process-start-point t)
+         (let ((response (match-string 0)))
+           (with-current-buffer nntp-server-buffer
+             (setq nntp-process-response response)))
          (nntp-async-stop process)
          ;; convert it.
          (when (gnus-buffer-exists-p nntp-process-to-buffer)