patch for mail-streams
Matthew Danish <[email protected]>
| Newsgroups | gmane.lisp.cclan.general |
|---|---|
| Message-ID | <[email protected]> |
Fixes: * Restart now re-creates stream for the body of the message, because it was drained * s/X-Lisp-Programme: yes/User-agent: cl-mail-streams/ * detects whether TO slot is a list or not * initargs for the relevant slots in mail-output-stream -- ; Matthew Danish <[email protected]> ; OpenPGP public key: C24B6010 on keyring.debian.org ; Signed or encrypted mail welcome. ; "There is no dark side of the moon really; matter of fact, it's all dark."
mail-streams.diff
(text/plain, 2 KB)
--- mail-streams.lisp.old Wed Jun 12 17:11:05 2002
+++ mail-streams.lisp Wed Jun 12 17:10:09 2002
@@ -45,11 +45,11 @@
(defclass mail-output-stream (fundamental-character-output-stream)
((real-stream :initarg :stream :initform nil :accessor mail-output-stream-stream)
(string-stream :accessor string-stream :initform (make-string-output-stream))
- (subject :accessor subject :initform "")
- (to :accessor to :initform nil)
- (cc :accessor cc :initform nil)
- (bcc :accessor bcc :initform nil)
- (other-headers :accessor other-headers :initform nil)))
+ (subject :initarg :subject :accessor subject :initform "")
+ (to :initarg :to :accessor to :initform nil)
+ (cc :initarg :cc :accessor cc :initform nil)
+ (bcc :initarg :bcc :accessor bcc :initform nil)
+ (other-headers :initarg :other-headers :accessor other-headers :initform nil)))
(defmethod initialize-instance :after ((object mail-output-stream) &key)
(if (null (mail-output-stream-stream object))
@@ -109,8 +109,10 @@
append (list "-b" x))
(loop for x in (other-headers stream)
append (list "-a" x))
- (list "-a" "X-Lisp-Programme: yes")
- (to stream))))
+ (list "-a" "User-Agent: cl-mail-streams")
+ (if (listp (to stream))
+ (to stream)
+ (list (to stream))))))
(restart-case
(let ((mail-process (portable-run-program
"mail" args
@@ -121,7 +123,10 @@
:error-code (process-exit-code mail-process))))
(retry ()
:report "Retry sending mail."
- (close stream))
+ (let ((s-o-s (make-string-output-stream)))
+ (princ body-string s-o-s)
+ (setf (mail-output-stream-stream stream) s-o-s)
+ (close stream)))
(save (pathname)
:report "Save mail body to file."
:interactive (lambda ()
@@ -131,4 +136,5 @@
(write body-string :stream s))))))
(eval-when (:load-toplevel :execute)
- (pushnew :mail-streams *features*))
\ No newline at end of file
+ (pushnew :mail-streams *features*))
+