* nntp.el (nntp-request-post): Put a Message-ID generated by server if it does

not exist in the article.
(nntp-request-post): Run `nntp-prepare-post-hook'.
(nntp-async-trigger): Save a response from the server in
`nntp-process-response' after sending a command.
(nntp-wait-for): Ditto.
(nntp-prepare-post-hook): New hook, run just before postting an article.
* nnheader.el (nnheader-init-server-buffer): Make `nntp-process-response' be
buffer-local in `nntp-server-buffer'.
(nntp-process-response): New variable, used for holding a response from the
server after sending a command.

diff --git a/lisp/nnheader.el b/lisp/nnheader.el
index 35aee59..f359a7d 100644 (file)
--- a/lisp/nnheader.el
+++ b/lisp/nnheader.el
@@ -426,6 +426,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 gnus-verbose-backends 7
   "*A number that says how talkative the Gnus backends should be.")
 (defvar gnus-nov-is-evil nil
@@ -444,6 +445,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 c212806..333ceb8 100644 (file)
--- a/lisp/nntp.el
+++ b/lisp/nntp.el
@@ -2,6 +2,7 @@
 ;;; Copyright (C) 1987-90,92-98 Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
+;;         Katsumi Yamaoka <yamaoka@jpl.org>
 ;; Keywords: news
 
 ;; This file is part of GNU Emacs.
@@ -173,6 +174,10 @@ server there that you can connect to.  See also
   "*Number of seconds to wait before an nntp connection times out.
 If this variable is nil, which is the default, no timers are set.")
 
+(defvoo nntp-prepare-post-hook nil
+  "*Hook run just before postting an article. It is supposed to be used for
+inserting Cancel-Lock headers, signing with Gpg, etc.")
+
 ;;; Internal variables.
 
 (defvar nntp-record-commands nil
@@ -264,13 +269,18 @@ 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))
+           (save-current-buffer
+             (set-buffer nntp-server-buffer)
+             (setq nntp-process-response response)))
          (nntp-decode-text (not decode))
          (unless discard
            (save-excursion
@@ -729,7 +739,24 @@ 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 (save-current-buffer
+                     (set-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)
@@ -963,6 +990,10 @@ 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)))
+           (save-current-buffer
+             (set-buffer nntp-server-buffer)
+             (setq nntp-process-response response)))
          (nntp-async-stop process)
          ;; convert it.
          (when (gnus-buffer-exists-p nntp-process-to-buffer)