emacs: maildir import message-do-fcc

We will need our own local copy of message-do-fcc so this commit just
copies the code straight from message.el so that it is easier to see
our local changes coming in the next commit.
This commit is contained in:
Mark Walters 2016-09-03 23:59:40 +01:00 committed by David Bremner
parent 37859d1fcb
commit 967bbc0792
2 changed files with 69 additions and 2 deletions

View file

@ -120,6 +120,70 @@ by notmuch-mua-mail"
subdir
(concat (notmuch-database-path) "/" subdir))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Functions for saving a message either using notmuch insert or file
;; fcc. First functions common to the two cases.
(defun notmuch-maildir-message-do-fcc ()
"Process Fcc headers in the current buffer.
This is a direct copy from message-mode's message-do-fcc."
(let ((case-fold-search t)
(buf (current-buffer))
list file
(mml-externalize-attachments message-fcc-externalize-attachments))
(save-excursion
(save-restriction
(message-narrow-to-headers)
(setq file (message-fetch-field "fcc" t)))
(when file
(set-buffer (get-buffer-create " *message temp*"))
(erase-buffer)
(insert-buffer-substring buf)
(message-encode-message-body)
(save-restriction
(message-narrow-to-headers)
(while (setq file (message-fetch-field "fcc" t))
(push file list)
(message-remove-header "fcc" nil t))
(let ((mail-parse-charset message-default-charset)
(rfc2047-header-encoding-alist
(cons '("Newsgroups" . default)
rfc2047-header-encoding-alist)))
(mail-encode-encoded-word-buffer)))
(goto-char (point-min))
(when (re-search-forward
(concat "^" (regexp-quote mail-header-separator) "$")
nil t)
(replace-match "" t t ))
;; Process FCC operations.
(while list
(setq file (pop list))
(if (string-match "^[ \t]*|[ \t]*\\(.*\\)[ \t]*$" file)
;; Pipe the article to the program in question.
(call-process-region (point-min) (point-max) shell-file-name
nil nil nil shell-command-switch
(match-string 1 file))
;; Save the article.
(setq file (expand-file-name file))
(unless (file-exists-p (file-name-directory file))
(make-directory (file-name-directory file) t))
(if (and message-fcc-handler-function
(not (eq message-fcc-handler-function 'rmail-output)))
(funcall message-fcc-handler-function file)
;; FIXME this option, rmail-output (also used if
;; message-fcc-handler-function is nil) is not
;; documented anywhere AFAICS. It should work in Emacs
;; 23; I suspect it does not work in Emacs 22.
;; FIXME I don't see the need for the two different cases here.
;; mail-use-rfc822 makes no difference (in Emacs 23),and
;; the third argument just controls \"Wrote file\" message.
(if (and (file-readable-p file) (mail-file-babyl-p file))
(rmail-output file 1 nil t)
(let ((mail-use-rfc822 t))
(rmail-output file 1 t t))))))
(kill-buffer (current-buffer))))))
(defun notmuch-fcc-handler (fcc-header)
"Store message with file fcc."
(notmuch-maildir-fcc-file-fcc fcc-header))

View file

@ -33,6 +33,7 @@
(declare-function notmuch-show-insert-body "notmuch-show" (msg body depth))
(declare-function notmuch-fcc-header-setup "notmuch-maildir-fcc" ())
(declare-function notmuch-fcc-handler "notmuch-maildir-fcc" (destdir))
(declare-function notmuch-maildir-message-do-fcc "notmuch-maildir-fcc" ())
;;
@ -490,12 +491,14 @@ will be addressed to all recipients of the source message."
(defun notmuch-mua-send-and-exit (&optional arg)
(interactive "P")
(let ((message-fcc-handler-function #'notmuch-fcc-handler))
(message-send-and-exit arg)))
(letf (((symbol-function 'message-do-fcc) #'notmuch-maildir-message-do-fcc))
(message-send-and-exit arg))))
(defun notmuch-mua-send (&optional arg)
(interactive "P")
(let ((message-fcc-handler-function #'notmuch-fcc-handler))
(message-send arg)))
(letf (((symbol-function 'message-do-fcc) #'notmuch-maildir-message-do-fcc))
(message-send arg))))
(defun notmuch-mua-kill-buffer ()
(interactive)