X-Git-Url: https://git.notmuchmail.org/git?p=notmuch;a=blobdiff_plain;f=emacs%2Fnotmuch-maildir-fcc.el;h=ae56bacd50b549b395bf6c39460728b294fa6bf3;hp=c6bdd7697610551913dce7aead5ea066ca51d4bc;hb=HEAD;hpb=16b2db0986ce0ed7c420a69d0a98bb41e9ca4bd8 diff --git a/emacs/notmuch-maildir-fcc.el b/emacs/notmuch-maildir-fcc.el index c6bdd769..51020788 100644 --- a/emacs/notmuch-maildir-fcc.el +++ b/emacs/notmuch-maildir-fcc.el @@ -21,7 +21,7 @@ ;;; Code: -(eval-when-compile (require 'cl-lib)) +(require 'seq) (require 'message) @@ -41,16 +41,17 @@ Three types of values are permitted: - a string: the value of `notmuch-fcc-dirs' is the Fcc header to be used. -- a list: the folder is chosen based on the From address of the - current message using a list of regular expressions and - corresponding folders: +- an alist: the folder is chosen based on the From address of + the current message according to an alist mapping regular + expressions to folders or nil: ((\"Sebastian@SSpaeth.de\" . \"privat\") (\"spaetz@sspaeth.de\" . \"OUTBOX.OSS\") (\".*\" . \"defaultinbox\")) - If none of the regular expressions match the From address, no - Fcc header will be added. + If none of the regular expressions match the From address, or + if the cdr of the matching entry is nil, then no Fcc header + will be added. If `notmuch-maildir-use-notmuch-insert' is set (the default) then the header should be of the form \"folder +tag1 -tag2\" where @@ -74,7 +75,8 @@ directory if it does not exist yet when sending a mail." (const :tag "No FCC header" nil) (string :tag "A single folder") (repeat :tag "A folder based on the From header" - (cons regexp (string :tag "Folder")))) + (cons regexp (choice (const :tag "No FCC header" nil) + (string :tag "Folder"))))) :require 'notmuch-fcc-initialization :group 'notmuch-send) @@ -90,10 +92,8 @@ directory if it does not exist yet when sending a mail." (defun notmuch-fcc-header-setup () "Add an Fcc header to the current message buffer. -Sets the Fcc header based on the values of `notmuch-fcc-dirs'. - -Originally intended to be use a hook function, but now called directly -by notmuch-mua-mail." +If the Fcc header is already set, then keep it as-is. +Otherwise set it according to `notmuch-fcc-dirs'." (let ((subdir (cond ((or (not notmuch-fcc-dirs) @@ -107,13 +107,14 @@ by notmuch-mua-mail." ;; Old style - no longer works. (error "Invalid `notmuch-fcc-dirs' setting (old style)")) ((listp notmuch-fcc-dirs) - (or (seq-some (let ((from (message-field-value "From"))) - (pcase-lambda (`(,regexp . ,folder)) - (and (string-match-p regexp from) - folder))) - notmuch-fcc-dirs) - (progn (message "No Fcc header added.") - nil))) + (if-let ((match (seq-some (let ((from (message-field-value "From"))) + (pcase-lambda (`(,regexp . ,folder)) + (and (string-match-p regexp from) + (cons t folder)))) + notmuch-fcc-dirs))) + (cdr match) + (message "No Fcc header added.") + nil)) (t (error "Invalid `notmuch-fcc-dirs' setting (neither string nor list)"))))) (when subdir @@ -148,15 +149,20 @@ by notmuch-mua-mail." (buf (current-buffer)) (mml-externalize-attachments message-fcc-externalize-attachments)) (with-current-buffer (get-buffer-create " *message temp*") + (message-clone-locals buf) ;; for message-encoded-mail-cache (erase-buffer) (insert-buffer-substring buf) ,@body))) (defun notmuch-maildir-setup-message-for-saving () - "Setup message for saving. Should be called on a temporary copy. + "Setup message for saving. +This should be called on a temporary copy. This is taken from the function message-do-fcc." - (message-encode-message-body) + (if (not message-encoded-mail-cache) + (message-encode-message-body) + (erase-buffer) + (insert message-encoded-mail-cache)) (save-restriction (message-narrow-to-headers) (mail-encode-encoded-word-buffer)) @@ -177,12 +183,12 @@ This is a rearranged version of message mode's message-do-fcc." (setq file (message-fetch-field "fcc" t))) (when file (with-temporary-notmuch-message-buffer + (notmuch-maildir-setup-message-for-saving) (save-restriction (message-narrow-to-headers) (while (setq file (message-fetch-field "fcc" t)) (push file files) (message-remove-header "fcc" nil t))) - (notmuch-maildir-setup-message-for-saving) ;; Process FCC operations. (mapc #'notmuch-fcc-handler files) (kill-buffer (current-buffer))))))) @@ -208,11 +214,11 @@ This inserts the current buffer as a message into the notmuch database in folder FOLDER. If CREATE is non-nil it will supply the --create-folder flag to create the folder if necessary. TAGS should be a list of tag changes to apply to the inserted message." - (let* ((args (append (and create (list "--create-folder")) - (list (concat "--folder=" folder)) - tags))) - (apply 'notmuch-call-notmuch-process - :stdin-string (buffer-string) "insert" args))) + (apply 'notmuch-call-notmuch-process + :stdin-string (buffer-string) "insert" + (append (and create (list "--create-folder")) + (list (concat "--folder=" folder)) + tags))) (defun notmuch-maildir-fcc-with-notmuch-insert (fcc-header &optional create) "Store message with notmuch insert. @@ -308,8 +314,8 @@ if successful, nil if not." (defun notmuch-maildir-fcc-file-fcc (fcc-header) "Write the message to the file specified by FCC-HEADER. -It offers the user a chance to correct the header, or filesystem, -if needed." +If that fails, then offer the user a chance to correct the header +or filesystem." (if (notmuch-maildir-fcc-dir-is-maildir-p fcc-header) (notmuch-maildir-fcc-write-buffer-to-maildir fcc-header t) ;; The fcc-header is not a valid maildir see if the user wants to @@ -329,9 +335,11 @@ if needed." (read-from-minibuffer "Fcc header: " fcc-header))))))) (defun notmuch-maildir-fcc-write-buffer-to-maildir (destdir &optional mark-seen) - "Writes the current buffer to maildir destdir. If mark-seen is -non-nil, it will write it to cur/, and mark it as read. It should -return t if successful, and nil otherwise." + "Write the current buffer to maildir destdir. + +If mark-seen is non-nil, then write it to \"cur/\", and mark it +as read, otherwise write it to \"new/\". Return t if successful, +and nil otherwise." (let ((orig-buffer (buffer-name))) (with-temp-buffer (insert-buffer-substring orig-buffer)