]> code.delx.au - gnu-emacs/blobdiff - lisp/mh-e/mh-comp.el
Merge from origin/emacs-25
[gnu-emacs] / lisp / mh-e / mh-comp.el
index 3f2ee056bdfc7d5ee2ed5830784a361bacba9d97..72980b7ead82bf337ce67387f30b969f916b54a8 100644 (file)
@@ -1,6 +1,7 @@
 ;;; mh-comp.el --- MH-E functions for composing and sending messages
 
 ;;; mh-comp.el --- MH-E functions for composing and sending messages
 
-;; Copyright (C) 1993, 1995, 1997, 2000-2012  Free Software Foundation, Inc.
+;; Copyright (C) 1993, 1995, 1997, 2000-2016 Free Software Foundation,
+;; Inc.
 
 ;; Author: Bill Wohler <wohler@newt.com>
 ;; Maintainer: Bill Wohler <wohler@newt.com>
 
 ;; Author: Bill Wohler <wohler@newt.com>
 ;; Maintainer: Bill Wohler <wohler@newt.com>
@@ -90,7 +91,7 @@ user's MH directory, then in the system MH lib directory.")
 Default is \"replgroupcomps\".
 
 This file is used to form replies to the sender and all recipients of
 Default is \"replgroupcomps\".
 
 This file is used to form replies to the sender and all recipients of
