From 2b13970a9210521ca17de0f527efe3da20016ed3 Mon Sep 17 00:00:00 2001 From: yamaoka Date: Tue, 12 Jan 1999 03:52:17 +0000 Subject: [PATCH] * 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. --- lisp/nnheader.el | 2 ++ lisp/nntp.el | 37 ++++++++++++++++++++++++++++++++++--- 2 files changed, 36 insertions(+), 3 deletions(-) diff --git a/lisp/nnheader.el b/lisp/nnheader.el index 35aee59..f359a7d 100644 --- 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 --- 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 +;; Katsumi Yamaoka ;; 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) -- 1.7.10.4