emacs: lisp/mail/smtpmail.el comparison

comparison lisp/mail/smtpmail.el @ 41716:e467d0e8f243

Use with-current-buffer. (message-make-date, message-make-message-id): Autoload when needed. (smtpmail-send-it): Use them to add `Date:' and `Message-Id:' headers when missing.

author	Stefan Monnier <monnier@iro.umontreal.ca>
date	Sat, 01 Dec 2001 00:36:12 +0000
parents	608d7b92d289
children	de4a90cd0a5f

comparison

equal deleted inserted replaced

-:3fb1c54eb631
+:e467d0e8f243
 (require 'sendmail)
 (require 'time-stamp)
 (autoload 'starttls-open-stream "starttls")
 (autoload 'starttls-negotiate "starttls")
 (autoload 'mail-strip-quoted-names "mail-utils")
+(autoload 'message-make-date "message")
+(autoload 'message-make-message-id "message")
 (autoload 'rfc2104-hash "rfc2104")
 ;;;
 (defgroup smtpmail nil
 "SMTP protocol for sending mail."
 			       (replace-match "\\1(\\3)" t)
 			       (goto-char fullname-start))))
 			 (insert ")\n"))
 			((null mail-from-style)
 			 (insert "From: " login "\n")))))
+	    ;; Insert a `Message-Id:' field if there isn't one yet.
+	    (goto-char (point-min))
+	    (unless (re-search-forward "^Message-Id:" delimline t)
+	      (insert "Message-Id: " (message-make-message-id) "\n"))
+	    ;; Insert a `Date:' field if there isn't one yet.
+	    (goto-char (point-min))
+	    (unless (re-search-forward "^Date:" delimline t)
+	      (insert "Date: " (message-make-date) "\n"))
 	    ;; Insert an extra newline if we need it to work around
 	    ;; Sun's bug that swallows newlines.
 	    (goto-char (1+ delimline))
 	    (if (eval mail-mailer-swallows-blank-line)
 		(newline))
 	    ;; Find and handle any FCC fields.
 	    (goto-char (point-min))
 	    (if (re-search-forward "^FCC:" delimline t)
 		(mail-do-fcc delimline))
 	    (if mail-interactive
-		(save-excursion
+		(with-current-buffer errbuf
-		  (set-buffer errbuf)
 		  (erase-buffer))))
 	  ;;
 	  ;;
 	  ;;
 	  (setq smtpmail-address-buffer (generate-new-buffer "*smtp-mail*"))
 		      (file-data (convert-standard-filename file-data))
 		      (file-elisp (concat file-data ".el"))
 		   (buffer-data (create-file-buffer file-data))
 		   (buffer-elisp (create-file-buffer file-elisp))
 		   (buffer-scratch "*queue-mail*"))
-	      (save-excursion
+	      (with-current-buffer buffer-data
-		(set-buffer buffer-data)
 		(erase-buffer)
 		(insert-buffer tembuf)
 		(write-file file-data)
 		(set-buffer buffer-elisp)
 		(erase-buffer)
 (interactive)
 ;;; Get index, get first mail, send it, get second mail, etc...
 (let ((buffer-index (find-file-noselect smtpmail-queue-index))
 	(file-msg "")
 	(tembuf nil))
-(save-excursion
+(with-current-buffer buffer-index
-(set-buffer buffer-index)
 (beginning-of-buffer)
 (while (not (eobp))
-	(setq file-msg (buffer-substring (point) (save-excursion
+	(setq file-msg (buffer-substring (point) (line-end-position)))
-						   (end-of-line)
-						   (point))))
 	(load file-msg)
 	(setq tembuf (find-file-noselect file-msg))
 	(if (not (null smtpmail-recipient-address-list))
 	    (if (not (smtpmail-via-smtp smtpmail-recipient-address-list
 					tembuf))
 	  ;; get or create the trace buffer
 	  (setq process-buffer
 		(get-buffer-create (format "*trace of SMTP session to %s*" host)))
 	  ;; clear the trace buffer of old output
-	  (save-excursion
+	  (with-current-buffer process-buffer
-	    (set-buffer process-buffer)
 	    (erase-buffer))
 	  ;; open the connection to the server
 	  (setq process (smtpmail-open-stream process-buffer host port))
 	  (and (null process) (throw 'done nil))
 	  ;; set the send-filter
 	  (set-process-filter process 'smtpmail-process-filter)
-	  (save-excursion
+	  (with-current-buffer process-buffer
-	    (set-buffer process-buffer)
 	    (set-buffer-process-coding-system 'raw-text-unix 'raw-text-unix)
 	    (make-local-variable 'smtpmail-read-point)
 	    (setq smtpmail-read-point (point-min))
 	    ;; MAIL FROM: <sender>
 	    (let ((size-part
 		   (if (or (member 'size supported-extensions)
 			   (assoc 'size supported-extensions))
 		       (format " SIZE=%d"
-			       (save-excursion
+			       (with-current-buffer smtpmail-text-buffer
-				 (set-buffer smtpmail-text-buffer)
 				 ;; size estimate:
 				 (+ (- (point-max) (point-min))
 				    ;; Add one byte for each change-of-line
 				    ;; because or CR-LF representation:
 				    (count-lines (point-min) (point-max))
 ;	    (smtpmail-send-command process "QUIT")
 ;	    (and (null (car (smtpmail-read-response process)))
 ;		 (throw 'done nil))
 	    t ))
 (if process
-	  (save-excursion
+	  (with-current-buffer (process-buffer process)
-	    (set-buffer (process-buffer process))
 	    (smtpmail-send-command process "QUIT")
 	    (smtpmail-read-response process)
 ;	    (if (or (null (car (setq response-code (smtpmail-read-response process))))
 ;		    (not (integerp (car response-code)))
 ;	      )
 	    (delete-process process))))))
 (defun smtpmail-process-filter (process output)
-(save-excursion
+(with-current-buffer (process-buffer process)
-(set-buffer (process-buffer process))
 (goto-char (point-max))
 (insert output)))
 (defun smtpmail-read-response (process)
 (let ((case-fold-search nil)
 ((data-continue t)
 (sending-data nil)
 this-line
 this-line-end)
-(save-excursion
+(with-current-buffer buffer
-(set-buffer buffer)
 (goto-char (point-min)))
 (while data-continue
-(save-excursion
+(with-current-buffer buffer
-	(set-buffer buffer)
 	(beginning-of-line)
 	(setq this-line (point))
 	(end-of-line)
 	(setq this-line-end (point))
 	(setq sending-data nil)
 (defun smtpmail-deduce-address-list (smtpmail-text-buffer header-start header-end)
 "Get address list suitable for smtp RCPT TO: <address>."
 (unwind-protect
-(save-excursion
+(with-current-buffer smtpmail-address-buffer
-	(set-buffer smtpmail-address-buffer) (erase-buffer)
+	(erase-buffer)
 	(let
 	    ((case-fold-search t)
 	     (simple-address-list "")
 	     this-line
 	     this-line-end
 	     addr-regexp)
 	  (insert-buffer-substring smtpmail-text-buffer header-start header-end)
 	  (goto-char (point-min))
 	  ;; RESENT-* fields should stop processing of regular fields.
 	  (save-excursion
-	    (if (re-search-forward "^Resent-\\(to\\|cc\\|bcc\\):" header-end t)
+	    (setq addr-regexp
-		(setq addr-regexp "^Resent-\\(to\\|cc\\|bcc\\):")
+		  (if (re-search-forward "^Resent-\\(to\\|cc\\|bcc\\):"
-	      (setq addr-regexp  "^\\(To:\\|Cc:\\|Bcc:\\)")))
+					 header-end t)
+		      "^Resent-\\(to\\|cc\\|bcc\\):"
+		    "^\\(To:\\|Cc:\\|Bcc:\\)")))
 	  (while (re-search-forward addr-regexp header-end t)
 	    (replace-match "")
 	    (setq this-line (match-beginning 0))
 	    (forward-line 1)

Mercurial > emacs

comparison lisp/mail/smtpmail.el @ 41716:e467d0e8f243