-a message. Only used if `(mh-variant-p 'nmh)' is non-nil.
+a message. Only used if (mh-variant-p \\='nmh) is non-nil.
 If not an absolute file name, the file is searched for first in the
 user's MH directory, then in the system MH lib directory.")
 
 If not an absolute file name, the file is searched for first in the
 user's MH directory, then in the system MH lib directory.")
 
@@ -268,7 +269,7 @@ RETURN-ACTION and any additional arguments are IGNORED."
 
 When you are all through editing a message, you send it with this
 command. You can give a prefix argument ARG to monitor the first stage
 
 When you are all through editing a message, you send it with this
 command. You can give a prefix argument ARG to monitor the first stage
-of the delivery\; this output can be found in a buffer called \"*MH-E
+of the delivery; this output can be found in a buffer called \"*MH-E
 Mail Delivery*\".
 
 The hook `mh-before-send-letter-hook' is run at the beginning of
 Mail Delivery*\".
 
 The hook `mh-before-send-letter-hook' is run at the beginning of
@@ -410,6 +411,7 @@ See also `mh-send'."
   (interactive (list (mh-get-msg-num t)))
   (let* ((from-folder mh-current-folder)
          (config (current-window-configuration))
   (interactive (list (mh-get-msg-num t)))
   (let* ((from-folder mh-current-folder)
          (config (current-window-configuration))
+         (components-file (mh-bare-components))
          (draft
           (cond ((and mh-draft-folder (equal from-folder mh-draft-folder))
                  (pop-to-buffer (find-file-noselect (mh-msg-filename message))
          (draft
           (cond ((and mh-draft-folder (equal from-folder mh-draft-folder))
                  (pop-to-buffer (find-file-noselect (mh-msg-filename message))
@@ -466,7 +468,8 @@ See also `mh-send'."
            ;; Text field, that's an easy case
            (t
             (mh-modify-header-field field value))))))
            ;; Text field, that's an easy case
            (t
             (mh-modify-header-field field value))))))
-     (mh-components-to-list (mh-find-components)))
+     (mh-components-to-list components-file))
+    (delete-file components-file)
     (goto-char (point-min))
     (save-buffer)
     (mh-compose-and-send-mail
     (goto-char (point-min))
     (save-buffer)
     (mh-compose-and-send-mail
@@ -586,6 +589,13 @@ See also `mh-compose-forward-as-mime-flag',
              (mh-forwarded-letter-subject orig-from orig-subject)))
         (mh-insert-fields "Subject:" forw-subject)
         (goto-char (point-min))
              (mh-forwarded-letter-subject orig-from orig-subject)))
         (mh-insert-fields "Subject:" forw-subject)
         (goto-char (point-min))
+        ;; Set the local value of mh-mail-header-separator according to what is
+        ;; present in the buffer...
+        (set (make-local-variable 'mh-mail-header-separator)
+             (save-excursion
+               (goto-char (mh-mail-header-end))
+               (buffer-substring-no-properties (point) (mh-line-end-position))))
+        (set (make-local-variable 'mail-header-separator) mh-mail-header-separator) ;override sendmail.el
         ;; If using MML, translate MH-style directive
         (if (equal mh-compose-insertion 'mml)
             (save-excursion
         ;; If using MML, translate MH-style directive
         (if (equal mh-compose-insertion 'mml)
             (save-excursion
@@ -877,22 +887,6 @@ Optional argument BUFFER can be used to specify the buffer."
           (t
            nil))))
 
           (t
            nil))))
 
-(defun mh-find-components ()
-  "Return the path to the components file."
-  (let (components)
-    (cond
-     ((file-exists-p
-       (setq components
-             (expand-file-name mh-comp-formfile mh-user-path)))
-      components)
-     ((file-exists-p
-       (setq components
-             (expand-file-name mh-comp-formfile mh-lib)))
-      components)
-     (t
-      (error "Can't find %s in %s or %s"
-             mh-comp-formfile mh-user-path mh-lib)))))
-
 (defun mh-send-sub (to cc subject config)
   "Do the real work of composing and sending a letter.
 Expects the TO, CC, and SUBJECT fields as arguments.
 (defun mh-send-sub (to cc subject config)
   "Do the real work of composing and sending a letter.
 Expects the TO, CC, and SUBJECT fields as arguments.
@@ -902,8 +896,8 @@ CONFIG is the window configuration before sending mail."
     (message "Composing a message...")
     (let ((draft (mh-read-draft
                   "message"
     (message "Composing a message...")
     (let ((draft (mh-read-draft
                   "message"
-                  (mh-find-components)
-                  nil)))
+                  (mh-bare-components)
+                  t)))
       (mh-insert-fields "To:" to "Subject:" subject "Cc:" cc)
       (goto-char (point-max))
       (mh-compose-and-send-mail draft "" folder msg-num
       (mh-insert-fields "To:" to "Subject:" subject "Cc:" cc)
       (goto-char (point-max))
       (mh-compose-and-send-mail draft "" folder msg-num
@@ -912,6 +906,29 @@ CONFIG is the window configuration before sending mail."
       (mh-letter-mode-message)
       (mh-letter-adjust-point))))
 
       (mh-letter-mode-message)
       (mh-letter-adjust-point))))
 
+(defun mh-bare-components ()
+  "Generate a temporary, clean components file and return its path."
+  ;; Let comp(1) create the skeleton for us.  This is particularly
+  ;; important with nmh-1.5, because its default "components" needs
+  ;; some processing before it can be used.  Unfortunately, comp(1)
+  ;; doesn't have a -build option.  So, to avoid the possibility of
+  ;; clobbering an existing draft, create a temporary directory and
+  ;; use it as the drafts folder.  Then copy the skeleton to a regular
+  ;; temp file, and return the regular temp file.
+  (let (new
+        (temp-folder (make-temp-file
+                      (concat mh-user-path "draftfolder.") t)))
+    (mh-exec-cmd "comp" "-nowhatnowproc"
+                 "-draftfolder" (format "+%s"
+                                        (file-name-nondirectory temp-folder))
+                 (if (stringp mh-comp-formfile)
+                     (list "-form" mh-comp-formfile)))
+    (setq new (make-temp-file "comp."))
+    (rename-file (concat temp-folder "/" "1") new t)
+    (delete-file (concat temp-folder "/" ".mh_sequences"))
+    (delete-directory temp-folder)
+    new))
+
 (defun mh-read-draft (use initial-contents delete-contents-file)
   "Read draft file into a draft buffer and make that buffer the current one.
 
 (defun mh-read-draft (use initial-contents delete-contents-file)
   "Read draft file into a draft buffer and make that buffer the current one.
 
@@ -1047,7 +1064,7 @@ The versions of MH-E, Emacs, and MH are shown."
                          (string-match "[0-9]+\\.[0-9]+\\(\\.[0-9]+\\)?"
                                        emacs-version)
                          (match-string 0 emacs-version))
                          (string-match "[0-9]+\\.[0-9]+\\(\\.[0-9]+\\)?"
                                        emacs-version)
                          (match-string 0 emacs-version))
-                        ((string-match "[0-9.]*\\( +\([ a-z]+[0-9]+\)\\)?"
+                        ((string-match "[0-9.]*\\( +([ a-z]+[0-9]+)\\)?"
                                        emacs-version)
                          (match-string 0 emacs-version))
                         (t (format "%s.%s" emacs-major-version
                                        emacs-version)
                          (match-string 0 emacs-version))
                         (t (format "%s.%s" emacs-major-version
@@ -1061,7 +1078,8 @@ The versions of MH-E, Emacs, and MH are shown."
 (defun mh-insert-x-face ()
   "Append X-Face, Face or X-Image-URL field to header.
 If the field already exists, this function does nothing."
 (defun mh-insert-x-face ()
   "Append X-Face, Face or X-Image-URL field to header.
 If the field already exists, this function does nothing."
-  (when (and (file-exists-p mh-x-face-file)
+  (when (and (stringp mh-x-face-file)
+             (file-exists-p mh-x-face-file)
              (file-readable-p mh-x-face-file))
     (save-excursion
       (unless (or (mh-position-on-field "X-Face")
              (file-readable-p mh-x-face-file))
     (save-excursion
       (unless (or (mh-position-on-field "X-Face")
@@ -1196,18 +1214,18 @@ discarded."
         (save-excursion
           (let ((search-result nil))
             (while fields
         (save-excursion
           (let ((search-result nil))
             (while fields
-              (let ((field (car fields))
-                    (syntax-table mh-regexp-in-field-syntax-table))
-                (if (null syntax-table)
-                    (let ((case-fold-search t))
-                      (cond
-                       ((string-match field "^To$\\|^[BD]?cc$\\|^From$")
-                        (setq syntax-table mh-addr-syntax-table))
-                       ((string-match field "^Fcc$")
-                        (setq syntax-table mh-fcc-syntax-table))
-                       (t
-                        (setq syntax-table (syntax-table)))
-                       )))
+              (let* ((field (car fields))
+                     (syntax-table
+                      (or mh-regexp-in-field-syntax-table
+                          (let ((case-fold-search t))
+                            (cond
+                             ((string-match field "^To$\\|^[BD]?cc$\\|^From$")
+                              mh-addr-syntax-table)
+                             ((string-match field "^Fcc$")
+                              mh-fcc-syntax-table)
+                             (t
+                              (syntax-table)))
+                            ))))
                 (if (and (mh-goto-header-field field)
                          (set-syntax-table syntax-table)
                          (re-search-forward
                 (if (and (mh-goto-header-field field)
                          (set-syntax-table syntax-table)
                          (re-search-forward