Update copyright year to 2016

[gnu-emacs] / lisp / mail / sendmail.el

diff --git a/lisp/mail/sendmail.el b/lisp/mail/sendmail.el
index 7e9bd5bca2fda64e072c991e8f45b826cf1199c7..5ab5bd9a2cda6ac43e1db985be731c1d949ce680 100644 (file)
--- a/lisp/mail/sendmail.el
+++ b/lisp/mail/sendmail.el
@@ -1,6 +1,6 @@
 ;;; sendmail.el --- mail sending commands for Emacs
 
 ;;; sendmail.el --- mail sending commands for Emacs
 

-;; Copyright (C) 1985-1986, 1992-1996, 1998, 2000-2015 Free Software
+;; Copyright (C) 1985-1986, 1992-1996, 1998, 2000-2016 Free Software

 ;; Foundation, Inc.
 
 ;; Maintainer: emacs-devel@gnu.org
 ;; Foundation, Inc.
 
 ;; Maintainer: emacs-devel@gnu.org


@@ -58,7 +58,7 @@
 (defcustom mail-from-style 'default
   "Specifies how \"From:\" fields look.
 
 (defcustom mail-from-style 'default
   "Specifies how \"From:\" fields look.
 

-If `nil', they contain just the return address like:
+If nil, they contain just the return address like:

        king@grassland.com
 If `parens', they look like:
        king@grassland.com (Elvis Parsley)
        king@grassland.com
 If `parens', they look like:
        king@grassland.com (Elvis Parsley)


@@ -525,31 +525,33 @@ This also saves the value of `send-mail-function' via Customize."
          ;; Query the user.
          (with-temp-buffer
            (rename-buffer "*Emacs Mail Setup Help*" t)
          ;; Query the user.
          (with-temp-buffer
            (rename-buffer "*Emacs Mail Setup Help*" t)

-           (insert "\
+           (insert (substitute-command-keys "\

  Emacs is about to send an email message, but it has not been
  configured for sending email.  To tell Emacs how to send email:
 
  Emacs is about to send an email message, but it has not been
  configured for sending email.  To tell Emacs how to send email:
 

- - Type `"
+ - Type `")

                    (propertize "mail client" 'face 'bold)
                    (propertize "mail client" 'face 'bold)

-                   "' to start your default email client and
-   pass it the message text.\n\n")
+                   (substitute-command-keys "\
+' to start your default email client and
+   pass it the message text.\n\n"))

            (and sendmail-program
                 (executable-find sendmail-program)
            (and sendmail-program
                 (executable-find sendmail-program)

-                (insert "\
- - Type `"
+                (insert (substitute-command-keys "\
+ - Type `")

                         (propertize "transport" 'face 'bold)
                         (propertize "transport" 'face 'bold)

-                        "' to invoke the system's mail transport agent
-   (the `"
+                        (substitute-command-keys "\
+' to invoke the system's mail transport agent
+   (the `")

                         sendmail-program
                         sendmail-program

-                        "' program).\n\n"))
-           (insert "\
- - Type `"
+                        (substitute-command-keys "' program).\n\n")))
+           (insert (substitute-command-keys "\
+ - Type `")

                    (propertize "smtp" 'face 'bold)
                    (propertize "smtp" 'face 'bold)

-                   "' to send mail directly to an \"outgoing mail\" server.
+                   (substitute-command-keys "' to send mail directly to an \"outgoing mail\" server.

    (Emacs may prompt you for SMTP settings).
 
  Emacs will record your selection and will use it thereafter.
    (Emacs may prompt you for SMTP settings).
 
  Emacs will record your selection and will use it thereafter.

- To change it later, customize the option `send-mail-function'.\n")
+ To change it later, customize the option `send-mail-function'.\n"))

            (goto-char (point-min))
            (display-buffer (current-buffer))
            (let ((completion-ignore-case t))
            (goto-char (point-min))
            (display-buffer (current-buffer))
            (let ((completion-ignore-case t))


@@ -907,6 +909,8 @@ the user from the mailer."
                 (concat "\\(?:[[:space:];,]\\|\\`\\)"
                         (regexp-opt mail-mailing-lists t)
                         "\\(?:[[:space:];,]\\|\\'\\)"))))
                 (concat "\\(?:[[:space:];,]\\|\\`\\)"
                         (regexp-opt mail-mailing-lists t)
                         "\\(?:[[:space:];,]\\|\\'\\)"))))

+        (mail-combine-fields "To")
+        (mail-combine-fields "CC")

        ;; If there are mailing lists defined
        (when ml
          (save-excursion
        ;; If there are mailing lists defined
        (when ml
          (save-excursion


@@ -1075,6 +1079,71 @@ This function does not perform RFC2047 encoding."
                 (goto-char fullname-start))))
           (insert ")\n")))))
 
                 (goto-char fullname-start))))
           (insert ")\n")))))
 

