/[emacs]/emacs/lisp/mail/smtpmail.el
ViewVC logotype

Diff of /emacs/lisp/mail/smtpmail.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.31.4.1 by eliz, Mon Dec 10 19:52:41 2001 UTC revision 1.31.4.2 by lektu, Mon Nov 18 08:57:48 2002 UTC
# Line 39  Line 39 
39  ;;(setq smtpmail-sendto-domain "YOUR DOMAIN NAME")  ;;(setq smtpmail-sendto-domain "YOUR DOMAIN NAME")
40  ;;(setq smtpmail-debug-info t) ; only to debug problems  ;;(setq smtpmail-debug-info t) ; only to debug problems
41    
42  ;; To queue mail, set smtpmail-queue-mail to t and use  ;; To queue mail, set smtpmail-queue-mail to t and use
43  ;; smtpmail-send-queued-mail to send.  ;; smtpmail-send-queued-mail to send.
44    
45    
# Line 59  Line 59 
59    :type '(choice (const nil) string)    :type '(choice (const nil) string)
60    :group 'smtpmail)    :group 'smtpmail)
61    
62  (defcustom smtpmail-smtp-server  (defcustom smtpmail-smtp-server
63    (or (getenv "SMTPSERVER") smtpmail-default-smtp-server)    (or (getenv "SMTPSERVER") smtpmail-default-smtp-server)
64    "*The name of the host running SMTP server."    "*The name of the host running SMTP server."
65    :type '(choice (const nil) string)    :type '(choice (const nil) string)
# Line 103  buffer includes an exchange like: Line 103  buffer includes an exchange like:
103    :type 'boolean    :type 'boolean
104    :group 'smtpmail)    :group 'smtpmail)
105    
106  (defcustom smtpmail-queue-mail nil  (defcustom smtpmail-queue-mail nil
107    "*Specify if mail is queued (if t) or sent immediately (if nil).    "*Specify if mail is queued (if t) or sent immediately (if nil).
108  If queued, it is stored in the directory `smtpmail-queue-dir'  If queued, it is stored in the directory `smtpmail-queue-dir'
109  and sent with `smtpmail-send-queued-mail'."  and sent with `smtpmail-send-queued-mail'."
# Line 224  This is relative to `smtpmail-queue-dir' Line 224  This is relative to `smtpmail-queue-dir'
224                               ;; ... then undo escaping of matching parentheses,                               ;; ... then undo escaping of matching parentheses,
225                               ;; including matching nested parentheses.                               ;; including matching nested parentheses.
226                               (goto-char fullname-start)                               (goto-char fullname-start)
227                               (while (re-search-forward                               (while (re-search-forward
228                                       "\\(\\=\\|[^\\]\\(\\\\\\\\\\)*\\)\\\\(\\(\\([^\\]\\|\\\\\\\\\\)*\\)\\\\)"                                       "\\(\\=\\|[^\\]\\(\\\\\\\\\\)*\\)\\\\(\\(\\([^\\]\\|\\\\\\\\\\)*\\)\\\\)"
229                                       fullname-end 1)                                       fullname-end 1)
230                                 (replace-match "\\1(\\3)" t)                                 (replace-match "\\1(\\3)" t)
# Line 252  This is relative to `smtpmail-queue-dir' Line 252  This is relative to `smtpmail-queue-dir'
252            (setq smtpmail-recipient-address-list            (setq smtpmail-recipient-address-list
253                      (smtpmail-deduce-address-list tembuf (point-min) delimline))                      (smtpmail-deduce-address-list tembuf (point-min) delimline))
254            (kill-buffer smtpmail-address-buffer)            (kill-buffer smtpmail-address-buffer)
255              
256            (smtpmail-do-bcc delimline)            (smtpmail-do-bcc delimline)
257            ; Send or queue            ; Send or queue
258            (if (not smtpmail-queue-mail)            (if (not smtpmail-queue-mail)
259                (if (not (null smtpmail-recipient-address-list))                (if (not (null smtpmail-recipient-address-list))
260                    (if (not (smtpmail-via-smtp                    (if (not (smtpmail-via-smtp
261                              smtpmail-recipient-address-list tembuf))                              smtpmail-recipient-address-list tembuf))
262                        (error "Sending failed; SMTP protocol error"))                        (error "Sending failed; SMTP protocol error"))
263                  (error "Sending failed; no recipients"))                  (error "Sending failed; no recipients"))
264              (let* ((file-data (concat              (let* ((file-data (concat
265                                 smtpmail-queue-dir                                 smtpmail-queue-dir
266                                 (concat (time-stamp-yyyy-mm-dd)                                 (concat (time-stamp-yyyy-mm-dd)
267                                         "_" (time-stamp-hh:mm:ss))))                                         "_" (time-stamp-hh:mm:ss))))
# Line 280  This is relative to `smtpmail-queue-dir' Line 280  This is relative to `smtpmail-queue-dir'
280                  (insert (concat                  (insert (concat
281                           "(setq smtpmail-recipient-address-list '"                           "(setq smtpmail-recipient-address-list '"
282                           (prin1-to-string smtpmail-recipient-address-list)                           (prin1-to-string smtpmail-recipient-address-list)
283                           ")\n"))                                               ")\n"))
284                  (write-file file-elisp)                  (write-file file-elisp)
285                  (set-buffer (generate-new-buffer buffer-scratch))                  (set-buffer (generate-new-buffer buffer-scratch))
286                  (insert (concat file-data "\n"))                  (insert (concat file-data "\n"))
287                  (append-to-file (point-min)                  (append-to-file (point-min)
288                                  (point-max)                                  (point-max)
289                                  smtpmail-queue-index)                                  smtpmail-queue-index)
290                  )                  )
291                (kill-buffer buffer-scratch)                (kill-buffer buffer-scratch)
# Line 295  This is relative to `smtpmail-queue-dir' Line 295  This is relative to `smtpmail-queue-dir'
295        (if (bufferp errbuf)        (if (bufferp errbuf)
296            (kill-buffer errbuf)))))            (kill-buffer errbuf)))))
297    
298    ;;;###autoload
299  (defun smtpmail-send-queued-mail ()  (defun smtpmail-send-queued-mail ()
300    "Send mail that was queued as a result of setting `smtpmail-queue-mail'."    "Send mail that was queued as a result of setting `smtpmail-queue-mail'."
301    (interactive)    (interactive)
# Line 315  This is relative to `smtpmail-queue-dir' Line 316  This is relative to `smtpmail-queue-dir'
316          ;; encoding wrongly.          ;; encoding wrongly.
317          (setq tembuf (find-file-noselect file-msg nil t))          (setq tembuf (find-file-noselect file-msg nil t))
318          (if (not (null smtpmail-recipient-address-list))          (if (not (null smtpmail-recipient-address-list))
319              (if (not (smtpmail-via-smtp smtpmail-recipient-address-list              (if (not (smtpmail-via-smtp smtpmail-recipient-address-list
320                                          tembuf))                                          tembuf))
321                  (error "Sending failed; SMTP protocol error"))                  (error "Sending failed; SMTP protocol error"))
322            (error "Sending failed; no recipients"))              (error "Sending failed; no recipients"))
323          (delete-file file-msg)          (delete-file file-msg)
324          (delete-file (concat file-msg ".el"))          (delete-file (concat file-msg ".el"))
325          (kill-buffer tembuf)          (kill-buffer tembuf)
326          (kill-line 1))                (kill-line 1))
327        (set-buffer buffer-index)        (set-buffer buffer-index)
328        (save-buffer smtpmail-queue-index)        (save-buffer smtpmail-queue-index)
329        (kill-buffer buffer-index)        (kill-buffer buffer-index)
# Line 374  This is relative to `smtpmail-queue-dir' Line 375  This is relative to `smtpmail-queue-dir'
375              (make-local-variable 'smtpmail-read-point)              (make-local-variable 'smtpmail-read-point)
376              (setq smtpmail-read-point (point-min))              (setq smtpmail-read-point (point-min))
377    
378                
379              (if (or (null (car (setq greeting (smtpmail-read-response process))))              (if (or (null (car (setq greeting (smtpmail-read-response process))))
380                      (not (integerp (car greeting)))                      (not (integerp (car greeting)))
381                      (>= (car greeting) 400))                      (>= (car greeting) 400))
# Line 480  This is relative to `smtpmail-queue-dir' Line 481  This is relative to `smtpmail-queue-dir'
481                        (>= (car response-code) 400))                        (>= (car response-code) 400))
482                    (throw 'done nil)                    (throw 'done nil)
483                  ))                  ))
484                
485              ;; RCPT TO: <recipient>              ;; RCPT TO: <recipient>
486              (let ((n 0))              (let ((n 0))
487                (while (not (null (nth n recipient)))                (while (not (null (nth n recipient)))
# Line 494  This is relative to `smtpmail-queue-dir' Line 495  This is relative to `smtpmail-queue-dir'
495                      (throw 'done nil)                      (throw 'done nil)
496                    )                    )
497                  ))                  ))
498                
499              ;; DATA              ;; DATA
500              (smtpmail-send-command process "DATA")              (smtpmail-send-command process "DATA")
501    
# Line 558  This is relative to `smtpmail-queue-dir' Line 559  This is relative to `smtpmail-queue-dir'
559        (setq response-strings        (setq response-strings
560              (cons (buffer-substring smtpmail-read-point (- match-end 2))              (cons (buffer-substring smtpmail-read-point (- match-end 2))
561                    response-strings))                    response-strings))
562            
563        (goto-char smtpmail-read-point)        (goto-char smtpmail-read-point)
564        (if (looking-at "[0-9]+ ")        (if (looking-at "[0-9]+ ")
565            (let ((begin (match-beginning 0))            (let ((begin (match-beginning 0))
# Line 573  This is relative to `smtpmail-queue-dir' Line 574  This is relative to `smtpmail-queue-dir'
574                  nil                  nil
575                (setq response-continue nil)                (setq response-continue nil)
576                (setq return-value                (setq return-value
577                      (cons (string-to-int                      (cons (string-to-int
578                             (buffer-substring begin end))                             (buffer-substring begin end))
579                            (nreverse response-strings)))))                            (nreverse response-strings)))))
580            
581          (if (looking-at "[0-9]+-")          (if (looking-at "[0-9]+-")
582              (progn (if smtpmail-debug-info              (progn (if smtpmail-debug-info
583                       (message "%s" (car response-strings)))                       (message "%s" (car response-strings)))
# Line 585  This is relative to `smtpmail-queue-dir' Line 586  This is relative to `smtpmail-queue-dir'
586            (progn            (progn
587              (setq smtpmail-read-point match-end)              (setq smtpmail-read-point match-end)
588              (setq response-continue nil)              (setq response-continue nil)
589              (setq return-value              (setq return-value
590                    (cons nil (nreverse response-strings)))                    (cons nil (nreverse response-strings)))
591              )              )
592            )))            )))
# Line 609  This is relative to `smtpmail-queue-dir' Line 610  This is relative to `smtpmail-queue-dir'
610             smtpmail-code-conv-from)             smtpmail-code-conv-from)
611        (setq data (string-as-multibyte        (setq data (string-as-multibyte
612                    (encode-coding-string data smtpmail-code-conv-from))))                    (encode-coding-string data smtpmail-code-conv-from))))
613            
614    (if smtpmail-debug-info    (if smtpmail-debug-info
615        (insert data "\r\n"))        (insert data "\r\n"))
616    
# Line 648  This is relative to `smtpmail-queue-dir' Line 649  This is relative to `smtpmail-queue-dir'
649        )        )
650      )      )
651    )    )
652        
653    
654  (defun smtpmail-deduce-address-list (smtpmail-text-buffer header-start header-end)  (defun smtpmail-deduce-address-list (smtpmail-text-buffer header-start header-end)
655    "Get address list suitable for smtp RCPT TO: <address>."    "Get address list suitable for smtp RCPT TO: <address>."
656    (require 'mail-utils)  ;; pick up mail-strip-quoted-names    (require 'mail-utils)  ;; pick up mail-strip-quoted-names
657        
658    (unwind-protect    (unwind-protect
659        (save-excursion        (save-excursion
660          (set-buffer smtpmail-address-buffer) (erase-buffer)          (set-buffer smtpmail-address-buffer) (erase-buffer)

Legend:
Removed from v.1.31.4.1  
changed lines
  Added in v.1.31.4.2

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26