mirror of https://github.com/djcb/mu.git
Merge branch 'wip/djcb/composer-rework'
This commit is contained in:
commit
14a882f912
|
@ -449,7 +449,8 @@ Server::Private::invoke(const std::string& expr) noexcept
|
|||
throw res.error();
|
||||
|
||||
} catch (const Mu::Error& me) {
|
||||
output_sexp(make_error(me.code(), mu_format("{}", me.what())));
|
||||
output_sexp(make_error(me.code(), mu_format("{}",
|
||||
me.what())));
|
||||
keep_going_ = true;
|
||||
} catch (const Xapian::Error& xerr) {
|
||||
output_sexp(make_error(Error::Code::Internal,
|
||||
|
@ -458,7 +459,17 @@ Server::Private::invoke(const std::string& expr) noexcept
|
|||
keep_going_ = false;
|
||||
} catch (const std::runtime_error& re) {
|
||||
output_sexp(make_error(Error::Code::Internal,
|
||||
mu_format("caught exception: {}", re.what())));
|
||||
mu_format("caught runtime exception: {}",
|
||||
re.what())));
|
||||
keep_going_ = false;
|
||||
} catch (const std::out_of_range& oore) {
|
||||
output_sexp(make_error(Error::Code::Internal,
|
||||
mu_format("caught out-of-range exception: {}",
|
||||
oore.what())));
|
||||
keep_going_ = false;
|
||||
} catch (const std::exception& e) {
|
||||
output_sexp(make_error(Error::Code::Internal,
|
||||
mu_format(" exception: {}", e.what())));
|
||||
keep_going_ = false;
|
||||
} catch (...) {
|
||||
output_sexp(make_error(Error::Code::Internal,
|
||||
|
@ -872,10 +883,14 @@ Server::Private::move_docid(Store::Id docid,
|
|||
}
|
||||
|
||||
/*
|
||||
* 'move' moves a message to a different maildir and/or changes its
|
||||
* flags. parameters are *either* a 'docid:' or 'msgid:' pointing to
|
||||
* the message, a 'maildir:' for the target maildir, and a 'flags:'
|
||||
* parameter for the new flags.
|
||||
* 'move' moves a message to a different maildir and/or changes its flags.
|
||||
* parameters are *either* a 'docid:' or 'msgid:' pointing to the message, a
|
||||
* 'maildir:' for the target maildir, and a 'flags:' parameter for the new
|
||||
* flags.
|
||||
*
|
||||
* With :msgid, this is "opportunistic": it's not an error when the given
|
||||
* message-id does not exist. This is e.g. for the case when tagging possible
|
||||
* related messages.
|
||||
*/
|
||||
void
|
||||
Server::Private::move_handler(const Command& cmd)
|
||||
|
@ -886,7 +901,19 @@ Server::Private::move_handler(const Command& cmd)
|
|||
const auto no_view{cmd.boolean_arg(":noupdate")};
|
||||
const auto docids{determine_docids(store_, cmd)};
|
||||
|
||||
if (docids.size() > 1) {
|
||||
if (docids.empty()) {
|
||||
if (!!cmd.string_arg(":msgid")) {
|
||||
// msgid not found: no problem.
|
||||
mu_debug("no move: '{}' not found",
|
||||
*cmd.string_arg(":msgid"));
|
||||
return;
|
||||
}
|
||||
// however, if we wanted to be move by msgid, it's worth raising
|
||||
// an error.
|
||||
throw Mu::Error{Error::Code::Store,
|
||||
"message not found in store (docid={})",
|
||||
cmd.number_arg(":docid").value_or(0)};
|
||||
} else if (docids.size() > 1) {
|
||||
if (!maildir.empty()) // ie. duplicate message-ids.
|
||||
throw Mu::Error{Error::Code::Store,
|
||||
"cannot move multiple messages at the same time"};
|
||||
|
@ -894,21 +921,22 @@ Server::Private::move_handler(const Command& cmd)
|
|||
for (auto&& docid : docids)
|
||||
move_docid(docid, flagopt, rename, no_view);
|
||||
return;
|
||||
} else {
|
||||
const auto docid{docids.at(0)};
|
||||
auto msg = store().find_message(docid)
|
||||
.or_else([&]{throw Error{Error::Code::InvalidArgument,
|
||||
"cannot find message {}", docid};}).value();
|
||||
|
||||
/* if maildir was not specified, take the current one */
|
||||
if (maildir.empty())
|
||||
maildir = msg.maildir();
|
||||
|
||||
/* determine the real target flags, which come from the flags-parameter
|
||||
* we received (ie., flagstr), if any, plus the existing message
|
||||
* flags. */
|
||||
const auto flags = calculate_message_flags(msg, flagopt);
|
||||
perform_move(docid, msg, maildir, flags, rename, no_view);
|
||||
}
|
||||
const auto docid{docids.at(0)};
|
||||
auto msg = store().find_message(docid)
|
||||
.or_else([&]{throw Error{Error::Code::InvalidArgument,
|
||||
"cannot find message {}", docid};}).value();
|
||||
|
||||
/* if maildir was not specified, take the current one */
|
||||
if (maildir.empty())
|
||||
maildir = msg.maildir();
|
||||
|
||||
/* determine the real target flags, which come from the flags-parameter
|
||||
* we received (ie., flagstr), if any, plus the existing message
|
||||
* flags. */
|
||||
const auto flags = calculate_message_flags(msg, flagopt);
|
||||
perform_move(docid, msg, maildir, flags, rename, no_view);
|
||||
}
|
||||
|
||||
void
|
||||
|
|
|
@ -43,6 +43,7 @@ mu4e_srcs=[
|
|||
'mu4e-contacts.el',
|
||||
'mu4e-context.el',
|
||||
'mu4e-contrib.el',
|
||||
'mu4e-draft.el',
|
||||
'mu4e-folders.el',
|
||||
'mu4e.el',
|
||||
'mu4e-headers.el',
|
||||
|
|
|
@ -22,10 +22,9 @@
|
|||
|
||||
;;; Commentary:
|
||||
|
||||
;; Implements mu4e-compose-mode, which is a `message-mode' derivative. This is a
|
||||
;; *fairly* thin wrapper around the gnus functions for message composition,
|
||||
;; integrated with mu4e. Still, quite a bit of code to make it work nicely in
|
||||
;; the mu4e context.
|
||||
;; Implements mu4e-compose-mode, which is a `message-mode' derivative. There's
|
||||
;; quite a bit of trickery involved to make the message-mode functions work in
|
||||
;; this context; see mu4e-draft for details.
|
||||
|
||||
|
||||
;;; Code:
|
||||
|
@ -40,124 +39,14 @@
|
|||
(require 'mu4e-context)
|
||||
(require 'mu4e-folders)
|
||||
|
||||
(require 'mu4e-draft)
|
||||
|
||||
|
||||
;;; User configuration for compose-mode
|
||||
(defgroup mu4e-compose nil
|
||||
"Customization for composing/sending messages."
|
||||
:group 'mu4e)
|
||||
|
||||
(defcustom mu4e-sent-messages-behavior 'sent
|
||||
"Determines what mu4e does with sent messages.
|
||||
|
||||
This is one of the symbols:
|
||||
* `sent' move the sent message to the Sent-folder (`mu4e-sent-folder')
|
||||
* `trash' move the sent message to the Trash-folder (`mu4e-trash-folder')
|
||||
* `delete' delete the sent message.
|
||||
|
||||
Note, when using GMail/IMAP, you should set this to either
|
||||
`trash' or `delete', since GMail already takes care of keeping
|
||||
copies in the sent folder.
|
||||
|
||||
Alternatively, `mu4e-sent-messages-behavior' can be a function
|
||||
which takes no arguments, and which should return one of the mentioned
|
||||
symbols, for example:
|
||||
|
||||
(setq mu4e-sent-messages-behavior (lambda ()
|
||||
(if (string= (message-sendmail-envelope-from) \"foo@example.com\")
|
||||
\\='delete \\='sent)))
|
||||
|
||||
The various `message-' functions from `message-mode' are available
|
||||
for querying the message information."
|
||||
:type '(choice (const :tag "move message to mu4e-sent-folder" sent)
|
||||
(const :tag "move message to mu4e-trash-folder" trash)
|
||||
(const :tag "delete message" delete))
|
||||
:group 'mu4e-compose)
|
||||
|
||||
(defcustom mu4e-compose-switch nil
|
||||
"Where to display the new message?
|
||||
A symbol:
|
||||
- nil : default (new buffer)
|
||||
- window : compose in new window
|
||||
- frame or t : compose in new frame
|
||||
- display-buffer: use `display-buffer' / `display-buffer-alist'
|
||||
(for fine-tuning).
|
||||
|
||||
For backward compatibility with `mu4e-compose-in-new-frame', t is
|
||||
treated as =\\'frame."
|
||||
:type 'symbol
|
||||
:group 'mu4e-compose)
|
||||
|
||||
(defcustom mu4e-compose-context-policy 'ask
|
||||
"Policy for determining the context when composing a new message.
|
||||
|
||||
If the value is `always-ask', ask the user unconditionally.
|
||||
|
||||
In all other cases, if any context matches (using its match
|
||||
function), this context is used. Otherwise, if none of the
|
||||
contexts match, we have the following choices:
|
||||
|
||||
- `pick-first': pick the first of the contexts available (ie. the default)
|
||||
- `ask': ask the user
|
||||
- `ask-if-none': ask if there is no context yet, otherwise leave it as it is
|
||||
- nil: return nil; leaves the current context as is.
|
||||
|
||||
Also see `mu4e-context-policy'."
|
||||
:type '(choice
|
||||
(const :tag "Always ask what context to use" always-ask)
|
||||
(const :tag "Ask if none of the contexts match" ask)
|
||||
(const :tag "Ask when there's no context yet" ask-if-none)
|
||||
(const :tag "Pick the first context if none match" pick-first)
|
||||
(const :tag "Don't change the context when none match" nil))
|
||||
:safe 'symbolp
|
||||
:group 'mu4e-compose)
|
||||
|
||||
(defcustom mu4e-compose-crypto-policy
|
||||
'(encrypt-encrypted-replies sign-encrypted-replies)
|
||||
"Policy to control when messages will be signed/encrypted.
|
||||
|
||||
The value is a list which influence the way draft messages are
|
||||
created. Specifically, it might contain:
|
||||
|
||||
- `sign-all-messages': Always add a signature.
|
||||
- `sign-new-messages': Add a signature to new message, ie.
|
||||
messages that aren't responses to another message.
|
||||
- `sign-forwarded-messages': Add a signature when forwarding
|
||||
a message
|
||||
- `sign-edited-messages': Add a signature to drafts
|
||||
- `sign-all-replies': Add a signature when responding to
|
||||
another message.
|
||||
- `sign-plain-replies': Add a signature when responding to
|
||||
non-encrypted messages.
|
||||
- `sign-encrypted-replies': Add a signature when responding
|
||||
to encrypted messages.
|
||||
|
||||
It should be noted that certain symbols have priorities over one
|
||||
another. So `sign-all-messages' implies `sign-all-replies', which
|
||||
in turn implies `sign-plain-replies'. Adding both to the set, is
|
||||
not a contradiction, but a redundant configuration.
|
||||
|
||||
All `sign-*' options have a `encrypt-*' analogue."
|
||||
:type '(set :greedy t
|
||||
(const :tag "Sign all messages" sign-all-messages)
|
||||
(const :tag "Encrypt all messages" encrypt-all-messages)
|
||||
(const :tag "Sign new messages" sign-new-messages)
|
||||
(const :tag "Encrypt new messages" encrypt-new-messages)
|
||||
(const :tag "Sign forwarded messages" sign-forwarded-messages)
|
||||
(const :tag "Encrypt forwarded messages"
|
||||
encrypt-forwarded-messages)
|
||||
(const :tag "Sign edited messages" sign-edited-messages)
|
||||
(const :tag "Encrypt edited messages" edited-forwarded-messages)
|
||||
(const :tag "Sign all replies" sign-all-replies)
|
||||
(const :tag "Encrypt all replies" encrypt-all-replies)
|
||||
(const :tag "Sign replies to plain messages" sign-plain-replies)
|
||||
(const :tag "Encrypt replies to plain messages"
|
||||
encrypt-plain-replies)
|
||||
(const :tag "Sign replies to encrypted messages"
|
||||
sign-encrypted-replies)
|
||||
(const :tag "Encrypt replies to encrypted messages"
|
||||
encrypt-encrypted-replies))
|
||||
:group 'mu4e-compose)
|
||||
|
||||
(defcustom mu4e-compose-format-flowed nil
|
||||
"Whether to compose messages to be sent as format=flowed.
|
||||
\(Or with long lines if variable `use-hard-newlines' is set to
|
||||
|
@ -183,16 +72,26 @@ the place to do that."
|
|||
:type 'hook
|
||||
:group 'mu4e-compose)
|
||||
|
||||
|
||||
;;; Runtime variables; useful for user-hooks etc.
|
||||
(defvar-local mu4e-compose-parent-message nil
|
||||
"The parent message plist.
|
||||
This is the message being replied to, forwarded or edited; used
|
||||
in `mu4e-compose-pre-hook'. For new (non-reply, forward etc.)
|
||||
messages, it is nil.")
|
||||
(defcustom mu4e-compose-post-hook
|
||||
(list
|
||||
;; kill compose frames
|
||||
#'mu4e-compose-post-kill-frame
|
||||
;; attempt to restore the old configuration.
|
||||
#'mu4e-compose-post-restore-window-configuration)
|
||||
"Hook run *after* message composition is over.
|
||||
|
||||
(defvar-local mu4e-compose-type nil
|
||||
"The compose-type for the current message.")
|
||||
This is hook is run when composition buffer,
|
||||
either by sending, postponing, exiting or killing it.
|
||||
|
||||
This multiplexes the `message-mode' hooks `message-send-actions',
|
||||
`message-postpone-actions', `message-exit-actions' and
|
||||
`message-kill-actions', and the hook is run with a variable
|
||||
`mu4e-compose-post-trigger' set correspondingly to a symbol,
|
||||
`send', `postpone', `exit' or `kill'."
|
||||
:type 'hook
|
||||
:group 'mu4e-compose)
|
||||
|
||||
|
||||
|
||||
(defvar mu4e-captured-message)
|
||||
(defun mu4e-compose-attach-captured-message ()
|
||||
|
@ -285,61 +184,6 @@ the file under our feet, which is a bit fragile."
|
|||
(when message-signature
|
||||
(save-excursion (message-insert-signature))))))))
|
||||
|
||||
|
||||
;;; Filenames
|
||||
(defun mu4e--message-basename()
|
||||
"Construct a randomized filename for a message with flags FLAGSTR.
|
||||
It looks something like
|
||||
<time>-<random>.<hostname>
|
||||
|
||||
This filename is used for the draft message and the sent message,
|
||||
depending on `mu4e-sent-messages-behavior'."
|
||||
(let* ((sysname (if (fboundp 'system-name)
|
||||
(system-name) (with-no-warnings system-name)))
|
||||
(sysname (if (string= sysname "") "localhost" sysname))
|
||||
(hostname (downcase
|
||||
(save-match-data
|
||||
(substring sysname
|
||||
(string-match "^[^.]+" sysname)
|
||||
(match-end 0))))))
|
||||
(format "%s.%04x%04x%04x%04x.%s"
|
||||
(format-time-string "%s" (current-time))
|
||||
(random 65535) (random 65535) (random 65535) (random 65535)
|
||||
hostname)))
|
||||
|
||||
(defun mu4e--draft-message-path (base-name &optional parent)
|
||||
"Construct a draft message path, based on PARENT if provided.
|
||||
|
||||
PARENT is either nil or the original message (being replied
|
||||
to/forwarded etc.), and is used to determine the draft folder.
|
||||
BASE-NAME is the base filename without any Maildir decoration."
|
||||
(let ((draft-dir (mu4e-get-drafts-folder parent)))
|
||||
(mu4e-join-paths
|
||||
(mu4e-root-maildir) draft-dir "cur"
|
||||
(format "%s%s2,DS" base-name mu4e-maildir-info-delimiter))))
|
||||
|
||||
(defun mu4e--fcc-path (base-name &optional parent)
|
||||
"Construct a Fcc: path, based on PARENT and `mu4e-sent-messages-behavior'.
|
||||
|
||||
PARENT is either nil or the original message (being replied
|
||||
to/forwarded etc.), and is used to determine the sent folder,
|
||||
together with `mu4e-sent-messages-behavior'. BASE-NAME is the
|
||||
base filename without any Maildir decoration.
|
||||
|
||||
Returns the path for the sent message, either in the sent or
|
||||
trash folder, or nil if the message should be removed after
|
||||
sending."
|
||||
(when-let ((sent-dir
|
||||
(pcase mu4e-sent-messages-behavior
|
||||
('delete nil)
|
||||
('trash (mu4e-get-trash-folder parent))
|
||||
('sent (mu4e-get-sent-folder parent))
|
||||
((pred functionp) (funcall mu4e-sent-messages-behavior))
|
||||
(_ (mu4e-error "Error in `mu4e-sent-messages-behavior'")))))
|
||||
(mu4e-join-paths
|
||||
(mu4e-root-maildir) sent-dir "cur"
|
||||
(format "%s%s2,S" base-name mu4e-maildir-info-delimiter))))
|
||||
|
||||
|
||||
;;; address completion
|
||||
|
||||
|
@ -360,10 +204,6 @@ sending."
|
|||
(display-sort-function . identity)
|
||||
(cycle-sort-function . identity)))))
|
||||
|
||||
(defconst mu4e--header-separator ;; XX properties down work... why not?
|
||||
(propertize "--text follows this line--" 'read-only t 'intangible t)
|
||||
"Line used to separate headers from text in messages being composed.")
|
||||
|
||||
(defun mu4e-complete-contact ()
|
||||
"Attempt to complete the text at point with a contact.
|
||||
I.e., either \"name <email>\" or \"email\". Return nil if not found.
|
||||
|
@ -402,206 +242,6 @@ completion functions still apply."
|
|||
(add-to-list (make-local-variable 'completion-styles) 'substring)
|
||||
(add-hook 'completion-at-point-functions
|
||||
#'mu4e--compose-complete-contact-field -10 t)))
|
||||
|
||||
(defun mu4e--fcc-handler (msgpath)
|
||||
"Handle Fcc: for MSGPATH.
|
||||
|
||||
This ensures that a copy of a sent messages ends up in the
|
||||
appropriate sent-messages folder.
|
||||
|
||||
If MSGPATH is nil, do nothing."
|
||||
(when msgpath
|
||||
(let* ((target-dir (file-name-directory msgpath))
|
||||
(target-mdir (file-name-directory target-dir)))
|
||||
;; create maildir if needed
|
||||
(unless (file-exists-p target-mdir)
|
||||
(make-directory
|
||||
(mu4e-join-paths target-mdir "cur" 'parents))
|
||||
(make-directory
|
||||
(mu4e-join-paths target-mdir "new" 'parents)))
|
||||
(write-file msgpath)
|
||||
(mu4e--server-add msgpath))))
|
||||
|
||||
;; save / send hooks
|
||||
|
||||
(defvar-local mu4e--compose-undo nil
|
||||
"Remember the undo-state.")
|
||||
|
||||
(defun mu4e--delimit-headers (&optional undelimit)
|
||||
"Delimit or undelimit (with UNDELIMIT) headers."
|
||||
(let ((mail-header-separator mu4e--header-separator)
|
||||
(inhibit-read-only t))
|
||||
(save-excursion
|
||||
(mail-sendmail-undelimit-header) ;; clear first
|
||||
(unless undelimit (mail-sendmail-delimit-header)))))
|
||||
|
||||
(defun mu4e--compose-before-save ()
|
||||
"Function called just before the draft buffer is saved."
|
||||
;; This does 3 things:
|
||||
;; - set the Message-Id if not already
|
||||
;; - set the Date if not already
|
||||
;; - (temporarily) remove the mail-header separator
|
||||
(setq mu4e--compose-undo buffer-undo-list)
|
||||
(save-excursion
|
||||
(unless (message-field-value "Message-ID")
|
||||
(message-generate-headers '(Message-ID)))
|
||||
;; older Emacsen (<= 28 perhaps?) won't update the Date
|
||||
;; if there already is one; so make sure it's gone.
|
||||
(message-remove-header "Date")
|
||||
(message-generate-headers '(Date Subject From))
|
||||
(mu4e--delimit-headers 'undelimit))) ;; remove separator
|
||||
|
||||
(defvar mu4e--compose-buffer-max-name-length 48)
|
||||
(defun mu4e--compose-set-friendly-buffer-name ()
|
||||
"Use some friendly name for this composition buffer."
|
||||
(let* ((subj (message-field-value "subject"))
|
||||
(subj (if (or (not subj) (string-match "^[:blank:]*$" subj))
|
||||
"No subject" subj)))
|
||||
(rename-buffer (generate-new-buffer-name
|
||||
(format "\"%s\""
|
||||
(truncate-string-to-width subj
|
||||
mu4e--compose-buffer-max-name-length
|
||||
0 nil t)))
|
||||
(buffer-name))))
|
||||
|
||||
(defun mu4e--set-parent-flags (path)
|
||||
"Set flags for replied-to and forwarded for the message at PATH.
|
||||
That is, set the `replied' \"R\" flag on messages we replied to,
|
||||
and the `passed' \"F\" flag on message we have forwarded.
|
||||
|
||||
If a message has an \"In-Reply-To\" header, it is considered a
|
||||
reply to the message with the corresponding message id.
|
||||
Otherwise, if it does not have an \"In-Reply-To\" header, but
|
||||
does have a \"References:\" header, it is considered to be a
|
||||
forward message for the message corresponding with the /last/
|
||||
message-id in the references header.
|
||||
|
||||
If the message has been determined to be either a forwarded
|
||||
message or a reply, we instruct the server to update that message
|
||||
with resp. the \"P\" (passed) flag for a forwarded message, or
|
||||
the \"R\" flag for a replied message. The original messages are
|
||||
also marked as Seen.
|
||||
|
||||
Function assumes that it is executed in the context of the
|
||||
message buffer."
|
||||
(let ((buf (find-file-noselect path)))
|
||||
(when buf
|
||||
(with-current-buffer buf
|
||||
(let ((in-reply-to (message-field-value "in-reply-to"))
|
||||
(forwarded-from)
|
||||
(references (message-field-value "references")))
|
||||
(unless in-reply-to
|
||||
(when references
|
||||
(with-temp-buffer ;; inspired by `message-shorten-references'.
|
||||
(insert references)
|
||||
(goto-char (point-min))
|
||||
(let ((refs))
|
||||
(while (re-search-forward "<[^ <]+@[^ <]+>" nil t)
|
||||
(push (match-string 0) refs))
|
||||
;; the last will be the first
|
||||
(setq forwarded-from (car refs))))))
|
||||
;; remove the <> and update the flags on the server-side.
|
||||
(when (and in-reply-to (string-match "<\\(.*\\)>" in-reply-to))
|
||||
(mu4e--server-move (match-string 1 in-reply-to) nil "+R-N"))
|
||||
(when (and forwarded-from (string-match "<\\(.*\\)>" forwarded-from))
|
||||
(mu4e--server-move (match-string 1 forwarded-from) nil "+P-N")))))))
|
||||
|
||||
(defun mu4e--compose-after-save()
|
||||
"Function called immediately after the draft buffer is saved."
|
||||
;; This does 3 things:
|
||||
;; - restore the mail-header-separator (see mu4e--compose-before-save)
|
||||
;; - update the buffer name (based on the message subject
|
||||
;; - tell the mu server about the updated draft message
|
||||
(mu4e--delimit-headers)
|
||||
(mu4e--compose-set-friendly-buffer-name)
|
||||
;; tell the server
|
||||
(mu4e--server-add (buffer-file-name))
|
||||
;; restore history.
|
||||
(set-buffer-modified-p nil)
|
||||
(setq buffer-undo-list mu4e--compose-undo))
|
||||
|
||||
(defun mu4e-sent-handler (docid path)
|
||||
"Handler called with DOCID and PATH for the just-sent message.
|
||||
For Forwarded ('Passed') and Replied messages, try to set the
|
||||
appropriate flag at the message forwarded or replied-to."
|
||||
;; XXX we don't need this function anymore here, but
|
||||
;; we have an external caller in mu4e-icalendar... we should
|
||||
;; update that.
|
||||
(mu4e--set-parent-flags path)
|
||||
;; if the draft file exists, remove it now.
|
||||
(when (file-exists-p path)
|
||||
(mu4e--server-remove docid)))
|
||||
|
||||
(defun mu4e--send-harden-newlines ()
|
||||
"Set the hard property to all newlines."
|
||||
(save-excursion
|
||||
(goto-char (point-min))
|
||||
(while (search-forward "\n" nil t)
|
||||
(put-text-property (1- (point)) (point) 'hard t))))
|
||||
|
||||
(defun mu4e--compose-before-send ()
|
||||
"Function called just before sending a message."
|
||||
;; Remove References: if In-Reply-To: is missing.
|
||||
;; This allows the user to effectively start a new message-thread by
|
||||
;; removing the In-Reply-To header.
|
||||
(when (eq mu4e-compose-type 'reply)
|
||||
(unless (message-field-value "In-Reply-To")
|
||||
(message-remove-header "References")))
|
||||
(when use-hard-newlines
|
||||
(mu4e--send-harden-newlines))
|
||||
;; now handle what happens _after_ sending; typically, draft is gone and
|
||||
;; the sent message appears in sent. Update flags for related messages,
|
||||
;; i.e. for Forwarded ('Passed') and Replied messages, try to set the
|
||||
;; appropriate flag at the message forwarded or replied-to.
|
||||
(add-hook 'message-sent-hook
|
||||
(lambda ()
|
||||
(when-let ((fcc-path (message-field-value "Fcc")))
|
||||
(mu4e--set-parent-flags fcc-path)
|
||||
;; we end up with a ((buried) buffer here, visiting
|
||||
;; the fcc-path; not quite sure why. But let's
|
||||
;; get rid of it (#2681)
|
||||
(when-let ((buf (find-buffer-visiting fcc-path)))
|
||||
(kill-buffer buf))))
|
||||
nil t))
|
||||
|
||||
;;; Crypto
|
||||
(defun mu4e--compose-setup-crypto (parent compose-type)
|
||||
"Possibly encrypt or sign a message based on PARENT and COMPOSE-TYPE.
|
||||
See `mu4e-compose-crypto-policy' for more details."
|
||||
(let* ((encrypted-p
|
||||
(and parent (memq 'encrypted (mu4e-message-field parent :flags))))
|
||||
(encrypt
|
||||
(or (memq 'encrypt-all-messages mu4e-compose-crypto-policy)
|
||||
(and (memq 'encrypt-new-messages mu4e-compose-crypto-policy)
|
||||
(eq compose-type 'new)) ;; new messages
|
||||
(and (eq compose-type 'forward) ;; forwarded
|
||||
(memq 'encrypt-forwarded-messages mu4e-compose-crypto-policy))
|
||||
(and (eq compose-type 'edit) ;; edit
|
||||
(memq 'encrypt-edited-messages mu4e-compose-crypto-policy))
|
||||
(and (eq compose-type 'reply) ;; all replies
|
||||
(memq 'encrypt-all-replies mu4e-compose-crypto-policy))
|
||||
(and (eq compose-type 'reply) (not encrypted-p) ;; plain replies
|
||||
(memq 'encrypt-plain-replies mu4e-compose-crypto-policy))
|
||||
(and (eq compose-type 'reply) encrypted-p
|
||||
(memq 'encrypt-encrypted-replies
|
||||
mu4e-compose-crypto-policy)))) ;; encrypted replies
|
||||
(sign
|
||||
(or (memq 'sign-all-messages mu4e-compose-crypto-policy)
|
||||
(and (eq compose-type 'new) ;; new messages
|
||||
(memq 'sign-new-messages mu4e-compose-crypto-policy))
|
||||
(and (eq compose-type 'forward) ;; forwarded messages
|
||||
(memq 'sign-forwarded-messages mu4e-compose-crypto-policy))
|
||||
(and (eq compose-type 'edit) ;; edited messages
|
||||
(memq 'sign-edited-messages mu4e-compose-crypto-policy))
|
||||
(and (eq compose-type 'reply) ;; all replies
|
||||
(memq 'sign-all-replies mu4e-compose-crypto-policy))
|
||||
(and (eq compose-type 'reply) (not encrypted-p) ;; plain replies
|
||||
(memq 'sign-plain-replies mu4e-compose-crypto-policy))
|
||||
(and (eq compose-type 'reply) encrypted-p ;; encrypted replies
|
||||
(memq 'sign-encrypted-replies mu4e-compose-crypto-policy)))))
|
||||
(cond ((and sign encrypt) (mml-secure-message-sign-encrypt))
|
||||
(sign (mml-secure-message-sign))
|
||||
(encrypt (mml-secure-message-encrypt)))))
|
||||
|
||||
;;; mu4e-compose-mode
|
||||
(defun mu4e--compose-remap-faces ()
|
||||
|
@ -688,37 +328,6 @@ buffers; lets remap its faces so it uses the ones for mu4e."
|
|||
(message-cite-original-without-signature)
|
||||
(delete-region (point-min) (point-max))))
|
||||
|
||||
(defun mu4e--decoded-message (msg &optional headers-only)
|
||||
"Get the message MSG, decoded as a string.
|
||||
With HEADERS-ONLY non-nil, only include the headers part."
|
||||
(with-temp-buffer
|
||||
(setq-local gnus-article-decode-hook
|
||||
'(article-decode-charset
|
||||
article-decode-encoded-words
|
||||
article-decode-idna-rhs
|
||||
article-treat-non-ascii
|
||||
article-remove-cr
|
||||
article-de-base64-unreadable
|
||||
article-de-quoted-unreadable)
|
||||
gnus-inhibit-mime-unbuttonizing nil
|
||||
gnus-unbuttonized-mime-types '(".*/.*")
|
||||
gnus-original-article-buffer (current-buffer))
|
||||
(insert-file-contents-literally
|
||||
(mu4e-message-readable-path msg) nil nil nil t)
|
||||
;; remove the body / attachments and what not.
|
||||
(when headers-only
|
||||
(rfc822-goto-eoh)
|
||||
(delete-region (point) (point-max)))
|
||||
;; in rare (broken) case, if a message-id is missing use the generated one
|
||||
;; from mu.
|
||||
(mu4e--delimit-headers)
|
||||
(unless (message-field-value "Message-Id")
|
||||
(goto-char (point-min))
|
||||
(insert (format "Message-Id: <%s>\n" (plist-get msg :message-id))))
|
||||
(mu4e--delimit-headers 'undelimit)
|
||||
(ignore-errors (run-hooks 'gnus-article-decode-hook))
|
||||
(buffer-substring-no-properties (point-min) (point-max))))
|
||||
|
||||
(defun mu4e--compose-cite (msg)
|
||||
"Return a cited version of the ORIG message MSG (a string).
|
||||
This function uses `message-cite-function', and its settings apply."
|
||||
|
@ -732,291 +341,124 @@ This function uses `message-cite-function', and its settings apply."
|
|||
(pop-mark)
|
||||
(goto-char (point-min))
|
||||
(buffer-string)))
|
||||
|
||||
(defvar mu4e-user-agent-string
|
||||
(format "mu4e %s; emacs %s" mu4e-mu-version emacs-version)
|
||||
"The User-Agent string for mu4e, or nil.")
|
||||
|
||||
(defun mu4e--compose-switch-function ()
|
||||
"Function to switch & display composition buffer.
|
||||
Based on the value of `mu4e-compose-switch'."
|
||||
(pcase mu4e-compose-switch
|
||||
('nil #'switch-to-buffer)
|
||||
('window #'switch-to-buffer-other-window)
|
||||
((or 'frame 't) #'switch-to-buffer-other-frame)
|
||||
('display-buffer #'display-buffer)
|
||||
;; t for backward compatibility with mu4e-compose-in-new-frame
|
||||
(_ (mu4e-error "Invalid mu4e-compose-switch"))))
|
||||
|
||||
(defun mu4e--fake-pop-to-buffer (name &optional _switch)
|
||||
"A fake `message-pop-to-buffer' for creating buffer NAME.
|
||||
This is a little glue to use `message-reply', `message-forward'
|
||||
etc. We cannot use the normal `message-pop-to-buffer' since we're
|
||||
not ready yet to show the buffer in mu4e."
|
||||
;; note: we're in a _different_ buffer here, so we need to copy
|
||||
;; message-reply-header's buffer-local value.
|
||||
(let ((reply-headers message-reply-headers))
|
||||
(set-buffer (get-buffer-create name))
|
||||
(setq-local message-reply-headers reply-headers)
|
||||
(erase-buffer)
|
||||
(current-buffer)))
|
||||
|
||||
(defun mu4e--headers (compose-type)
|
||||
"Determine headers needed for message based on COMPOSE-TYPE."
|
||||
(seq-filter #'identity ;; ensure needed headers are generated.
|
||||
`(From Subject Date Message-ID
|
||||
,(when (memq compose-type '(reply forward)) 'References)
|
||||
,(when (eq compose-type 'reply) 'In-Reply-To)
|
||||
,(when message-newsreader 'User-Agent)
|
||||
,(when message-user-organization 'Organization))))
|
||||
|
||||
(defun mu4e--compose-setup-buffer (compose-type compose-func parent)
|
||||
"Set up a buffer for message composition before `mu4e-compose-mode'.
|
||||
|
||||
COMPOSE-TYPE is the type of message to creat.
|
||||
|
||||
COMPOSE-FUNC is a function / lambda to create the specific type
|
||||
of message; it should return (but not show) the created buffer.
|
||||
|
||||
PARENT is the \"parent\" message; nil
|
||||
for a \\='new message, set for all others (the message replied to /
|
||||
forwarded / ...)."
|
||||
(with-temp-buffer
|
||||
;; call the call message function; turn off the gnus crypto stuff;
|
||||
;; we handle that ourselves below
|
||||
(let* ((message-this-is-mail t)
|
||||
(message-generate-headers-first nil)
|
||||
(message-newsreader mu4e-user-agent-string)
|
||||
(message-mail-user-agent nil))
|
||||
;; we handle it ourselves.
|
||||
(setq-local gnus-message-replysign nil
|
||||
gnus-message-replyencrypt nil
|
||||
gnus-message-replysignencrypted nil)
|
||||
(goto-char (point-min))
|
||||
;; annoyingly, various message- functions call `message-pop-to-buffer`
|
||||
;; (showing the message. But we're not ready for that yet. So
|
||||
;; temporarily override that.
|
||||
(cl-letf (((symbol-function #'message-pop-to-buffer)
|
||||
#'mu4e--fake-pop-to-buffer))
|
||||
(funcall compose-func parent))
|
||||
;; add some more headers, if needed.
|
||||
(message-generate-headers (mu4e--headers compose-type))
|
||||
(current-buffer)))) ;; returns new buffer (this is not the tmp buf)
|
||||
|
||||
|
||||
(defvar mu4e-compose-hidden-headers
|
||||
(append message-hidden-headers '("^User-agent:" "^Fcc:"))
|
||||
"Message headers to hide when composing.
|
||||
This is mu4e's version of `message-hidden-headers'.")
|
||||
|
||||
(defun mu4e--message-is-yours-p (func &rest args)
|
||||
"Mu4e advice for `message-is-yours'.
|
||||
FUNC is the original function, and ARGS are its arguments.
|
||||
Is this address yours?"
|
||||
(if (mu4e-running-p)
|
||||
(let ((sender (message-field-value "from"))
|
||||
(from (message-field-value "sender")))
|
||||
(or (and sender (mu4e-personal-or-alternative-address-p
|
||||
(car (mail-header-parse-address sender))))
|
||||
(and from (mu4e-personal-or-alternative-address-p
|
||||
(car (mail-header-parse-address from))))))
|
||||
(apply func args)))
|
||||
|
||||
(defun mu4e--compose-setup-post (compose-type &optional parent)
|
||||
"Prepare the new message buffer.
|
||||
|
||||
COMPOSE-TYPE determines the type of message to create. PARENT
|
||||
refers to the optional message to start from, i.e., the message
|
||||
replied to or forwarded, etc."
|
||||
(mu4e-compose-mode)
|
||||
;; remember some variables, e.g for user hooks.
|
||||
(setq-local
|
||||
mu4e-compose-parent-message parent
|
||||
mu4e-compose-type compose-type)
|
||||
|
||||
(mu4e--compose-setup-crypto parent compose-type)
|
||||
;; set the attachment dir to something more reasonable than the draft
|
||||
;; directory.
|
||||
(setq default-directory (mu4e-determine-attachment-dir))
|
||||
|
||||
(add-hook 'before-save-hook #'mu4e--compose-before-save nil t)
|
||||
(add-hook 'after-save-hook #'mu4e--compose-after-save nil t)
|
||||
(add-hook 'message-send-hook #'mu4e--compose-before-send nil t)
|
||||
|
||||
(when-let ((fcc-path (mu4e--fcc-path (mu4e--message-basename) parent)))
|
||||
(message-add-header (concat "Fcc: " fcc-path "\n")))
|
||||
(setq-local message-fcc-handler-function #'mu4e--fcc-handler)
|
||||
|
||||
(mu4e--compose-set-friendly-buffer-name)
|
||||
(let ((message-hidden-headers mu4e-compose-hidden-headers))
|
||||
(message-hide-headers))
|
||||
|
||||
;; jump to some reasonable place.
|
||||
(if (not (message-field-value "To"))
|
||||
(message-goto-to)
|
||||
(if (not (message-field-value "Subject"))
|
||||
(message-goto-subject)
|
||||
(pcase message-cite-reply-position
|
||||
((or 'above 'traditional) (message-goto-body))
|
||||
(_ (when (message-goto-signature) (forward-line -2))))))
|
||||
;; buffer is not user-modified yet
|
||||
(set-buffer-modified-p nil)
|
||||
(undo-boundary))
|
||||
|
||||
(defun mu4e--compose-setup (compose-type compose-func &optional switch)
|
||||
"Set up a new buffer for mu4e message composition.
|
||||
|
||||
COMPOSE-TYPE is a symbol for message-kind; one of \\='(new reply forward edit)
|
||||
PARENT is the \"parent\" message; nil for a \\='new message, set for
|
||||
all others (the message replied to / forwarded / ...).
|
||||
|
||||
COMPOSE-FUNC is a function / lambda to create the specific type
|
||||
of message.
|
||||
|
||||
Optionally, SWITCH determines how to find a buffer for the message
|
||||
\(see SWITCH-FUNCTION in `compose-mail').
|
||||
|
||||
Returns the new buffer."
|
||||
(cl-assert (member compose-type '(reply forward edit new)))
|
||||
(unless (mu4e-running-p) (mu4e 'background)) ;; start if needed
|
||||
(let* ((parent
|
||||
(when (member compose-type '(reply forward edit))
|
||||
(mu4e-message-at-point)))
|
||||
(mu4e-compose-parent-message parent)
|
||||
(mu4e-compose-type compose-type)
|
||||
(oldframe (selected-frame)))
|
||||
(advice-add 'message-is-yours-p :around #'mu4e--message-is-yours-p)
|
||||
(run-hooks 'mu4e-compose-pre-hook) ;; run the pre-hook. Still useful?
|
||||
(mu4e--context-autoswitch parent mu4e-compose-context-policy)
|
||||
(with-current-buffer
|
||||
(mu4e--compose-setup-buffer compose-type compose-func parent)
|
||||
(unless (eq compose-type 'edit)
|
||||
(set-visited-file-name ;; make it a draft file
|
||||
(mu4e--draft-message-path (mu4e--message-basename) parent)))
|
||||
(mu4e--compose-setup-post compose-type parent)
|
||||
(funcall (or switch (mu4e--compose-switch-function)) (current-buffer))
|
||||
(let* ((msgframe (selected-frame))
|
||||
(actions (list
|
||||
(lambda () ;; kill frame when it was created for this
|
||||
(unless (eq oldframe msgframe)
|
||||
(delete-frame msgframe))))))
|
||||
;; handle closing of frames.
|
||||
(setq-local ;;message-kill-actions actions
|
||||
message-return-actions actions
|
||||
message-send-actions actions
|
||||
message-kill-actions actions))
|
||||
(current-buffer))))
|
||||
|
||||
|
||||
;;;###autoload
|
||||
(defun mu4e-compose-new (&optional to subject other-headers continue
|
||||
switch-function yank-action send-actions
|
||||
return-action &rest _)
|
||||
"Mu4e's implementation of `compose-mail'.
|
||||
TO, SUBJECT, OTHER-HEADERS, CONTINUE, SWITCH-FUNCTION,
|
||||
YANK-ACTION SEND-ACTIONS RETURN-ACTION are as described in
|
||||
`compose-mail', and to the extend that they do not conflict with
|
||||
mu4e inner workings."
|
||||
(interactive)
|
||||
(mu4e--compose-setup
|
||||
'new (lambda (_parent)
|
||||
(message-mail to subject other-headers continue nil
|
||||
yank-action send-actions return-action))
|
||||
switch-function))
|
||||
|
||||
;;;###autoload
|
||||
(defalias 'mu4e-compose-mail #'mu4e-compose-new)
|
||||
|
||||
;;;###autoload
|
||||
(defun mu4e-compose-reply (&optional wide)
|
||||
"Reply to the message at point.
|
||||
If WIDE is non-nil, make it a \"wide\" reply (a.k.a.
|
||||
\"reply-to-all\")."
|
||||
(defun mu4e-compose-new (&optional to subject other-headers continue
|
||||
_switch-function yank-action send-actions
|
||||
return-action &rest _)
|
||||
"Mu4e's implementation of `compose-mail'.
|
||||
TO, SUBJECT, OTHER-HEADERS, CONTINUE, YANK-ACTION SEND-ACTIONS
|
||||
RETURN-ACTION are as described in `compose-mail', and to the
|
||||
extend that they do not conflict with mu4e's inner workings.
|
||||
SWITCH-FUNCTION is ignored."
|
||||
(interactive)
|
||||
(mu4e--compose-setup
|
||||
'reply
|
||||
(lambda (parent)
|
||||
(insert (mu4e--decoded-message parent 'headers-only))
|
||||
(message-reply nil wide)
|
||||
(message-goto-body)
|
||||
(insert (mu4e--compose-cite parent)))))
|
||||
(mu4e--draft
|
||||
'new
|
||||
(lambda () (mu4e--message-call
|
||||
#'message-mail to subject other-headers continue
|
||||
nil ;; switch-function -> we handle it ourselves.
|
||||
yank-action send-actions return-action))))
|
||||
|
||||
;;;###autoload
|
||||
(defun mu4e-compose-reply-to (&optional to wide)
|
||||
"Reply to the message at point.
|
||||
Optional TO can be the To: address for the message. If WIDE is
|
||||
non-nil, make it a \"wide\" reply (a.k.a. \"reply-to-all\")."
|
||||
(interactive)
|
||||
(let ((parent (mu4e-message-at-point)))
|
||||
(mu4e--draft-with-parent
|
||||
'reply parent
|
||||
(lambda ()
|
||||
(with-current-buffer (mu4e--message-call #'message-reply to wide)
|
||||
(message-goto-body)
|
||||
(insert (mu4e--compose-cite parent))
|
||||
(current-buffer))))))
|
||||
|
||||
;;;###autoload
|
||||
(defun mu4e-compose-reply (&optional wide)
|
||||
"Reply to the message at point. If WIDE is
|
||||
non-nil, make it a \"wide\" reply (a.k.a. \"reply-to-all\")."
|
||||
(interactive)
|
||||
(mu4e-compose-reply-to nil wide))
|
||||
|
||||
;;;###autoload
|
||||
(defun mu4e-compose-wide-reply ()
|
||||
"Wide-reply to the message at point.
|
||||
A.k.a., \"reply-to-all\"."
|
||||
(interactive) (mu4e-compose-reply 'wide))
|
||||
"Wide reply to the message at point.
|
||||
(a.k.a. \"reply-to-all\")."
|
||||
(interactive)
|
||||
(mu4e-compose-reply-to nil t))1
|
||||
|
||||
;;;###autoload
|
||||
(defun mu4e-compose-supersede ()
|
||||
"Supersede message at point.
|
||||
"Supersede the message at point.
|
||||
|
||||
That is, send the message again, with all the same recipients;
|
||||
this can be useful to follow-up on a sent message. The message
|
||||
must be from current user, as determined through
|
||||
must originate from the current user, as determined through
|
||||
`mu4e-personal-or-alternative-address-p'."
|
||||
(interactive)
|
||||
(mu4e--compose-setup
|
||||
'reply ;; it's a special kind of reply.
|
||||
(lambda (parent)
|
||||
(insert (mu4e--decoded-message parent))
|
||||
(set-buffer-modified-p nil)
|
||||
(message-supersede))))
|
||||
(let ((parent (mu4e-message-at-point)))
|
||||
(mu4e--draft-with-parent
|
||||
'reply ;; it's a special kind of reply.
|
||||
parent
|
||||
(lambda ()
|
||||
(with-current-buffer (mu4e--message-call #'message-supersede))))))
|
||||
|
||||
;;;###autoload
|
||||
(defun mu4e-compose-forward ()
|
||||
"Forward the message at point."
|
||||
"Forward the message at point.
|
||||
To influence the way a message is forwarded, you can use the
|
||||
variables ‘message-forward-as-mime’ and
|
||||
‘message-forward-show-mml’."
|
||||
(interactive)
|
||||
(mu4e--compose-setup
|
||||
'forward
|
||||
(lambda (parent)
|
||||
(let ((message-make-forward-subject-function
|
||||
#'message-forward-subject-fwd))
|
||||
(insert (mu4e--decoded-message parent))
|
||||
(mu4e--delimit-headers)
|
||||
;; message-forward expects message-reply-headers to be set up; here we
|
||||
;; only need message-id & references, rest is for completeness.
|
||||
(setq-local message-reply-headers
|
||||
(make-full-mail-header
|
||||
0
|
||||
(or (message-field-value "subject") "none")
|
||||
(or (message-field-value "from") "nobody")
|
||||
(message-field-value "date")
|
||||
(message-field-value "message-id" t)
|
||||
(message-field-value "references")
|
||||
0 0 ""))
|
||||
(mu4e--delimit-headers 'undelimit)
|
||||
(set-buffer-modified-p nil)
|
||||
(message-forward)))))
|
||||
(let ((parent (mu4e-message-at-point)))
|
||||
(mu4e--draft-with-parent
|
||||
'forward parent
|
||||
(lambda ()
|
||||
(setq
|
||||
message-reply-headers (make-full-mail-header
|
||||
0
|
||||
(or (message-field-value "Subject") "none")
|
||||
(or (message-field-value "From") "nobody")
|
||||
(message-field-value "Date")
|
||||
(message-field-value "Message-Id" t)
|
||||
(message-field-value "References")
|
||||
0 0 ""))
|
||||
(with-current-buffer (mu4e--message-call #'message-forward)
|
||||
(current-buffer))))))
|
||||
|
||||
;;;###autoload
|
||||
(defun mu4e-compose-edit()
|
||||
"Edit an existing draft message."
|
||||
(interactive)
|
||||
(let* ((msg (mu4e-message-at-point)))
|
||||
(unless (member 'draft (mu4e-message-field msg :flags))
|
||||
(mu4e-warn "Cannot edit non-draft messages"))
|
||||
(mu4e--compose-setup
|
||||
'edit
|
||||
(lambda (parent)
|
||||
(let ((buf (find-file-noselect (plist-get parent :path))))
|
||||
(with-current-buffer buf
|
||||
(mu4e--delimit-headers))
|
||||
(switch-to-buffer buf))))))
|
||||
"Edit an existing draft message."
|
||||
(interactive)
|
||||
(let* ((msg (mu4e-message-at-point)))
|
||||
(unless (member 'draft (mu4e-message-field msg :flags))
|
||||
(mu4e-warn "Cannot edit non-draft messages"))
|
||||
(mu4e--draft
|
||||
'edit
|
||||
(lambda ()
|
||||
(with-current-buffer
|
||||
(find-file-noselect (mu4e-message-readable-path msg))
|
||||
(mu4e--delimit-headers)
|
||||
(current-buffer))))))
|
||||
|
||||
;;;###autoload
|
||||
(defun mu4e-compose-resend (address)
|
||||
"Re-send the message at point to ADDRESS.
|
||||
The message is resent as-is, without any editing."
|
||||
The message is resent as-is, without any editing. See
|
||||
`message-resend' for details."
|
||||
(interactive
|
||||
(list (completing-read
|
||||
"Resend message to address: " mu4e--contacts-set)))
|
||||
(unless (mu4e-running-p) (mu4e 'background))
|
||||
(let ((path (plist-get (mu4e-message-at-point) :path)))
|
||||
(let ((msg (mu4e-message-at-point)))
|
||||
(with-temp-buffer
|
||||
(insert-file-contents path)
|
||||
(mu4e--prepare-draft msg)
|
||||
(insert-file-contents (mu4e-message-readable-path msg))
|
||||
(message-resend address))))
|
||||
|
||||
|
||||
;;; Compose Mail
|
||||
|
||||
(declare-function mu4e "mu4e")
|
||||
|
|
|
@ -0,0 +1,736 @@
|
|||
;;; mu4e-draft.el --- Helpers for m4e-compose -*- lexical-binding: t -*-
|
||||
|
||||
;; Copyright (C) 2024 Dirk-Jan C. Binnema
|
||||
|
||||
;; Author: Dirk-Jan C. Binnema <djcb@djcbsoftware.nl>
|
||||
;; Maintainer: Dirk-Jan C. Binnema <djcb@djcbsoftware.nl>
|
||||
|
||||
;; This file is not part of GNU Emacs.
|
||||
|
||||
;; mu4e is free software: you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; mu4e is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with mu4e. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; Implements various helper functions for mu4e-compose. This all
|
||||
;; look a little convoluted since we need to subvert the gnus/message
|
||||
;; functions a bit to work with mu4e.
|
||||
|
||||
(require 'message)
|
||||
(require 'mu4e-config)
|
||||
(require 'mu4e-helpers)
|
||||
(require 'mu4e-contacts)
|
||||
(require 'mu4e-folders)
|
||||
(require 'mu4e-message)
|
||||
(require 'mu4e-context)
|
||||
(require 'mu4e-window)
|
||||
|
||||
;;; Code:
|
||||
|
||||
(declare-function mu4e-compose-mode "mu4e-compose")
|
||||
(declare-function mu4e "mu4e")
|
||||
|
||||
(defcustom mu4e-compose-crypto-policy
|
||||
'(encrypt-encrypted-replies sign-encrypted-replies)
|
||||
"Policy to control when messages will be signed/encrypted.
|
||||
|
||||
The value is a list which influence the way draft messages are
|
||||
created. Specifically, it might contain:
|
||||
|
||||
- `sign-all-messages': Always add a signature.
|
||||
- `sign-new-messages': Add a signature to new message, ie.
|
||||
messages that aren't responses to another message.
|
||||
- `sign-forwarded-messages': Add a signature when forwarding
|
||||
a message
|
||||
- `sign-edited-messages': Add a signature to drafts
|
||||
- `sign-all-replies': Add a signature when responding to
|
||||
another message.
|
||||
- `sign-plain-replies': Add a signature when responding to
|
||||
non-encrypted messages.
|
||||
- `sign-encrypted-replies': Add a signature when responding
|
||||
to encrypted messages.
|
||||
|
||||
It should be noted that certain symbols have priorities over one
|
||||
another. So `sign-all-messages' implies `sign-all-replies', which
|
||||
in turn implies `sign-plain-replies'. Adding both to the set, is
|
||||
not a contradiction, but a redundant configuration.
|
||||
|
||||
All `sign-*' options have a `encrypt-*' analogue."
|
||||
:type '(set :greedy t
|
||||
(const :tag "Sign all messages" sign-all-messages)
|
||||
(const :tag "Encrypt all messages" encrypt-all-messages)
|
||||
(const :tag "Sign new messages" sign-new-messages)
|
||||
(const :tag "Encrypt new messages" encrypt-new-messages)
|
||||
(const :tag "Sign forwarded messages" sign-forwarded-messages)
|
||||
(const :tag "Encrypt forwarded messages"
|
||||
encrypt-forwarded-messages)
|
||||
(const :tag "Sign edited messages" sign-edited-messages)
|
||||
(const :tag "Encrypt edited messages" edited-forwarded-messages)
|
||||
(const :tag "Sign all replies" sign-all-replies)
|
||||
(const :tag "Encrypt all replies" encrypt-all-replies)
|
||||
(const :tag "Sign replies to plain messages" sign-plain-replies)
|
||||
(const :tag "Encrypt replies to plain messages"
|
||||
encrypt-plain-replies)
|
||||
(const :tag "Sign replies to encrypted messages"
|
||||
sign-encrypted-replies)
|
||||
(const :tag "Encrypt replies to encrypted messages"
|
||||
encrypt-encrypted-replies))
|
||||
:group 'mu4e-compose)
|
||||
|
||||
;;; Crypto
|
||||
(defun mu4e--prepare-crypto (parent compose-type)
|
||||
"Possibly encrypt or sign a message based on PARENT and COMPOSE-TYPE.
|
||||
See `mu4e-compose-crypto-policy' for more details."
|
||||
(let* ((encrypted-p
|
||||
(and parent (memq 'encrypted (mu4e-message-field parent :flags))))
|
||||
(encrypt
|
||||
(or (memq 'encrypt-all-messages mu4e-compose-crypto-policy)
|
||||
(and (memq 'encrypt-new-messages mu4e-compose-crypto-policy)
|
||||
(eq compose-type 'new)) ;; new messages
|
||||
(and (eq compose-type 'forward) ;; forwarded
|
||||
(memq 'encrypt-forwarded-messages mu4e-compose-crypto-policy))
|
||||
(and (eq compose-type 'edit) ;; edit
|
||||
(memq 'encrypt-edited-messages mu4e-compose-crypto-policy))
|
||||
(and (eq compose-type 'reply) ;; all replies
|
||||
(memq 'encrypt-all-replies mu4e-compose-crypto-policy))
|
||||
(and (eq compose-type 'reply) (not encrypted-p) ;; plain replies
|
||||
(memq 'encrypt-plain-replies mu4e-compose-crypto-policy))
|
||||
(and (eq compose-type 'reply) encrypted-p
|
||||
(memq 'encrypt-encrypted-replies
|
||||
mu4e-compose-crypto-policy)))) ;; encrypted replies
|
||||
(sign
|
||||
(or (memq 'sign-all-messages mu4e-compose-crypto-policy)
|
||||
(and (eq compose-type 'new) ;; new messages
|
||||
(memq 'sign-new-messages mu4e-compose-crypto-policy))
|
||||
(and (eq compose-type 'forward) ;; forwarded messages
|
||||
(memq 'sign-forwarded-messages mu4e-compose-crypto-policy))
|
||||
(and (eq compose-type 'edit) ;; edited messages
|
||||
(memq 'sign-edited-messages mu4e-compose-crypto-policy))
|
||||
(and (eq compose-type 'reply) ;; all replies
|
||||
(memq 'sign-all-replies mu4e-compose-crypto-policy))
|
||||
(and (eq compose-type 'reply) (not encrypted-p) ;; plain replies
|
||||
(memq 'sign-plain-replies mu4e-compose-crypto-policy))
|
||||
(and (eq compose-type 'reply) encrypted-p ;; encrypted replies
|
||||
(memq 'sign-encrypted-replies mu4e-compose-crypto-policy)))))
|
||||
(cond ((and sign encrypt) (mml-secure-message-sign-encrypt))
|
||||
(sign (mml-secure-message-sign))
|
||||
(encrypt (mml-secure-message-encrypt)))))
|
||||
|
||||
(defcustom mu4e-sent-messages-behavior 'sent
|
||||
"Determines what mu4e does with sent messages.
|
||||
|
||||
This is one of the symbols:
|
||||
* `sent' move the sent message to the Sent-folder (`mu4e-sent-folder')
|
||||
* `trash' move the sent message to the Trash-folder (`mu4e-trash-folder')
|
||||
* `delete' delete the sent message.
|
||||
|
||||
Note, when using GMail/IMAP, you should set this to either
|
||||
`trash' or `delete', since GMail already takes care of keeping
|
||||
copies in the sent folder.
|
||||
|
||||
Alternatively, `mu4e-sent-messages-behavior' can be a function
|
||||
which takes no arguments, and which should return one of the mentioned
|
||||
symbols, for example:
|
||||
|
||||
(setq mu4e-sent-messages-behavior (lambda ()
|
||||
(if (string= (message-sendmail-envelope-from) \"foo@example.com\")
|
||||
\\='delete \\='sent)))
|
||||
|
||||
The various `message-' functions from `message-mode' are available
|
||||
for querying the message information."
|
||||
:type '(choice (const :tag "move message to mu4e-sent-folder" sent)
|
||||
(const :tag "move message to mu4e-trash-folder" trash)
|
||||
(const :tag "delete message" delete))
|
||||
:group 'mu4e-compose)
|
||||
|
||||
(defcustom mu4e-compose-context-policy 'ask
|
||||
"Policy for determining the context when composing a new message.
|
||||
|
||||
If the value is `always-ask', ask the user unconditionally.
|
||||
|
||||
In all other cases, if any context matches (using its match
|
||||
function), this context is used. Otherwise, if none of the
|
||||
contexts match, we have the following choices:
|
||||
|
||||
- `pick-first': pick the first of the contexts available (ie. the default)
|
||||
- `ask': ask the user
|
||||
- `ask-if-none': ask if there is no context yet, otherwise leave it as it is
|
||||
- nil: return nil; leaves the current context as is.
|
||||
|
||||
Also see `mu4e-context-policy'."
|
||||
:type '(choice
|
||||
(const :tag "Always ask what context to use" always-ask)
|
||||
(const :tag "Ask if none of the contexts match" ask)
|
||||
(const :tag "Ask when there's no context yet" ask-if-none)
|
||||
(const :tag "Pick the first context if none match" pick-first)
|
||||
(const :tag "Don't change the context when none match" nil))
|
||||
:safe 'symbolp
|
||||
:group 'mu4e-compose)
|
||||
|
||||
;;
|
||||
;; display the ready-to-go display buffer in the desired way.
|
||||
;;
|
||||
(defun mu4e--display-draft-buffer (cbuf)
|
||||
"Display the message composition buffer CBUF.
|
||||
Display is influenced by `mu4e-compose-switch'."
|
||||
(let ((func
|
||||
(pcase mu4e-compose-switch
|
||||
('nil #'switch-to-buffer)
|
||||
('window #'switch-to-buffer-other-window)
|
||||
((or 'frame 't) #'switch-to-buffer-other-frame)
|
||||
('display-buffer #'display-buffer)
|
||||
(_ (mu4e-error "Invalid mu4e-compose-switch")))))
|
||||
(funcall func cbuf)))
|
||||
|
||||
(defvar mu4e-user-agent-string
|
||||
(format "mu4e %s; emacs %s" mu4e-mu-version emacs-version)
|
||||
"The User-Agent string for mu4e, or nil.")
|
||||
|
||||
;;; Runtime variables; useful for user-hooks etc.
|
||||
(defvar-local mu4e-compose-parent-message nil
|
||||
"The parent message plist.
|
||||
This is the message being replied to, forwarded or edited; used
|
||||
in `mu4e-compose-pre-hook'. For new (non-reply, forward etc.)
|
||||
messages, it is nil.")
|
||||
|
||||
(defvar-local mu4e-compose-type nil
|
||||
"The compose-type for the current message.")
|
||||
|
||||
;;; Filenames
|
||||
(defun mu4e--draft-basename()
|
||||
"Construct a randomized filename for a message with flags FLAGSTR.
|
||||
It looks something like
|
||||
<time>-<random>.<hostname>
|
||||
|
||||
This filename is used for the draft message and the sent message,
|
||||
depending on `mu4e-sent-messages-behavior'."
|
||||
(let* ((sysname (if (fboundp 'system-name)
|
||||
(system-name) (with-no-warnings system-name)))
|
||||
(sysname (if (string= sysname "") "localhost" sysname))
|
||||
(hostname (downcase
|
||||
(save-match-data
|
||||
(substring sysname
|
||||
(string-match "^[^.]+" sysname)
|
||||
(match-end 0))))))
|
||||
(format "%s.%04x%04x%04x%04x.%s"
|
||||
(format-time-string "%s" (current-time))
|
||||
(random 65535) (random 65535) (random 65535) (random 65535)
|
||||
hostname)))
|
||||
|
||||
(defun mu4e--draft-message-path (base-name &optional parent)
|
||||
"Construct a draft message path, based on PARENT if provided.
|
||||
|
||||
PARENT is either nil or the original message (being replied
|
||||
to/forwarded etc.), and is used to determine the draft folder.
|
||||
BASE-NAME is the base filename without any Maildir decoration."
|
||||
(let ((draft-dir (mu4e-get-drafts-folder parent)))
|
||||
(mu4e-join-paths
|
||||
(mu4e-root-maildir) draft-dir "cur"
|
||||
(format "%s%s2,DS" base-name mu4e-maildir-info-delimiter))))
|
||||
|
||||
(defun mu4e--fcc-path (base-name &optional parent)
|
||||
"Construct a Fcc: path, based on PARENT and `mu4e-sent-messages-behavior'.
|
||||
|
||||
PARENT is either nil or the original message (being replied
|
||||
to/forwarded etc.), and is used to determine the sent folder,
|
||||
together with `mu4e-sent-messages-behavior'. BASE-NAME is the
|
||||
base filename without any Maildir decoration.
|
||||
|
||||
Returns the path for the sent message, either in the sent or
|
||||
trash folder, or nil if the message should be removed after
|
||||
sending."
|
||||
(let* ((behavior
|
||||
(if (functionp mu4e-sent-messages-behavior)
|
||||
(funcall mu4e-sent-messages-behavior) mu4e-sent-messages-behavior))
|
||||
(sent-dir
|
||||
(pcase behavior
|
||||
('delete nil)
|
||||
('trash (mu4e-get-trash-folder parent))
|
||||
('sent (mu4e-get-sent-folder parent))
|
||||
(_ (mu4e-error "Error in `mu4e-sent-messages-behavior'")))))
|
||||
(when sent-dir
|
||||
(mu4e-join-paths
|
||||
(mu4e-root-maildir) sent-dir "cur"
|
||||
(format "%s%s2,S" base-name mu4e-maildir-info-delimiter)))))
|
||||
|
||||
|
||||
(defconst mu4e--header-separator
|
||||
;; XX properties don't show... why not?
|
||||
(propertize "--text follows this line--" 'read-only t 'intangible t)
|
||||
"Line used to separate headers from text in messages being composed.")
|
||||
|
||||
(defun mu4e--delimit-headers (&optional undelimit)
|
||||
"Delimit or undelimit (with UNDELIMIT) headers."
|
||||
(let ((mail-header-separator (substring-no-properties mu4e--header-separator))
|
||||
(inhibit-read-only t))
|
||||
(save-excursion (mail-sendmail-undelimit-header)) ;; clear first
|
||||
(unless undelimit (save-excursion (mail-sendmail-delimit-header)))))
|
||||
|
||||
(defun mu4e--decoded-message (msg &optional headers-only)
|
||||
"Get the message MSG, decoded as a string.
|
||||
With HEADERS-ONLY non-nil, only include the headers part."
|
||||
(with-temp-buffer
|
||||
(setq-local gnus-article-decode-hook
|
||||
'(article-decode-charset
|
||||
article-decode-encoded-words
|
||||
article-decode-idna-rhs
|
||||
article-treat-non-ascii
|
||||
article-remove-cr
|
||||
article-de-base64-unreadable
|
||||
article-de-quoted-unreadable)
|
||||
gnus-inhibit-mime-unbuttonizing nil
|
||||
gnus-unbuttonized-mime-types '(".*/.*")
|
||||
gnus-original-article-buffer (current-buffer))
|
||||
(insert-file-contents-literally
|
||||
(mu4e-message-readable-path msg) nil nil nil t)
|
||||
;; remove the body / attachments and what not.
|
||||
(when headers-only
|
||||
(rfc822-goto-eoh)
|
||||
(delete-region (point) (point-max)))
|
||||
;; in rare (broken) case, if a message-id is missing use the generated one
|
||||
;; from mu.
|
||||
(mu4e--delimit-headers)
|
||||
(unless (message-field-value "Message-Id")
|
||||
(goto-char (point-min))
|
||||
(insert (format "Message-Id: <%s>\n" (plist-get msg :message-id))))
|
||||
(mu4e--delimit-headers 'undelimit)
|
||||
(ignore-errors (run-hooks 'gnus-article-decode-hook))
|
||||
(buffer-substring-no-properties (point-min) (point-max))))
|
||||
|
||||
(defvar mu4e--draft-buffer-max-name-length 48)
|
||||
(defun mu4e--draft-set-friendly-buffer-name ()
|
||||
"Use some friendly name for this draft buffer."
|
||||
(let* ((subj (message-field-value "subject"))
|
||||
(subj (if (or (not subj) (string-match "^[:blank:]*$" subj))
|
||||
"No subject" subj)))
|
||||
(rename-buffer (generate-new-buffer-name
|
||||
(format "\"%s\""
|
||||
(truncate-string-to-width subj
|
||||
mu4e--draft-buffer-max-name-length
|
||||
0 nil t)))
|
||||
(buffer-name))))
|
||||
|
||||
;; hook impls
|
||||
|
||||
(defun mu4e--fcc-handler (msgpath)
|
||||
"Handle Fcc: for MSGPATH.
|
||||
This ensures that a copy of a sent messages ends up in the
|
||||
appropriate sent-messages folder. If MSGPATH is nil, do nothing."
|
||||
(when msgpath
|
||||
(let* ((target-dir (file-name-directory msgpath))
|
||||
(target-mdir (file-name-directory target-dir)))
|
||||
;; create maildir if needed
|
||||
(unless (file-exists-p target-mdir)
|
||||
(make-directory
|
||||
(mu4e-join-paths target-mdir "cur" 'parents))
|
||||
(make-directory
|
||||
(mu4e-join-paths target-mdir "new" 'parents)))
|
||||
(write-file msgpath)
|
||||
(mu4e--server-add msgpath))))
|
||||
|
||||
;; save / send hooks
|
||||
|
||||
(defvar-local mu4e--compose-undo nil
|
||||
"Remember the undo-state.")
|
||||
|
||||
(defun mu4e--compose-before-save ()
|
||||
"Function called just before the draft buffer is saved."
|
||||
;; This does 3 things:
|
||||
;; - set the Message-Id if not already
|
||||
;; - set the Date if not already
|
||||
;; - (temporarily) remove the mail-header separator
|
||||
(setq mu4e--compose-undo buffer-undo-list)
|
||||
(save-excursion
|
||||
(unless (message-field-value "Message-ID")
|
||||
(message-generate-headers '(Message-ID)))
|
||||
;; older Emacsen (<= 28 perhaps?) won't update the Date
|
||||
;; if there already is one; so make sure it's gone.
|
||||
(message-remove-header "Date")
|
||||
(message-generate-headers '(Date Subject From))
|
||||
(mu4e--delimit-headers 'undelimit))) ;; remove separator
|
||||
|
||||
(defun mu4e--set-parent-flags (path)
|
||||
"Set flags for replied-to and forwarded for the message at PATH.
|
||||
That is, set the `replied' \"R\" flag on messages we replied to,
|
||||
and the `passed' \"F\" flag on message we have forwarded.
|
||||
|
||||
If a message has an \"In-Reply-To\" header, it is considered a
|
||||
reply to the message with the corresponding message id.
|
||||
Otherwise, if it does not have an \"In-Reply-To\" header, but
|
||||
does have a \"References:\" header, it is considered to be a
|
||||
forward message for the message corresponding with the /last/
|
||||
message-id in the references header.
|
||||
|
||||
If the message has been determined to be either a forwarded
|
||||
message or a reply, we instruct the server to update that message
|
||||
with resp. the \"P\" (passed) flag for a forwarded message, or
|
||||
the \"R\" flag for a replied message. The original messages are
|
||||
also marked as Seen.
|
||||
|
||||
Function assumes that it is executed in the context of the
|
||||
message buffer."
|
||||
(when-let ((buf (find-file-noselect path)))
|
||||
(with-current-buffer buf
|
||||
(let ((in-reply-to (message-field-value "in-reply-to"))
|
||||
(forwarded-from)
|
||||
(references (message-field-value "references")))
|
||||
(unless in-reply-to
|
||||
(when references
|
||||
(with-temp-buffer ;; inspired by `message-shorten-references'.
|
||||
(insert references)
|
||||
(goto-char (point-min))
|
||||
(let ((refs))
|
||||
(while (re-search-forward "<[^ <]+@[^ <]+>" nil t)
|
||||
(push (match-string 0) refs))
|
||||
;; the last will be the first
|
||||
(setq forwarded-from (car refs))))))
|
||||
;; remove the <> and update the flags on the server-side.
|
||||
(when (and in-reply-to (string-match "<\\(.*\\)>" in-reply-to))
|
||||
(mu4e--server-move (match-string 1 in-reply-to) nil "+R-N"))
|
||||
(when (and forwarded-from (string-match "<\\(.*\\)>" forwarded-from))
|
||||
(mu4e--server-move (match-string 1 forwarded-from) nil "+P-N"))))))
|
||||
|
||||
(defun mu4e--compose-after-save()
|
||||
"Function called immediately after the draft buffer is saved."
|
||||
;; This does 3 things:
|
||||
;; - restore the mail-header-separator (see mu4e--compose-before-save)
|
||||
;; - update the buffer name (based on the message subject
|
||||
;; - tell the mu server about the updated draft message
|
||||
(mu4e--delimit-headers)
|
||||
(mu4e--draft-set-friendly-buffer-name)
|
||||
;; tell the server
|
||||
(mu4e--server-add (buffer-file-name))
|
||||
;; restore history.
|
||||
(set-buffer-modified-p nil)
|
||||
(setq buffer-undo-list mu4e--compose-undo))
|
||||
|
||||
(defun mu4e-sent-handler (docid path)
|
||||
"Handler called with DOCID and PATH for the just-sent message.
|
||||
For Forwarded ('Passed') and Replied messages, try to set the
|
||||
appropriate flag at the message forwarded or replied-to."
|
||||
;; XXX we don't need this function anymore here, but
|
||||
;; we have an external caller in mu4e-icalendar... we should
|
||||
;; update that.
|
||||
(mu4e--set-parent-flags path)
|
||||
;; if the draft file exists, remove it now.
|
||||
(when (file-exists-p path)
|
||||
(mu4e--server-remove docid)))
|
||||
|
||||
(defun mu4e--send-harden-newlines ()
|
||||
"Set the hard property to all newlines."
|
||||
(save-excursion
|
||||
(goto-char (point-min))
|
||||
(while (search-forward "\n" nil t)
|
||||
(put-text-property (1- (point)) (point) 'hard t))))
|
||||
|
||||
(defun mu4e--compose-before-send ()
|
||||
"Function called just before sending a message."
|
||||
;; Remove References: if In-Reply-To: is missing.
|
||||
;; This allows the user to effectively start a new message-thread by
|
||||
;; removing the In-Reply-To header.
|
||||
(when (eq mu4e-compose-type 'reply)
|
||||
(unless (message-field-value "In-Reply-To")
|
||||
(message-remove-header "References")))
|
||||
(when use-hard-newlines
|
||||
(mu4e--send-harden-newlines))
|
||||
;; now handle what happens _after_ sending; typically, draft is gone and
|
||||
;; the sent message appears in sent. Update flags for related messages,
|
||||
;; i.e. for Forwarded ('Passed') and Replied messages, try to set the
|
||||
;; appropriate flag at the message forwarded or replied-to.
|
||||
(add-hook 'message-sent-hook
|
||||
(lambda ()
|
||||
(when-let ((fcc-path (message-field-value "Fcc")))
|
||||
(mu4e--set-parent-flags fcc-path)
|
||||
;; we end up with a ((buried) buffer here, visiting the
|
||||
;; fcc-path; not quite sure why. But let's get rid of it (#2681)
|
||||
(when-let ((buf (find-buffer-visiting fcc-path)))
|
||||
(kill-buffer buf))))
|
||||
nil t))
|
||||
|
||||
;; overrides for message-* functions
|
||||
;;
|
||||
;; mostly some magic because the message-reply/-forward/... functions want to
|
||||
;; create and switch to buffer by themselves; but mu4e wants to control
|
||||
;; when/where the buffers are shown so we subvert the message-functions and get
|
||||
;; the buffer without display it.
|
||||
|
||||
(defvar mu4e--message-buf nil
|
||||
"The message buffer created by (overridden) message-* functions.")
|
||||
|
||||
(defun mu4e--message-pop-to-buffer (name &optional _switch)
|
||||
"Mu4e override for `message-pop-to-buffer'.
|
||||
Creates a buffer NAME and returns it."
|
||||
(set-buffer (get-buffer-create name))
|
||||
(erase-buffer)
|
||||
(setq mu4e--message-buf (current-buffer)))
|
||||
|
||||
(defun mu4e--message-is-yours-p ()
|
||||
"Mu4e's override for `message-is-yours-p'."
|
||||
(seq-some (lambda (field)
|
||||
(if-let ((recip (message-field-value field)))
|
||||
(mu4e-personal-or-alternative-address-p
|
||||
(car (mail-header-parse-address recip)))))
|
||||
'("From" "Sender")))
|
||||
|
||||
(defmacro mu4e--validate-hidden-buffer (&rest body)
|
||||
"Macro to evaluate BODY and asserts that it yields a valid buffer.
|
||||
Where valid means that it is a live an non-active buffer.
|
||||
Returns said buffer."
|
||||
`(let ((buf (progn ,@body)))
|
||||
(cl-assert (buffer-live-p buf))
|
||||
(cl-assert (not (eq buf (window-buffer (selected-window)))))
|
||||
buf))
|
||||
|
||||
(defun mu4e--message-call (func &rest params)
|
||||
"Call message/gnus functions from a mu4e-context.
|
||||
E.g., functions such as `message-reply' or `message-forward', but
|
||||
manipulate such that they do *not* switch to the created buffer,
|
||||
but merely return it.
|
||||
|
||||
FUNC is the function to call and PARAMS are its parameters.
|
||||
|
||||
For replying/forwarding, this functions expects to be called
|
||||
while in a buffer with the to-be-forwarded/replied-to message."
|
||||
(let* ((message-this-is-mail t)
|
||||
(message-generate-headers-first nil)
|
||||
(message-newsreader mu4e-user-agent-string)
|
||||
(message-mail-user-agent nil))
|
||||
(cl-letf
|
||||
;; `message-pop-to-buffer' attempts switching the visible buffer;
|
||||
;; instead, we manipulate it to _return_ the buffer.
|
||||
(((symbol-function #'message-pop-to-buffer)
|
||||
#'mu4e--message-pop-to-buffer)
|
||||
;; teach `message-is-yours-p' about how mu4e defines that
|
||||
((symbol-function #'message-is-yours-p)
|
||||
#'mu4e--message-is-yours-p))
|
||||
;; also turn off all the gnus crypto handling, we do that ourselves..
|
||||
(setq-local gnus-message-replysign nil
|
||||
gnus-message-replyencrypt nil
|
||||
gnus-message-replysignencrypted nil)
|
||||
(setq mu4e--message-buf nil)
|
||||
(apply func params))
|
||||
(mu4e--validate-hidden-buffer mu4e--message-buf)))
|
||||
;;
|
||||
;; make the draft buffer ready for use.
|
||||
;;
|
||||
|
||||
(defun mu4e--jump-to-a-reasonable-place ()
|
||||
"Jump to a reasonable place for writing an email."
|
||||
(if (not (message-field-value "To"))
|
||||
(message-goto-to)
|
||||
(if (not (message-field-value "Subject"))
|
||||
(message-goto-subject)
|
||||
(pcase message-cite-reply-position
|
||||
((or 'above 'traditional) (message-goto-body))
|
||||
(_ (when (message-goto-signature) (forward-line -2)))))))
|
||||
|
||||
(defvar mu4e-draft-hidden-headers
|
||||
(append message-hidden-headers '("^User-agent:" "^Fcc:"))
|
||||
"Message headers to hide when composing.
|
||||
This is mu4e's version of `message-hidden-headers'.")
|
||||
|
||||
(defun mu4e--prepare-draft (&optional parent)
|
||||
"Get ready for message composition.
|
||||
PARENT is the parent message, if any."
|
||||
(unless (mu4e-running-p) (mu4e 'background)) ;; start if needed
|
||||
(mu4e--context-autoswitch parent mu4e-compose-context-policy))
|
||||
|
||||
(defun mu4e--prepare-draft-headers (compose-type)
|
||||
"Add extra headers for message based on COMPOSE-TYPE."
|
||||
(message-generate-headers
|
||||
(seq-filter #'identity ;; ensure needed headers are generated.
|
||||
`(From Subject Date Message-ID
|
||||
,(when (memq compose-type '(reply forward)) 'References)
|
||||
,(when (eq compose-type 'reply) 'In-Reply-To)
|
||||
,(when message-newsreader 'User-Agent)
|
||||
,(when message-user-organization 'Organization)))))
|
||||
|
||||
(defun mu4e--prepare-draft-buffer (compose-type parent)
|
||||
"Prepare the current buffer as a draft-buffer.
|
||||
COMPOSE-TYPE and PARENT are as in `mu4e--draft'."
|
||||
(cl-assert (member compose-type '(reply forward edit new)))
|
||||
(cl-assert (eq (if parent t nil)
|
||||
(if (member compose-type '(reply forward)) t nil)))
|
||||
;; remember some variables, e.g for user hooks. These are permanent-local
|
||||
;; hence survive the mode-switch below (we do this so these useful vars are
|
||||
;; available in mode-hooks.
|
||||
(setq
|
||||
mu4e-compose-parent-message parent
|
||||
mu4e-compose-type compose-type)
|
||||
|
||||
;; draft path
|
||||
(unless (eq compose-type 'edit)
|
||||
(set-visited-file-name ;; make it a draft file
|
||||
(mu4e--draft-message-path (mu4e--draft-basename) parent)))
|
||||
;; fcc
|
||||
(when-let ((fcc-path (mu4e--fcc-path (mu4e--draft-basename) parent)))
|
||||
(message-add-header (concat "Fcc: " fcc-path "\n")))
|
||||
|
||||
(mu4e--prepare-draft-headers compose-type)
|
||||
(mu4e--prepare-crypto parent compose-type)
|
||||
;; set the attachment dir to something more reasonable than the draft
|
||||
;; directory.
|
||||
(setq default-directory (mu4e-determine-attachment-dir))
|
||||
(mu4e--draft-set-friendly-buffer-name)
|
||||
|
||||
;; now, switch to compose mode
|
||||
(mu4e-compose-mode)
|
||||
|
||||
;; hide some internal headers
|
||||
(let ((message-hidden-headers mu4e-draft-hidden-headers))
|
||||
(message-hide-headers))
|
||||
|
||||
;; hooks
|
||||
(add-hook 'before-save-hook #'mu4e--compose-before-save nil t)
|
||||
(add-hook 'after-save-hook #'mu4e--compose-after-save nil t)
|
||||
(add-hook 'message-send-hook #'mu4e--compose-before-send nil t)
|
||||
(setq-local message-fcc-handler-function #'mu4e--fcc-handler)
|
||||
|
||||
(mu4e--jump-to-a-reasonable-place)
|
||||
|
||||
(set-buffer-modified-p nil)
|
||||
(undo-boundary))
|
||||
|
||||
;;
|
||||
;; mu4e-compose-pos-hook helpers
|
||||
|
||||
(defvar mu4e--before-draft-window-config nil
|
||||
"The window configuration just before creating the draft.")
|
||||
|
||||
(defun mu4e-compose-post-restore-window-configuration()
|
||||
"Function that perhaps restores the window configuration.
|
||||
I.e. the configuration just before the draft buffer appeared.
|
||||
This is for use in `mu4e-compose-post-hook'.
|
||||
See `set-window-configuration' for further details."
|
||||
(when mu4e--before-draft-window-config
|
||||
;;(message "RESTORE to %s" mu4e--before-draft-window-config)
|
||||
(set-window-configuration mu4e--before-draft-window-config)
|
||||
(setq mu4e--before-draft-window-config nil)))
|
||||
|
||||
(defvar mu4e--draft-activation-frame nil
|
||||
"Frame from which composition was activated.
|
||||
Used internally for mu4e-compose-post-kill-frame.")
|
||||
|
||||
(defun mu4e-compose-post-kill-frame ()
|
||||
"Function that perhaps kills the composition frame.
|
||||
This is for use in `mu4e-compose-post-hook'."
|
||||
(let ((msgframe (selected-frame)))
|
||||
;;(message "kill frame? %s %s" mu4e--draft-activation-frame msgframe)
|
||||
(when (and (frame-live-p msgframe)
|
||||
(not (eq mu4e--draft-activation-frame msgframe)))
|
||||
(delete-frame msgframe))))
|
||||
|
||||
(defvar mu4e-message-post-action nil
|
||||
"Runtime variable for use with `mu4e-compose-post-hook'.
|
||||
It contains a symbol denoting the action that triggered the hook,
|
||||
either `send', `exit', `kill' or `postpone'.")
|
||||
|
||||
(defvar mu4e-compose-post-hook)
|
||||
(defun mu4e--message-post-actions (trigger)
|
||||
"Invoked after we're done with a message.
|
||||
|
||||
I.e. this multiplexes the `message-(send|exit|kill|postpone)-actions';
|
||||
with the mu4e-message-post-action set accordingly."
|
||||
(setq mu4e-message-post-action trigger)
|
||||
(run-hooks 'mu4e-compose-post-hook))
|
||||
|
||||
(defun mu4e--prepare-post (&optional oldframe oldwindconf)
|
||||
"Prepare the `mu4e-compose-post-hook` handling.
|
||||
|
||||
Set up some message actions. In particular, handle closing frames
|
||||
when we created it. OLDFRAME is the frame from which the
|
||||
message-composition was triggered. OLDWINDCONF is the current
|
||||
window configuration."
|
||||
;; remember current frame & window conf
|
||||
(setq mu4e--draft-activation-frame oldframe
|
||||
mu4e--before-draft-window-config oldwindconf)
|
||||
|
||||
;; make message's "post" hooks local, and multiplex them
|
||||
(make-local-variable 'message-send-actions)
|
||||
(make-local-variable 'message-postpone-actions)
|
||||
(make-local-variable 'message-exit-actions)
|
||||
(make-local-variable 'message-kill-actions)
|
||||
|
||||
(push (lambda () (mu4e--message-post-actions 'send))
|
||||
message-send-actions)
|
||||
(push (lambda () (mu4e--message-post-actions 'postpone))
|
||||
message-postpone-actions)
|
||||
(push (lambda () (mu4e--message-post-actions 'exit))
|
||||
message-exit-actions)
|
||||
(push (lambda () (mu4e--message-post-actions 'kill))
|
||||
message-kill-actions))
|
||||
|
||||
;;
|
||||
;; creating drafts
|
||||
;;
|
||||
|
||||
(defun mu4e--draft (compose-type compose-func &optional parent)
|
||||
"Create a new message draft.
|
||||
|
||||
This is the central access point for creating new mail buffers;
|
||||
when there's a parent message, use `mu4e--compose-with-parent'.
|
||||
|
||||
COMPOSE-TYPE is the type of message to create. COMPOSE-FUNC is a
|
||||
function that must return a buffer that satisfies
|
||||
`mu4e--validate-hidden-buffer'.
|
||||
|
||||
Optionally, PARENT is the message parent or nil. For compose-type
|
||||
`reply' and `forward' we require a PARENT; for the other compose
|
||||
it must be nil.
|
||||
|
||||
After this, user is presented with a message composition buffer.
|
||||
|
||||
Returns the new buffer."
|
||||
(mu4e--prepare-draft parent)
|
||||
;; evaluate BODY; this must yield a hidden, live buffer. This is evaluated in
|
||||
;; a temp buffer with contains the parent-message, if any. if there's a
|
||||
;; PARENT, load the corresponding message into a temp-buffer before calling
|
||||
;; compose-func
|
||||
(let ((draft-buffer)
|
||||
(oldframe (selected-frame))
|
||||
(oldwinconf (current-window-configuration)))
|
||||
(with-temp-buffer
|
||||
;; provide a temp buffer so the compose-func can do its thing
|
||||
(setq draft-buffer (mu4e--validate-hidden-buffer (funcall compose-func)))
|
||||
(with-current-buffer draft-buffer
|
||||
;; we have our basic buffer; turn it into a full mu4e composition
|
||||
;; buffer.
|
||||
(mu4e--prepare-draft-buffer compose-type parent)))
|
||||
;; we're ready for composition; let's display it in the way user configured
|
||||
;; things: directly through display buffer (via pop-t or otherwise through
|
||||
;; mu4e-window.
|
||||
(if (eq mu4e-compose-switch 'display-buffer)
|
||||
(pop-to-buffer draft-buffer)
|
||||
(mu4e-display-buffer draft-buffer 'do-select))
|
||||
;; prepare possible message actions (such as cleaning-up)
|
||||
(mu4e--prepare-post oldframe oldwinconf)
|
||||
draft-buffer))
|
||||
|
||||
(defun mu4e--draft-with-parent (compose-type parent compose-func)
|
||||
"Draft a message based on some parent message.
|
||||
COMPOSE-TYPE, COMPOSE-FUNC and PARENT are as in `mu4e--draft',
|
||||
but note the different order."
|
||||
(mu4e--draft
|
||||
compose-type
|
||||
(lambda ()
|
||||
(let ( ;; only needed for Fwd. Gnus has a bad default.
|
||||
(message-make-forward-subject-function
|
||||
(list #'message-forward-subject-fwd)))
|
||||
(insert (mu4e--decoded-message parent))
|
||||
;; let's make sure we don't use message-reply-headers from
|
||||
;; some unrelated message.
|
||||
(setq message-reply-headers nil)
|
||||
(funcall compose-func)))
|
||||
parent))
|
||||
|
||||
(provide 'mu4e-draft)
|
|
@ -134,15 +134,14 @@
|
|||
(or organizer
|
||||
(plist-get (car (plist-get msg :reply-to)) :email)
|
||||
(plist-get (car (plist-get msg :from)) :email)
|
||||
(mu4e-warn "Cannot find organizer"))))
|
||||
(message-reply organizer)
|
||||
(goto-char (point-max))
|
||||
(mu4e-warn "Cannot find organizer")))
|
||||
(message-cite-function #'mu4e-message-cite-nothing))
|
||||
(mu4e-compose-reply-to organizer)
|
||||
(message-goto-body)
|
||||
(mml-insert-multipart "alternative")
|
||||
(mml-insert-empty-tag 'part 'type "text/plain")
|
||||
(mml-attach-buffer ical-name
|
||||
"text/calendar; method=REPLY; charset=UTF-8")
|
||||
(mu4e-compose-mode)
|
||||
(when mu4e-icalendar-trash-after-reply
|
||||
;; Override `mu4e-sent-handler' set by `mu4e-compose-mode' to
|
||||
;; also trash the message (thus must be appended to hooks).
|
||||
|
|
|
@ -1,6 +1,6 @@
|
|||
;;; mu4e-obsolete.el --- Obsolete things -*- lexical-binding: t -*-
|
||||
|
||||
;; Copyright (C) 2022-2023 Dirk-Jan C. Binnema
|
||||
;; Copyright (C) 2022-2024 Dirk-Jan C. Binnema
|
||||
|
||||
;; Author: Dirk-Jan C. Binnema <djcb@djcbsoftware.nl>
|
||||
;; Maintainer: Dirk-Jan C. Binnema <djcb@djcbsoftware.nl>
|
||||
|
@ -65,6 +65,10 @@
|
|||
'mu4e-compose-cite-function 'message-cite-function "1.11.22")
|
||||
(define-obsolete-variable-alias
|
||||
'mu4e-compose-in-new-frame 'mu4e-compose-switch "1.11.22")
|
||||
|
||||
(define-obsolete-variable-alias 'mu4e-compose-hidden-headers
|
||||
'mu4e-draft-hidden-headers "1.12.5")
|
||||
|
||||
|
||||
;; mu4e-message
|
||||
|
||||
|
|
|
@ -1,6 +1,7 @@
|
|||
;;; mu4e-window.el --- Window management -*- lexical-binding: t; -*-
|
||||
|
||||
;; Copyright (C) 2022 Mickey Petersen
|
||||
;; Copyright (C) 2023-2024 Dirk-Jan C. Binnema
|
||||
|
||||
;; Author: Mickey Petersen <mickey@masteringemacs.org>
|
||||
;; Keywords: mail
|
||||
|
@ -33,7 +34,6 @@
|
|||
(defvar mu4e-embedded-buffer-name " *mu4e-embedded*"
|
||||
"Name for the embedded message view buffer.")
|
||||
|
||||
|
||||
;; Buffer names for public use
|
||||
|
||||
(defvar mu4e-headers-buffer-name "*mu4e-headers*"
|
||||
|
@ -89,6 +89,20 @@ vertical split-view."
|
|||
:type 'integer
|
||||
:group 'mu4e-headers)
|
||||
|
||||
(defcustom mu4e-compose-switch nil
|
||||
"Where to display the new message?
|
||||
A symbol:
|
||||
- nil : default (new buffer)
|
||||
- window : compose in new window
|
||||
- frame or t : compose in new frame
|
||||
- display-buffer: use `display-buffer' / `display-buffer-alist'
|
||||
(for fine-tuning).
|
||||
|
||||
For backward compatibility with `mu4e-compose-in-new-frame', t is
|
||||
treated as =\\'frame."
|
||||
:type 'symbol
|
||||
:group 'mu4e-compose)
|
||||
|
||||
(declare-function mu4e-view-mode "mu4e-view")
|
||||
(declare-function mu4e-error "mu4e-helpers")
|
||||
(declare-function mu4e-warn "mu4e-helpers")
|
||||
|
@ -196,20 +210,24 @@ being created if CREATE is non-nil."
|
|||
(let ((buffer)
|
||||
;; If `mu4e-view-buffer-name-func' is non-nil, then use that
|
||||
;; to source the name of the view buffer to create or re-use.
|
||||
(buffer-name (or (and mu4e-view-buffer-name-func
|
||||
(funcall mu4e-view-buffer-name-func headers-buffer))
|
||||
;; If the variable is nil, use the default
|
||||
;; name
|
||||
mu4e-view-buffer-name))
|
||||
(buffer-name
|
||||
(or (and mu4e-view-buffer-name-func
|
||||
(funcall mu4e-view-buffer-name-func headers-buffer))
|
||||
;; If the variable is nil, use the default
|
||||
;; name
|
||||
mu4e-view-buffer-name))
|
||||
;; Search all view buffers and return those that are linked to
|
||||
;; `headers-buffer'.
|
||||
(linked-buffer (mu4e-get-view-buffers
|
||||
(lambda (buf)
|
||||
(and (mu4e--buffer-local-boundp 'mu4e-linked-headers-buffer buf)
|
||||
(eq mu4e-linked-headers-buffer headers-buffer))))))
|
||||
;; If such a linked buffer exists and its buffer is live, we use that buffer.
|
||||
(linked-buffer
|
||||
(mu4e-get-view-buffers
|
||||
(lambda (buf)
|
||||
(and (mu4e--buffer-local-boundp 'mu4e-linked-headers-buffer buf)
|
||||
(eq mu4e-linked-headers-buffer headers-buffer))))))
|
||||
;; If such a linked buffer exists and its buffer is live, we use that
|
||||
;; buffer.
|
||||
(if (and linked-buffer (buffer-live-p (car linked-buffer)))
|
||||
;; NOTE: It's possible for there to be more than one linked view buffer.
|
||||
;; NOTE: It's possible for there to be more than one linked view
|
||||
;; buffer.
|
||||
;;
|
||||
;; What, if anything, should the heuristic be to pick the
|
||||
;; one to use? Presently `car' is used, but there are better
|
||||
|
@ -274,8 +292,10 @@ for BUFFER-OR-NAME to be displayed in."
|
|||
(setq mu4e-split-view 'horizontal))
|
||||
|
||||
(let* ((buffer-name (or (get-buffer buffer-or-name)
|
||||
(mu4e-error "Buffer `%s' does not exist" buffer-or-name)))
|
||||
(buffer-type (with-current-buffer buffer-name (mu4e--get-current-buffer-type)))
|
||||
(mu4e-error "Buffer `%s' does not exist"
|
||||
buffer-or-name)))
|
||||
(buffer-type
|
||||
(with-current-buffer buffer-name (mu4e--get-current-buffer-type)))
|
||||
(direction (cons 'direction
|
||||
(pcase (cons buffer-type mu4e-split-view)
|
||||
;; views or headers can display
|
||||
|
@ -289,19 +309,34 @@ for BUFFER-OR-NAME to be displayed in."
|
|||
;; views or headers can display
|
||||
;; horz/vert depending on the value of
|
||||
;; `mu4e-split-view'
|
||||
('(view . horizontal) '((window-height . shrink-window-if-larger-than-buffer)))
|
||||
('(view . vertical) '((window-min-width . fit-window-to-buffer)))
|
||||
('(view . horizontal)
|
||||
'((window-height . shrink-window-if-larger-than-buffer)))
|
||||
('(view . vertical)
|
||||
'((window-min-width . fit-window-to-buffer)))
|
||||
(`(,_ . t) nil)))
|
||||
(window-action (cond
|
||||
((eq buffer-type 'main) '(display-buffer-reuse-window
|
||||
display-buffer-reuse-mode-window
|
||||
display-buffer-full-frame))
|
||||
((memq buffer-type '(headers compose))
|
||||
;; main-buffer
|
||||
((eq buffer-type 'main)
|
||||
'(display-buffer-reuse-window
|
||||
display-buffer-reuse-mode-window
|
||||
display-buffer-full-frame))
|
||||
;; compose-buffer
|
||||
((eq buffer-type 'compose)
|
||||
(pcase mu4e-compose-switch
|
||||
('window #'display-buffer-pop-up-window)
|
||||
((or 'frame 't) #'display-buffer-pop-up-frame)
|
||||
(_ '(display-buffer-reuse-window
|
||||
display-buffer-reuse-mode-window
|
||||
display-buffer-same-window))))
|
||||
;; headers buffer
|
||||
((memq buffer-type '(headers))
|
||||
'(display-buffer-reuse-window
|
||||
display-buffer-reuse-mode-window
|
||||
display-buffer-same-window))
|
||||
|
||||
((memq mu4e-split-view '(horizontal vertical))
|
||||
'(display-buffer-in-direction))
|
||||
|
||||
((memq mu4e-split-view '(single-window))
|
||||
'(display-buffer-reuse-window
|
||||
display-buffer-reuse-mode-window
|
||||
|
@ -314,8 +349,7 @@ for BUFFER-OR-NAME to be displayed in."
|
|||
display-buffer-same-window))))
|
||||
(arg `((,@window-action)
|
||||
,@window-size
|
||||
,direction
|
||||
)))
|
||||
,direction)))
|
||||
(funcall (if select #'pop-to-buffer #'display-buffer)
|
||||
buffer-name
|
||||
arg)))
|
||||
|
@ -339,11 +373,11 @@ This function is best called from the hook
|
|||
;; cause for error.
|
||||
(ignore-errors
|
||||
(cond ((eq mu4e-split-view 'vertical)
|
||||
(window-resize win (- mu4e-headers-visible-columns (window-width win nil))
|
||||
(window-resize win (- mu4e-headers-visible-columns
|
||||
(window-width win nil))
|
||||
t t nil))
|
||||
((eq mu4e-split-view 'horizontal)
|
||||
(set-window-text-height win mu4e-headers-visible-lines))))))
|
||||
|
||||
|
||||
(provide 'mu4e-window)
|
||||
;;; mu4e-window.el ends here
|
||||
|
|
|
@ -1648,8 +1648,8 @@ The major mode for the composer is @code{mu4e-compose-mode}.
|
|||
There are a view different ways to @emph{enter} the composer; i.e., from other
|
||||
@t{mu4e} views or even completely outside.
|
||||
|
||||
If you want the composer to start in a new frame or window, see the variable
|
||||
@t{mu4e-compose-switch}.
|
||||
If you want the composer to start in a new frame or window, you can configure
|
||||
the variable @t{mu4e-compose-switch}; see its docstring for details.
|
||||
|
||||
@subsection New message
|
||||
|
||||
|
@ -1798,11 +1798,15 @@ value of various properties (and see @ref{Message functions}).
|
|||
starts, when the whole buffer has already been set up. This is a good place
|
||||
for editing-related settings. @code{mu4e-compose-parent-message} (see above)
|
||||
is also at your disposal.
|
||||
@item @code{mu4e-compose-post-hook}: this hook is run when we're done with
|
||||
message compositions. See the docstring for details.
|
||||
@end itemize
|
||||
|
||||
@noindent
|
||||
Let's look at an examples. As mentioned, @code{mu4e-compose-mode-hook} is especially
|
||||
useful for editing-related settings. For example:
|
||||
As mentioned, @code{mu4e-compose-mode-hook} is especially useful for
|
||||
editing-related settings:
|
||||
|
||||
Let's look at an example:
|
||||
@lisp
|
||||
(add-hook 'mu4e-compose-mode-hook
|
||||
(defun my-do-compose-stuff ()
|
||||
|
@ -1811,7 +1815,7 @@ useful for editing-related settings. For example:
|
|||
(flyspell-mode)))
|
||||
@end lisp
|
||||
|
||||
This hook is also useful for adding headers or changing headers, since the
|
||||
The hook is also useful for adding headers or changing headers, since the
|
||||
message is fully formed when this hook runs. For example, to add a
|
||||
@t{Bcc:}-header, you could add something like the following, using
|
||||
@code{message-add-header} from @code{message-mode}.
|
||||
|
|
Loading…
Reference in New Issue