+(defun mail-combine-fields (field)
+  "Offer to combine all FIELD fields in buffer into one FIELD field.
+If this finds multiple FIELD fields, it asks the user whether
+to combine them into one, and does so if the user says y."
+  (let ((search-pattern (format "^%s[ \t]*:" field))
+        first-to-end
+        query-asked
+        query-answer
+        (old-point (point))
+        (old-max (point-max)))
+    (save-excursion
+      (save-restriction
+        (goto-char (point-min))
+        (narrow-to-region (point-min) (mail-header-end))
+        ;; Find the first FIELD field and record where it ends.
+        (when (re-search-forward search-pattern nil t)
+          (forward-line 1)
+          (re-search-forward "^[^ \t]" nil t)
+          (beginning-of-line)
+          (setq first-to-end (point-marker))
+          (set-marker-insertion-type first-to-end t)
+          ;; Find each following FIELD field
+          ;; and combine it with the first FIELD field.
+          (while (re-search-forward search-pattern nil t)
+            ;; For the second FIELD field, ask user to
+            ;; approve combining them.
+            ;; But if the user refuse to combine them, signal error.
+            (unless query-asked
+              (save-restriction
+                ;; This is just so the screen doesn't change.
+                (narrow-to-region (point-min) old-max)
+                (goto-char old-point)
+                (setq query-asked t)
+                (if (y-or-n-p (format "Message contains multiple %s fields.  Combine? " field))
+                    (setq query-answer t))))
+            (when query-answer
+              (let ((this-to-start (line-beginning-position))
+                    this-to-end
+                    this-to)
+                (forward-line 1)
+                (re-search-forward "^[^ \t]" nil t)
+                (beginning-of-line)
+                (setq this-to-end (point))
+                ;; Get the text of this FIELD field.
+                (setq this-to (buffer-substring this-to-start this-to-end))
+                ;; Delete it.
+                (delete-region this-to-start this-to-end)
+                (save-excursion
+                  ;; Put a comma after the first FIELD field.
+                  (goto-char first-to-end)
+                  (forward-char -1)
+                  (insert ",")
+                  ;; Copy this one after it.
+                  (goto-char first-to-end)
+                  (save-excursion
+                    (insert this-to))
+                  ;; Replace the FIELD: with spaces.
+                  (looking-at search-pattern)
+                  ;; Try to preserve alignment of contents of the field
+                  (let ((prefix-length (length (match-string 0))))
+                    (replace-match " ")
+                    (dotimes (i (1- prefix-length))
+                      (insert " ")))))))
+          (set-marker first-to-end nil))))))
+

 (defun mail-encode-header (beg end)
   "Encode the mail header between BEG and END according to RFC2047.
 Return non-nil if and only if some part of the header is encoded."
 (defun mail-encode-header (beg end)
   "Encode the mail header between BEG and END according to RFC2047.
 Return non-nil if and only if some part of the header is encoded."


@@ -1299,10 +1368,10 @@ external program defined by `sendmail-program'."
                   (error "Sending...failed to %s"
                          (buffer-substring (point-min) (point-max)))))))
       (kill-buffer tembuf)
                   (error "Sending...failed to %s"
                          (buffer-substring (point-min) (point-max)))))))
       (kill-buffer tembuf)

-      (if (and (bufferp errbuf)
-               (not error))
-          (kill-buffer errbuf)
-        (switch-to-buffer-other-window errbuf)))))
+      (when (buffer-live-p errbuf)
+        (if error
+            (switch-to-buffer-other-window errbuf)
+          (kill-buffer errbuf))))))

 
 (autoload 'rmail-output-to-rmail-buffer "rmailout")
 
 
 (autoload 'rmail-output-to-rmail-buffer "rmailout")
 


@@ -1500,9 +1569,10 @@ just append to the file, in Babyl format if necessary."
            (insert "\nMail-Followup-To: "))))
 
 (defun mail-position-on-field (field &optional soft)
            (insert "\nMail-Followup-To: "))))
 
 (defun mail-position-on-field (field &optional soft)

-  "Move to the start of the contents of header field FIELD.
-If there is none, insert one, unless SOFT is non-nil.
-If there are multiple FIELD fields, this goes to the first."
+  "Move to the end of the contents of header field FIELD.
+If there is no such header, insert one, unless SOFT is non-nil.
+If there are multiple FIELD fields, this goes to the first.
+Returns non-nil if FIELD was originally present."

   (let (end
        (case-fold-search t))
     (setq end (mail-header-end))
   (let (end
        (case-fold-search t))
     (setq end (mail-header-end))


@@ -2008,7 +2078,6 @@ you can move to one of them and type C-c C-c to recover that one."
 
 ;; Local Variables:
 ;; byte-compile-dynamic: t
 
 ;; Local Variables:
 ;; byte-compile-dynamic: t

-;; coding: utf-8

 ;; End:
 
 ;;; sendmail.el ends here
 ;; End:
 
 ;;; sendmail.el ends here