From: Chris Hanson <org/chris-hanson/cph>
Date: Thu, 22 Jun 2000 20:19:08 +0000 (+0000)
Subject: Use new hook to modify the "User-Agent" header.
X-Git-Tag: 20090517-FFI~3459
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=75dad316087b3966a833a52f3c3d2ae3b4e593fe;p=mit-scheme.git

Use new hook to modify the "User-Agent" header.
---

diff --git a/v7/src/imail/imail-top.scm b/v7/src/imail/imail-top.scm
index 5c9de2b34..7049cd992 100644
--- a/v7/src/imail/imail-top.scm
+++ b/v7/src/imail/imail-top.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: imail-top.scm,v 1.181 2000/06/20 19:36:09 cph Exp $
+;;; $Id: imail-top.scm,v 1.182 2000/06/22 20:18:59 cph Exp $
 ;;;
 ;;; Copyright (c) 1999-2000 Massachusetts Institute of Technology
 ;;;
@@ -905,7 +905,9 @@ original message into it."
   (lambda ()
     (make-mail-buffer '(("To" "") ("Subject" ""))
 		      (chase-imail-buffer (selected-buffer))
-		      select-buffer-other-window)))
+		      (lambda (mail-buffer)
+			(initialize-imail-mail-buffer mail-buffer)
+			(select-buffer-other-window mail-buffer)))))
 
 (define-command imail-reply
   "Reply to the current message.
@@ -919,6 +921,7 @@ While composing the reply, use \\[mail-yank-original] to yank the
       (make-mail-buffer (imail-reply-headers message (not just-sender?))
 			(chase-imail-buffer (selected-buffer))
 			(lambda (mail-buffer)
+			  (initialize-imail-mail-buffer mail-buffer)
 			  (message-answered message)
 			  (select-buffer-other-window mail-buffer))))))
 
@@ -930,6 +933,13 @@ While composing the reply, use \\[mail-yank-original] to yank the
 ;; This procedure is invoked by M-x mail-yank-original in Mail mode.
 (define (imail-yank-original buffer left-margin mark)
   (insert-message (selected-message #t buffer) #t left-margin mark))
+
+(define (initialize-imail-mail-buffer buffer)
+  (buffer-put! buffer 'MAILER-VERSION-STRING imail-mailer-version-string))
+
+(define (imail-mailer-version-string generic)
+  (string-append "IMAIL/" (get-subsystem-version-string "IMAIL")
+		 "; " generic))
 
 (define-command imail-forward
   "Forward the current message to another user.
@@ -957,6 +967,7 @@ see the documentation of `imail-resend'."
 	  "]")))
      #f
      (lambda (mail-buffer)
+       (initialize-imail-mail-buffer mail-buffer)
        (let ((raw? (ref-variable imail-forward-all-headers mail-buffer)))
 	 (if (ref-variable imail-forward-using-mime mail-buffer)
 	     (add-buffer-mime-attachment!
@@ -999,6 +1010,7 @@ ADDRESSES is a string consisting of several addresses separated by commas."
 		    (string-ci=? (header-field-name header) "sender")))))
        #f
        (lambda (mail-buffer)
+	 (initialize-imail-mail-buffer mail-buffer)
 	 (with-buffer-point-preserved mail-buffer
 	   (lambda ()
 	     (insert-message-body message (buffer-end mail-buffer))))
diff --git a/v7/src/imail/todo.txt b/v7/src/imail/todo.txt
index 06c473bca..e138d96b3 100644
--- a/v7/src/imail/todo.txt
+++ b/v7/src/imail/todo.txt
@@ -1,5 +1,5 @@
 IMAIL To-Do List
-$Id: todo.txt,v 1.93 2000/06/20 20:38:25 cph Exp $
+$Id: todo.txt,v 1.94 2000/06/22 20:19:08 cph Exp $
 
 Bug fixes
 ---------
@@ -40,8 +40,6 @@ New features
   Use this to extend M-x imail-rename-folder to work in all cases by
   using copy/delete when rename inapplicable.
 
-* Generate more specific X-Mailer header.
-
 * Add variable to control how multipart/alternative shows the
   secondary alternatives.