/[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.35 by rms, Sun Nov 25 17:43:47 2001 UTC revision 1.36 by monnier, Sat Dec 1 00:36:12 2001 UTC
# Line 70  Line 70 
70  (autoload 'starttls-open-stream "starttls")  (autoload 'starttls-open-stream "starttls")
71  (autoload 'starttls-negotiate "starttls")  (autoload 'starttls-negotiate "starttls")
72  (autoload 'mail-strip-quoted-names "mail-utils")  (autoload 'mail-strip-quoted-names "mail-utils")
73    (autoload 'message-make-date "message")
74    (autoload 'message-make-message-id "message")
75  (autoload 'rfc2104-hash "rfc2104")  (autoload 'rfc2104-hash "rfc2104")
76    
77  ;;;  ;;;
# Line 293  This is relative to `smtpmail-queue-dir' Line 295  This is relative to `smtpmail-queue-dir'
295                           (insert ")\n"))                           (insert ")\n"))
296                          ((null mail-from-style)                          ((null mail-from-style)
297                           (insert "From: " login "\n")))))                           (insert "From: " login "\n")))))
298                ;; Insert a `Message-Id:' field if there isn't one yet.
299                (goto-char (point-min))
300                (unless (re-search-forward "^Message-Id:" delimline t)
301                  (insert "Message-Id: " (message-make-message-id) "\n"))
302                ;; Insert a `Date:' field if there isn't one yet.
303                (goto-char (point-min))
304                (unless (re-search-forward "^Date:" delimline t)
305                  (insert "Date: " (message-make-date) "\n"))
306              ;; Insert an extra newline if we need it to work around              ;; Insert an extra newline if we need it to work around
307              ;; Sun's bug that swallows newlines.              ;; Sun's bug that swallows newlines.
308              (goto-char (1+ delimline))              (goto-char (1+ delimline))
# Line 303  This is relative to `smtpmail-queue-dir' Line 313  This is relative to `smtpmail-queue-dir'
313              (if (re-search-forward "^FCC:" delimline t)              (if (re-search-forward "^FCC:" delimline t)
314                  (mail-do-fcc delimline))                  (mail-do-fcc delimline))
315              (if mail-interactive              (if mail-interactive
316                  (save-excursion                  (with-current-buffer errbuf
                   (set-buffer errbuf)  
317                    (erase-buffer))))                    (erase-buffer))))
318            ;;            ;;
319            ;;            ;;
# Line 331  This is relative to `smtpmail-queue-dir' Line 340  This is relative to `smtpmail-queue-dir'
340                     (buffer-data (create-file-buffer file-data))                     (buffer-data (create-file-buffer file-data))
341                     (buffer-elisp (create-file-buffer file-elisp))                     (buffer-elisp (create-file-buffer file-elisp))
342                     (buffer-scratch "*queue-mail*"))                     (buffer-scratch "*queue-mail*"))
343                (save-excursion                (with-current-buffer buffer-data
                 (set-buffer buffer-data)  
344                  (erase-buffer)                  (erase-buffer)
345                  (insert-buffer tembuf)                  (insert-buffer tembuf)
346                  (write-file file-data)                  (write-file file-data)
# Line 363  This is relative to `smtpmail-queue-dir' Line 371  This is relative to `smtpmail-queue-dir'
371    (let ((buffer-index (find-file-noselect smtpmail-queue-index))    (let ((buffer-index (find-file-noselect smtpmail-queue-index))
372          (file-msg "")          (file-msg "")
373          (tembuf nil))          (tembuf nil))
374      (save-excursion      (with-current-buffer buffer-index
       (set-buffer buffer-index)  
375        (beginning-of-buffer)        (beginning-of-buffer)
376        (while (not (eobp))        (while (not (eobp))
377          (setq file-msg (buffer-substring (point) (save-excursion          (setq file-msg (buffer-substring (point) (line-end-position)))
                                                    (end-of-line)  
                                                    (point))))  
378          (load file-msg)          (load file-msg)
379          (setq tembuf (find-file-noselect file-msg))          (setq tembuf (find-file-noselect file-msg))
380          (if (not (null smtpmail-recipient-address-list))          (if (not (null smtpmail-recipient-address-list))
# Line 520  This is relative to `smtpmail-queue-dir' Line 525  This is relative to `smtpmail-queue-dir'
525                  (get-buffer-create (format "*trace of SMTP session to %s*" host)))                  (get-buffer-create (format "*trace of SMTP session to %s*" host)))
526    
527            ;; clear the trace buffer of old output            ;; clear the trace buffer of old output
528            (save-excursion            (with-current-buffer process-buffer
             (set-buffer process-buffer)  
529              (erase-buffer))              (erase-buffer))
530    
531            ;; open the connection to the server            ;; open the connection to the server
# Line 531  This is relative to `smtpmail-queue-dir' Line 535  This is relative to `smtpmail-queue-dir'
535            ;; set the send-filter            ;; set the send-filter
536            (set-process-filter process 'smtpmail-process-filter)            (set-process-filter process 'smtpmail-process-filter)
537    
538            (save-excursion            (with-current-buffer process-buffer
             (set-buffer process-buffer)  
539              (set-buffer-process-coding-system 'raw-text-unix 'raw-text-unix)              (set-buffer-process-coding-system 'raw-text-unix 'raw-text-unix)
540              (make-local-variable 'smtpmail-read-point)              (make-local-variable 'smtpmail-read-point)
541              (setq smtpmail-read-point (point-min))              (setq smtpmail-read-point (point-min))
# Line 629  This is relative to `smtpmail-queue-dir' Line 632  This is relative to `smtpmail-queue-dir'
632                     (if (or (member 'size supported-extensions)                     (if (or (member 'size supported-extensions)
633                             (assoc 'size supported-extensions))                             (assoc 'size supported-extensions))
634                         (format " SIZE=%d"                         (format " SIZE=%d"
635                                 (save-excursion                                 (with-current-buffer smtpmail-text-buffer
                                  (set-buffer smtpmail-text-buffer)  
636                                   ;; size estimate:                                   ;; size estimate:
637                                   (+ (- (point-max) (point-min))                                   (+ (- (point-max) (point-min))
638                                      ;; Add one byte for each change-of-line                                      ;; Add one byte for each change-of-line
# Line 713  This is relative to `smtpmail-queue-dir' Line 715  This is relative to `smtpmail-queue-dir'
715  ;                (throw 'done nil))  ;                (throw 'done nil))
716              t ))              t ))
717        (if process        (if process
718            (save-excursion            (with-current-buffer (process-buffer process)
             (set-buffer (process-buffer process))  
719              (smtpmail-send-command process "QUIT")              (smtpmail-send-command process "QUIT")
720              (smtpmail-read-response process)              (smtpmail-read-response process)
721    
# Line 727  This is relative to `smtpmail-queue-dir' Line 728  This is relative to `smtpmail-queue-dir'
728    
729    
730  (defun smtpmail-process-filter (process output)  (defun smtpmail-process-filter (process output)
731    (save-excursion    (with-current-buffer (process-buffer process)
     (set-buffer (process-buffer process))  
732      (goto-char (point-max))      (goto-char (point-max))
733      (insert output)))      (insert output)))
734    
# Line 819  This is relative to `smtpmail-queue-dir' Line 819  This is relative to `smtpmail-queue-dir'
819         this-line         this-line
820         this-line-end)         this-line-end)
821    
822      (save-excursion      (with-current-buffer buffer
       (set-buffer buffer)  
823        (goto-char (point-min)))        (goto-char (point-min)))
824    
825      (while data-continue      (while data-continue
826        (save-excursion        (with-current-buffer buffer
         (set-buffer buffer)  
827          (beginning-of-line)          (beginning-of-line)
828          (setq this-line (point))          (setq this-line (point))
829          (end-of-line)          (end-of-line)
# Line 844  This is relative to `smtpmail-queue-dir' Line 842  This is relative to `smtpmail-queue-dir'
842  (defun smtpmail-deduce-address-list (smtpmail-text-buffer header-start header-end)  (defun smtpmail-deduce-address-list (smtpmail-text-buffer header-start header-end)
843    "Get address list suitable for smtp RCPT TO: <address>."    "Get address list suitable for smtp RCPT TO: <address>."
844    (unwind-protect    (unwind-protect
845        (save-excursion        (with-current-buffer smtpmail-address-buffer
846          (set-buffer smtpmail-address-buffer) (erase-buffer)          (erase-buffer)
847          (let          (let
848              ((case-fold-search t)              ((case-fold-search t)
849               (simple-address-list "")               (simple-address-list "")
# Line 856  This is relative to `smtpmail-queue-dir' Line 854  This is relative to `smtpmail-queue-dir'
854            (goto-char (point-min))            (goto-char (point-min))
855            ;; RESENT-* fields should stop processing of regular fields.            ;; RESENT-* fields should stop processing of regular fields.
856            (save-excursion            (save-excursion
857              (if (re-search-forward "^Resent-\\(to\\|cc\\|bcc\\):" header-end t)              (setq addr-regexp
858                  (setq addr-regexp "^Resent-\\(to\\|cc\\|bcc\\):")                    (if (re-search-forward "^Resent-\\(to\\|cc\\|bcc\\):"
859                (setq addr-regexp  "^\\(To:\\|Cc:\\|Bcc:\\)")))                                           header-end t)
860                          "^Resent-\\(to\\|cc\\|bcc\\):"
861                        "^\\(To:\\|Cc:\\|Bcc:\\)")))
862    
863            (while (re-search-forward addr-regexp header-end t)            (while (re-search-forward addr-regexp header-end t)
864              (replace-match "")              (replace-match "")

Legend:
Removed from v.1.35  
changed lines
  Added in v.1.36

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