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

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

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

revision 1.283 by eliz, Sat May 21 11:48:00 2005 UTC revision 1.284 by rms, Fri Jun 17 14:28:44 2005 UTC
# Line 42  Line 42 
42    :prefix "mail-"    :prefix "mail-"
43    :group 'mail)    :group 'mail)
44    
45    (defcustom mail-setup-with-from t
46      "Non-nil means insert `From:' field when setting up the message."
47      :type 'binary
48      :group 'sendmail
49      :version "22.1")
50    
51  ;;;###autoload  ;;;###autoload
52  (defcustom mail-from-style 'angles "\  (defcustom mail-from-style 'angles "\
53  *Specifies how \"From:\" fields look.  *Specifies how \"From:\" fields look.
# Line 416  actually occur.") Line 422  actually occur.")
422    (setq mail-send-actions actions)    (setq mail-send-actions actions)
423    (setq mail-reply-action replybuffer)    (setq mail-reply-action replybuffer)
424    (goto-char (point-min))    (goto-char (point-min))
425      (if mail-setup-with-from
426          (mail-insert-from-field))
427    (insert "To: ")    (insert "To: ")
428    (save-excursion    (save-excursion
429      (if to      (if to
# Line 884  instead use sendmail-coding-system to ge Line 892  instead use sendmail-coding-system to ge
892  of outgoing mails regardless of the current language environment.  of outgoing mails regardless of the current language environment.
893  See also the function `select-message-coding-system'.")  See also the function `select-message-coding-system'.")
894    
895    (defun mail-insert-from-field ()
896      (let* ((login user-mail-address)
897             (fullname (user-full-name))
898             (quote-fullname nil))
899        (if (string-match "[^\0-\177]" fullname)
900            (setq fullname (rfc2047-encode-string fullname)
901                  quote-fullname t))
902        (cond ((eq mail-from-style 'angles)
903               (insert "From: " fullname)
904               (let ((fullname-start (+ (point-min) 6))
905                     (fullname-end (point-marker)))
906                 (goto-char fullname-start)
907                 ;; Look for a character that cannot appear unquoted
908                 ;; according to RFC 822.
909                 (if (or (re-search-forward "[^- !#-'*+/-9=?A-Z^-~]"
910                                            fullname-end 1)
911                         quote-fullname)
912                     (progn
913                       ;; Quote fullname, escaping specials.
914                       (goto-char fullname-start)
915                       (insert "\"")
916                       (while (re-search-forward "[\"\\]"
917                                                 fullname-end 1)
918                         (replace-match "\\\\\\&" t))
919                       (insert "\""))))
920               (insert " <" login ">\n"))
921              ((eq mail-from-style 'parens)
922               (insert "From: " login " (")
923               (let ((fullname-start (point)))
924                 (if quote-fullname
925                     (insert "\""))
926                 (insert fullname)
927                 (if quote-fullname
928                     (insert "\""))
929                 (let ((fullname-end (point-marker)))
930                   (goto-char fullname-start)
931                   ;; RFC 822 says \ and nonmatching parentheses
932                   ;; must be escaped in comments.
933                   ;; Escape every instance of ()\ ...
934                   (while (re-search-forward "[()\\]" fullname-end 1)
935                     (replace-match "\\\\\\&" t))
936                   ;; ... then undo escaping of matching parentheses,
937                   ;; including matching nested parentheses.
938                   (goto-char fullname-start)
939                   (while (re-search-forward
940                           "\\(\\=\\|[^\\]\\(\\\\\\\\\\)*\\)\\\\(\\(\\([^\\]\\|\\\\\\\\\\)*\\)\\\\)"
941                           fullname-end 1)
942                     (replace-match "\\1(\\3)" t)
943                     (goto-char fullname-start))))
944               (insert ")\n"))
945              ((null mail-from-style)
946               (insert "From: " login "\n"))
947              ((eq mail-from-style 'system-default)
948               nil)
949              (t (error "Invalid value for `mail-from-style'")))))
950    
951  (defun sendmail-send-it ()  (defun sendmail-send-it ()
952    "Send the current mail buffer using the Sendmail package.    "Send the current mail buffer using the Sendmail package.
953  This is a suitable value for `send-mail-function'.  It sends using the  This is a suitable value for `send-mail-function'.  It sends using the
# Line 980  external program defined by `sendmail-pr Line 1044  external program defined by `sendmail-pr
1044              ;; they put one in themselves.              ;; they put one in themselves.
1045              (goto-char (point-min))              (goto-char (point-min))
1046              (if (not (re-search-forward "^From:" delimline t))              (if (not (re-search-forward "^From:" delimline t))
1047                  (let* ((login user-mail-address)                  (mail-insert-from-field))
                        (fullname (user-full-name))  
                        (quote-fullname nil))  
                   (if (string-match "[^\0-\177]" fullname)  
                       (setq fullname (rfc2047-encode-string fullname)  
                             quote-fullname t))  
                   (cond ((eq mail-from-style 'angles)  
                          (insert "From: " fullname)  
                          (let ((fullname-start (+ (point-min) 6))  
                                (fullname-end (point-marker)))  
                            (goto-char fullname-start)  
                            ;; Look for a character that cannot appear unquoted  
                            ;; according to RFC 822.  
                            (if (or (re-search-forward "[^- !#-'*+/-9=?A-Z^-~]"  
                                                       fullname-end 1)  
                                    quote-fullname)  
                                (progn  
                                  ;; Quote fullname, escaping specials.  
                                  (goto-char fullname-start)  
                                  (insert "\"")  
                                  (while (re-search-forward "[\"\\]"  
                                                            fullname-end 1)  
                                    (replace-match "\\\\\\&" t))  
                                  (insert "\""))))  
                          (insert " <" login ">\n"))  
                         ((eq mail-from-style 'parens)  
                          (insert "From: " login " (")  
                          (let ((fullname-start (point)))  
                            (if quote-fullname  
                                (insert "\""))  
                            (insert fullname)  
                            (if quote-fullname  
                                (insert "\""))  
                            (let ((fullname-end (point-marker)))  
                              (goto-char fullname-start)  
                              ;; RFC 822 says \ and nonmatching parentheses  
                              ;; must be escaped in comments.  
                              ;; Escape every instance of ()\ ...  
                              (while (re-search-forward "[()\\]" fullname-end 1)  
                                (replace-match "\\\\\\&" t))  
                              ;; ... then undo escaping of matching parentheses,  
                              ;; including matching nested parentheses.  
                              (goto-char fullname-start)  
                              (while (re-search-forward  
                                      "\\(\\=\\|[^\\]\\(\\\\\\\\\\)*\\)\\\\(\\(\\([^\\]\\|\\\\\\\\\\)*\\)\\\\)"  
                                      fullname-end 1)  
                                (replace-match "\\1(\\3)" t)  
                                (goto-char fullname-start))))  
                          (insert ")\n"))  
                         ((null mail-from-style)  
                          (insert "From: " login "\n"))  
                         ((eq mail-from-style 'system-default)  
                          nil)  
                         (t (error "Invalid value for `mail-from-style'")))))  
1048              ;; Possibly add a MIME header for the current coding system              ;; Possibly add a MIME header for the current coding system
1049              (let (charset)              (let (charset)
1050                (goto-char (point-min))                (goto-char (point-min))

Legend:
Removed from v.1.283  
changed lines
  Added in v.1.284

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