2011-09-18 13:39:36 +02:00
|
|
|
|
;; mm-send.el -- part of mm, the mu mail user agent
|
|
|
|
|
;;
|
|
|
|
|
;; Copyright (C) 2011 Dirk-Jan C. Binnema
|
|
|
|
|
|
|
|
|
|
;; Author: Dirk-Jan C. Binnema <djcb@djcbsoftware.nl>
|
|
|
|
|
;; Maintainer: Dirk-Jan C. Binnema <djcb@djcbsoftware.nl>
|
|
|
|
|
;; Keywords: email
|
|
|
|
|
;; Version: 0.0
|
|
|
|
|
|
|
|
|
|
;; This file is not part of GNU Emacs.
|
|
|
|
|
;;
|
|
|
|
|
;; GNU Emacs 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.
|
|
|
|
|
|
|
|
|
|
;; GNU Emacs 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 GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
|
|
|
|
|
|
|
|
|
|
;;; Commentary:
|
|
|
|
|
|
|
|
|
|
;; In this file, various functions to compose/send messages, piggybacking on
|
2011-10-10 07:38:14 +02:00
|
|
|
|
;; gnus' message mode
|
2011-09-18 13:39:36 +02:00
|
|
|
|
|
|
|
|
|
;; mm
|
|
|
|
|
|
|
|
|
|
;;; Code:
|
|
|
|
|
|
|
|
|
|
(eval-when-compile (require 'cl))
|
|
|
|
|
|
|
|
|
|
;; we use some stuff from gnus...
|
|
|
|
|
(require 'message)
|
|
|
|
|
(require 'mail-parse)
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
;; internal variables / constants ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
|
(defconst mm/msg-draft-name "*mm-draft*"
|
|
|
|
|
"Name for draft messages.")
|
|
|
|
|
|
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
|
|
|
|
|
|
;; FIXME
|
|
|
|
|
(defun mm/mu-binary-version () "0.98pre")
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(defun mm/msg-user-agent ()
|
|
|
|
|
"Return the User-Agent string for mm. This is either the value
|
|
|
|
|
of `mm/user-agent', or, if not set, a string based on the
|
|
|
|
|
version of mm and emacs."
|
|
|
|
|
(or mm/user-agent
|
|
|
|
|
(format "mu %s; emacs %s" (mm/mu-binary-version) emacs-version)))
|
|
|
|
|
|
|
|
|
|
(defun mm/view-body (msg)
|
|
|
|
|
"Get the body for this message, which is either :body-txt,
|
|
|
|
|
or if not available, :body-html converted to text)."
|
|
|
|
|
(or (plist-get msg :body-txt)
|
|
|
|
|
(with-temp-buffer
|
|
|
|
|
(plist-get msg :body-html)
|
|
|
|
|
(html2text)
|
|
|
|
|
(buffer-string))
|
|
|
|
|
"No body found"))
|
|
|
|
|
|
|
|
|
|
(defun mm/msg-cite-original (msg)
|
|
|
|
|
"Cite the body text of MSG, with a \"On %s, %s wrote:\"
|
|
|
|
|
line (with the %s's replaced with the date of MSG and the name
|
|
|
|
|
or e-mail address of its sender (or 'someone' if nothing
|
|
|
|
|
else)), followed of the quoted body of MSG, constructed by by
|
|
|
|
|
prepending `mm/msg-citation-prefix' to each line. If there is
|
|
|
|
|
no body in MSG, return nil."
|
|
|
|
|
(let* ((from (plist-get msg :from))
|
|
|
|
|
;; first try plain-text, then html
|
|
|
|
|
(body (or (plist-get msg :body-txt)
|
|
|
|
|
(with-temp-buffer
|
|
|
|
|
(plist-get msg :body-html)
|
|
|
|
|
(html2text)
|
|
|
|
|
(buffer-string)))))
|
|
|
|
|
(when body
|
|
|
|
|
(concat
|
|
|
|
|
(format "On %s, %s wrote:"
|
|
|
|
|
(format-time-string "%c" (plist-get msg :date))
|
|
|
|
|
(if (and from (car from)) ;; a list ((<name> . <email>))
|
|
|
|
|
(or (caar from) (cdar from) "someone")
|
|
|
|
|
"someone"))
|
|
|
|
|
"\n\n"
|
|
|
|
|
(replace-regexp-in-string "^" " > " body)))))
|
|
|
|
|
|
|
|
|
|
(defun mm/msg-recipients-remove (lst email-to-remove)
|
|
|
|
|
"Remove the recipient with EMAIL from the recipient list (of form
|
|
|
|
|
'( (\"A\" . \"a@example.com\") (\"B\" . \"B@example.com\"))."
|
|
|
|
|
(remove-if
|
|
|
|
|
(lambda (name-email)
|
|
|
|
|
(let ((email (cdr name-email)))
|
|
|
|
|
(when email (string= email-to-remove (downcase email))))) lst))
|
|
|
|
|
|
|
|
|
|
(defun mm/msg-recipients-to-string (lst)
|
|
|
|
|
"Convert a recipient list (of form '( (\"A\"
|
|
|
|
|
. \"a@example.com\") (\"B\" . \"B@example.com\") (nil
|
|
|
|
|
. \"c@example.com\")) into a string of form \"A <@aexample.com>, B
|
|
|
|
|
<b@example.com>, c@example.com\."
|
|
|
|
|
(mapconcat
|
|
|
|
|
(lambda (recip)
|
|
|
|
|
(let ((name (car recip)) (email (cdr recip)))
|
|
|
|
|
(if name
|
|
|
|
|
(format "%s <%s>" name email)
|
|
|
|
|
(format "%s" email)))) lst ", "))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(defun mm/msg-header (hdr val)
|
|
|
|
|
"Return a header line of the form HDR: VAL\n. If VAL is nil,
|
|
|
|
|
return nil."
|
|
|
|
|
(when val (format "%s: %s\n" hdr val)))
|
|
|
|
|
|
|
|
|
|
(defun mm/msg-references-create (msg)
|
|
|
|
|
"Construct the value of the References: header based on MSG as a
|
|
|
|
|
comma-separated string. Normally, this the concatenation of the
|
|
|
|
|
existing References (which may be empty) and the message-id. If the
|
|
|
|
|
message-id is empty, returns the old References. If both are empty,
|
|
|
|
|
return nil."
|
|
|
|
|
(let ((refs (plist-get msg :references))
|
2011-10-02 20:35:03 +02:00
|
|
|
|
(old-msgid (plist-get msg :message-id)))
|
|
|
|
|
(when old-msgid
|
|
|
|
|
(setq refs (append refs (list old-msgid)))
|
|
|
|
|
(mapconcat
|
|
|
|
|
(lambda (msgid) (format "<%s>" msgid))
|
|
|
|
|
refs ","))))
|
2011-09-18 13:39:36 +02:00
|
|
|
|
|
|
|
|
|
(defun mm/msg-to-create (msg reply-all)
|
|
|
|
|
"Construct the To: header for a reply-message based on some
|
|
|
|
|
message MSG. If REPLY-ALL is nil, this the the Reply-To addresss of
|
|
|
|
|
MSG if it exist, or the From:-address othewise. If reply-all is
|
|
|
|
|
non-nil, the To: is what was in the old To: with either the
|
|
|
|
|
Reply-To: or From: appended, and then the
|
|
|
|
|
receiver (i.e. `user-mail-address') removed.
|
|
|
|
|
|
|
|
|
|
So:
|
|
|
|
|
reply-all nil: Reply-To: or From: of MSG
|
|
|
|
|
reply-all t : Reply-To: or From: of MSG + To: of MSG - `user-mail-address'
|
|
|
|
|
|
|
|
|
|
The result is either nil or a string which can be used for the To:-field."
|
|
|
|
|
(let ((to-lst (plist-get msg :to))
|
|
|
|
|
(reply-to (plist-get msg :reply-to))
|
|
|
|
|
(from (plist-get msg :from)))
|
|
|
|
|
(if reply-all
|
|
|
|
|
(progn ;; reply-all
|
|
|
|
|
(setq to-lst ;; append Reply-To:, or if not set, From: if set
|
2011-11-05 09:26:24 +01:00
|
|
|
|
(if reply-to
|
|
|
|
|
(cons `(nil . ,reply-to) to-lst)
|
|
|
|
|
(if from
|
|
|
|
|
(append to-lst from)
|
2011-09-18 13:39:36 +02:00
|
|
|
|
to-lst)))
|
|
|
|
|
|
|
|
|
|
;; and remove myself from To:
|
|
|
|
|
(setq to-lst (mm/msg-recipients-remove to-lst user-mail-address))
|
|
|
|
|
(mm/msg-recipients-to-string to-lst))
|
|
|
|
|
|
|
|
|
|
;; reply single
|
|
|
|
|
(progn
|
|
|
|
|
(or reply-to (mm/msg-recipients-to-string from))))))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(defun mm/msg-cc-create (msg reply-all)
|
|
|
|
|
"Get the list of Cc-addresses for the reply to MSG. If REPLY-ALL
|
|
|
|
|
is nil this is simply empty, otherwise it is the same list as the
|
|
|
|
|
one in MSG, minus `user-mail-address'. The result of this function
|
|
|
|
|
is either nil or a string to be used for the Cc: field."
|
|
|
|
|
(let ((cc-lst (plist-get msg :cc)))
|
|
|
|
|
(when (and reply-all cc-lst)
|
|
|
|
|
(mm/msg-recipients-to-string
|
2011-11-05 09:26:24 +01:00
|
|
|
|
(mm/msg-recipients-remove cc-lst user-mail-address)))))
|
2011-09-18 13:39:36 +02:00
|
|
|
|
|
|
|
|
|
(defun mm/msg-from-create ()
|
|
|
|
|
"Construct a value for the From:-field of the reply to MSG,
|
|
|
|
|
based on `user-full-name' and `user-mail-address'; if the latter is
|
|
|
|
|
nil, function returns nil."
|
|
|
|
|
(when user-mail-address
|
|
|
|
|
(if user-full-name
|
|
|
|
|
(format "%s <%s>" user-full-name user-mail-address)
|
|
|
|
|
(format "%s" user-mail-address))))
|
|
|
|
|
|
2011-10-02 20:35:03 +02:00
|
|
|
|
(defun mm/msg-create-reply (msg)
|
|
|
|
|
"Create a draft message as a reply to MSG.
|
2011-09-18 13:39:36 +02:00
|
|
|
|
|
|
|
|
|
A reply message has fields:
|
|
|
|
|
From: - see `mu-msg-from-create'
|
|
|
|
|
To: - see `mm/msg-to-create'
|
|
|
|
|
Cc: - see `mm/msg-cc-create'
|
|
|
|
|
Subject: - `mm/msg-reply-prefix' + subject of MSG
|
|
|
|
|
|
|
|
|
|
then, the following fields, normally hidden from user:
|
|
|
|
|
Reply-To: - if `mail-reply-to' has been set
|
|
|
|
|
References: - see `mm/msg-references-create'
|
|
|
|
|
In-Reply-To: - message-id of MSG
|
|
|
|
|
User-Agent - see `mm/msg-user-agent'
|
|
|
|
|
|
2011-09-30 07:37:47 +02:00
|
|
|
|
Then follows `mail-header-separator' (for `message-mode' to separate
|
2011-09-18 13:39:36 +02:00
|
|
|
|
body from headers)
|
|
|
|
|
|
|
|
|
|
And finally, the cited body of MSG, as per `mm/msg-cite-original'."
|
2011-10-02 20:35:03 +02:00
|
|
|
|
(let* ((recipnum (+ (length (plist-get msg :to))
|
|
|
|
|
(length (plist-get msg :cc))))
|
|
|
|
|
(reply-all (when (> recipnum 1)
|
|
|
|
|
(yes-or-no-p
|
|
|
|
|
(format "Reply to all ~%d recipients? "
|
|
|
|
|
(+ recipnum))))))
|
|
|
|
|
(concat
|
|
|
|
|
(mm/msg-header "From" (or (mm/msg-from-create) ""))
|
|
|
|
|
(when (boundp 'mail-reply-to)
|
|
|
|
|
(mm/msg-header "Reply-To" mail-reply-to))
|
2011-09-18 13:39:36 +02:00
|
|
|
|
|
2011-10-02 20:35:03 +02:00
|
|
|
|
(mm/msg-header "To" (or (mm/msg-to-create msg reply-all) ""))
|
|
|
|
|
(mm/msg-header "Cc" (mm/msg-cc-create msg reply-all))
|
2011-09-18 13:39:36 +02:00
|
|
|
|
|
2011-10-02 20:35:03 +02:00
|
|
|
|
(mm/msg-header "User-agent" (mm/msg-user-agent))
|
|
|
|
|
(mm/msg-header "References" (mm/msg-references-create msg))
|
2011-09-18 13:39:36 +02:00
|
|
|
|
|
2011-10-02 20:35:03 +02:00
|
|
|
|
(mm/msg-header "In-reply-to" (format "<%s>" (plist-get msg :message-id)))
|
2011-09-18 13:39:36 +02:00
|
|
|
|
|
2011-10-02 20:35:03 +02:00
|
|
|
|
(mm/msg-header "Subject"
|
|
|
|
|
(concat mm/msg-reply-prefix (plist-get msg :subject)))
|
2011-09-30 07:37:47 +02:00
|
|
|
|
|
2011-10-02 20:35:03 +02:00
|
|
|
|
(propertize mail-header-separator 'read-only t 'intangible t) '"\n"
|
2011-10-10 07:38:14 +02:00
|
|
|
|
|
|
|
|
|
"\n\n"
|
2011-10-02 20:35:03 +02:00
|
|
|
|
(mm/msg-cite-original msg))))
|
2011-09-30 07:37:47 +02:00
|
|
|
|
|
2011-09-18 13:39:36 +02:00
|
|
|
|
;; TODO: attachments
|
|
|
|
|
(defun mm/msg-create-forward (msg)
|
|
|
|
|
"Create a draft forward message for MSG.
|
|
|
|
|
|
|
|
|
|
A forward message has fields:
|
|
|
|
|
From: - see `mm/msg-from-create'
|
|
|
|
|
To: - empty
|
|
|
|
|
Subject: - `mm/msg-forward-prefix' + subject of MSG
|
|
|
|
|
|
|
|
|
|
then, the following fields, normally hidden from user:
|
|
|
|
|
Reply-To: - if `mail-reply-to' has been set
|
|
|
|
|
References: - see `mm/msg-references-create'
|
|
|
|
|
User-Agent - see `mm/msg-user-agent'
|
|
|
|
|
|
2011-09-30 07:37:47 +02:00
|
|
|
|
Then follows `mail-header-separator' (for `message-mode' to separate
|
2011-09-18 13:39:36 +02:00
|
|
|
|
body from headers)
|
|
|
|
|
|
|
|
|
|
And finally, the cited body of MSG, as per `mm/msg-cite-original'."
|
|
|
|
|
(concat
|
2011-09-20 22:59:20 +02:00
|
|
|
|
(mm/msg-header "From" (or (mm/msg-from-create) ""))
|
2011-09-18 13:39:36 +02:00
|
|
|
|
(when (boundp 'mail-reply-to)
|
|
|
|
|
(mm/msg-header "Reply-To" mail-reply-to))
|
|
|
|
|
|
|
|
|
|
(mm/msg-header "To" "")
|
2011-10-02 20:35:03 +02:00
|
|
|
|
(mm/msg-header "User-agent" (mm/msg-user-agent))
|
|
|
|
|
(mm/msg-header "References" (mm/msg-references-create msg))
|
2011-09-30 07:37:47 +02:00
|
|
|
|
(mm/msg-header"Subject"
|
2011-09-18 13:39:36 +02:00
|
|
|
|
(concat mm/msg-forward-prefix (plist-get msg :subject)))
|
2011-09-30 07:37:47 +02:00
|
|
|
|
(propertize mail-header-separator 'read-only t 'intangible t) "\n"
|
2011-09-18 13:39:36 +02:00
|
|
|
|
|
2011-10-10 07:38:14 +02:00
|
|
|
|
"\n\n"
|
2011-09-18 13:39:36 +02:00
|
|
|
|
(mm/msg-cite-original msg)))
|
|
|
|
|
|
|
|
|
|
(defun mm/msg-create-new ()
|
|
|
|
|
"Create a new message.
|
|
|
|
|
|
|
|
|
|
A new draft message has fields:
|
|
|
|
|
From: - see `mu-msg-from-create'
|
|
|
|
|
To: - empty
|
|
|
|
|
Subject: - empty
|
|
|
|
|
|
|
|
|
|
then, the following fields, normally hidden from user:
|
|
|
|
|
Reply-To: - if `mail-reply-to' has been set
|
|
|
|
|
User-Agent - see `mm/msg-user-agent'
|
|
|
|
|
|
2011-09-30 07:37:47 +02:00
|
|
|
|
Then follows `mail-header-separator' (for `message-mode' to separate
|
2011-09-18 13:39:36 +02:00
|
|
|
|
body from headers)."
|
|
|
|
|
(concat
|
|
|
|
|
(mm/msg-header "From" (or (mm/msg-from-create) ""))
|
|
|
|
|
(when (boundp 'mail-reply-to)
|
|
|
|
|
(mm/msg-header "Reply-To" mail-reply-to))
|
|
|
|
|
(mm/msg-header "To" "")
|
2011-10-02 20:35:03 +02:00
|
|
|
|
(mm/msg-header "User-agent" (mm/msg-user-agent))
|
2011-09-18 13:39:36 +02:00
|
|
|
|
(mm/msg-header "Subject" "")
|
2011-09-30 07:37:47 +02:00
|
|
|
|
(propertize mail-header-separator 'read-only t 'intangible t) "\n"))
|
2011-09-18 13:39:36 +02:00
|
|
|
|
|
2011-10-02 20:35:03 +02:00
|
|
|
|
(defun mm/msg-open-draft (compose-type &optional msg)
|
|
|
|
|
"Open a draft file for a new message, creating it if it does not
|
|
|
|
|
already exist, and optionally fill it with STR. Function also adds
|
|
|
|
|
the new message to the database. When the draft message is added to
|
|
|
|
|
the database, `mm/path-docid-map' will be updated, so that we can
|
2011-11-05 09:26:24 +01:00
|
|
|
|
use the new docid. Returns the full path to the new message."
|
|
|
|
|
(let* ((hostname
|
|
|
|
|
(downcase
|
|
|
|
|
(save-match-data
|
|
|
|
|
(substring system-name
|
|
|
|
|
(string-match "^[^.]+" system-name) (match-end 0)))))
|
|
|
|
|
(draft
|
|
|
|
|
(concat mm/maildir mm/drafts-folder "/cur/"
|
|
|
|
|
(format "%s-%x%x.%s:2,D" ;; 'D': rarely used, but hey, it's available
|
|
|
|
|
(format-time-string "%Y%m%d" (current-time))
|
|
|
|
|
(emacs-pid) (random t) hostname)))
|
|
|
|
|
(str (case compose-type
|
|
|
|
|
(reply (mm/msg-create-reply msg))
|
|
|
|
|
(forward (mm/msg-create-forward msg))
|
|
|
|
|
(new (mm/msg-create-new))
|
|
|
|
|
(t (error "unsupported compose-type %S" compose-type)))))
|
2011-10-02 20:35:03 +02:00
|
|
|
|
(when str
|
|
|
|
|
(with-temp-file draft
|
|
|
|
|
(insert str)
|
|
|
|
|
(write-file draft)))
|
|
|
|
|
|
|
|
|
|
;; save our file immediately, add add it to the db; thus, we can retrieve
|
|
|
|
|
;; the new docid from `mm/path-docid-map'.
|
|
|
|
|
(mm/proc-add draft mm/drafts-folder)
|
|
|
|
|
draft))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(defun mm/send-compose-handler (compose-type &optional msg)
|
|
|
|
|
"Create a new draft message, or open an existing one.
|
|
|
|
|
|
|
|
|
|
COMPOSE-TYPE determines the kind of message to compose and is a
|
|
|
|
|
symbol, either `reply', `forward', `edit', `new'. `edit' is for
|
|
|
|
|
editing existing messages.
|
|
|
|
|
|
|
|
|
|
When COMPOSE-TYPE is `reply' or `forward', MSG should be a message
|
|
|
|
|
plist. If COMPOSE-TYPE is `new', MSG should be nil.
|
|
|
|
|
|
|
|
|
|
The name of the draft folder is constructed from the concatenation
|
|
|
|
|
of `mm/maildir' and `mm/drafts-folder' (therefore, these must be
|
|
|
|
|
set).
|
2011-09-18 13:39:36 +02:00
|
|
|
|
|
|
|
|
|
The message file name is a unique name determined by
|
|
|
|
|
`mm/msg-draft-file-name'.
|
|
|
|
|
|
|
|
|
|
The initial STR would be created from either `mm/msg-create-reply',
|
2011-10-02 20:35:03 +02:00
|
|
|
|
ar`mm/msg-create-forward' or `mm/msg-create-new'. The editing buffer is
|
2011-09-18 13:39:36 +02:00
|
|
|
|
using Gnus' `message-mode'."
|
|
|
|
|
(unless mm/maildir (error "mm/maildir not set"))
|
|
|
|
|
(unless mm/drafts-folder (error "mm/drafts-folder not set"))
|
2011-10-02 20:35:03 +02:00
|
|
|
|
(let ((draft
|
|
|
|
|
(if (member compose-type '(reply forward new))
|
|
|
|
|
(mm/msg-open-draft compose-type msg)
|
|
|
|
|
(if (eq compose-type 'edit)
|
|
|
|
|
(plist-get msg :path)
|
|
|
|
|
(error "unsupported compose-type %S" compose-type)))))
|
2011-09-18 13:39:36 +02:00
|
|
|
|
|
2011-10-02 20:35:03 +02:00
|
|
|
|
(unless (file-readable-p draft)
|
|
|
|
|
(error "Cannot read %s" path))
|
2011-10-10 07:38:14 +02:00
|
|
|
|
|
2011-10-02 20:35:03 +02:00
|
|
|
|
(find-file draft)
|
2011-09-18 13:39:36 +02:00
|
|
|
|
(message-mode)
|
|
|
|
|
|
2011-09-30 07:37:47 +02:00
|
|
|
|
(make-local-variable 'write-file-functions)
|
2011-10-02 20:35:03 +02:00
|
|
|
|
|
2011-09-30 07:37:47 +02:00
|
|
|
|
;; update the db when the file is saved...]
|
|
|
|
|
(add-to-list 'write-file-functions
|
|
|
|
|
(lambda() (mm/proc-add (buffer-file-name) mm/drafts-folder)))
|
|
|
|
|
|
2011-09-22 20:01:35 +02:00
|
|
|
|
;; hook our functions up with sending of the message
|
|
|
|
|
(add-hook 'message-sent-hook 'mm/msg-save-to-sent nil t)
|
|
|
|
|
(add-hook 'message-sent-hook 'mm/send-set-parent-flag nil t)
|
2011-09-18 13:39:36 +02:00
|
|
|
|
|
2011-09-30 07:37:47 +02:00
|
|
|
|
(let ((message-hidden-headers
|
|
|
|
|
`("^References:" "^Face:" "^X-Face:" "^X-Draft-From:"
|
|
|
|
|
"^User-agent:")))
|
|
|
|
|
(message-hide-headers))
|
2011-09-18 13:39:36 +02:00
|
|
|
|
|
2011-10-10 07:38:14 +02:00
|
|
|
|
(if (eq compose-type 'new)
|
|
|
|
|
(message-goto-to)
|
|
|
|
|
(message-goto-body))))
|
2011-09-18 13:39:36 +02:00
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(defun mm/msg-save-to-sent ()
|
|
|
|
|
"Move the message in this buffer to the sent folder. This is
|
|
|
|
|
meant to be called from message mode's `message-sent-hook'."
|
2011-09-18 22:57:46 +02:00
|
|
|
|
(unless mm/sent-folder (error "mm/sent-folder not set"))
|
2011-10-02 20:35:03 +02:00
|
|
|
|
(let ((docid (gethash (buffer-file-name) mm/path-docid-map)))
|
2011-09-19 23:20:59 +02:00
|
|
|
|
(unless docid (error "unknown message (%S)" (buffer-file-name)))
|
2011-09-18 22:57:46 +02:00
|
|
|
|
;; ok, all seems well, well move the message to the sent-folder
|
2011-09-19 23:20:59 +02:00
|
|
|
|
(mm/proc-move-msg docid mm/sent-folder "-T-D+S")
|
|
|
|
|
;; we can remove the value from the hash now, if we can establish there
|
|
|
|
|
;; are not other compose buffers using this very same docid...
|
|
|
|
|
|
2011-09-18 22:57:46 +02:00
|
|
|
|
;; mark the buffer as read-only, as its pointing at a non-existing file
|
|
|
|
|
;; now...
|
2011-09-19 23:20:59 +02:00
|
|
|
|
(message "Message has been sent")
|
2011-10-02 20:35:03 +02:00
|
|
|
|
(setq buffer-read-only t)))
|
2011-09-20 22:59:20 +02:00
|
|
|
|
|
2011-09-18 13:39:36 +02:00
|
|
|
|
|
2011-10-03 08:13:58 +02:00
|
|
|
|
|
2011-09-18 13:39:36 +02:00
|
|
|
|
(defun mm/send-set-parent-flag ()
|
|
|
|
|
"Set the 'replied' flag on messages we replied to, and the
|
|
|
|
|
'passed' flag on message we have forwarded.
|
|
|
|
|
|
2011-10-02 20:35:03 +02:00
|
|
|
|
If a message has a 'in-reply-to' header, it is considered a reply
|
|
|
|
|
to the message with the corresponding message id. 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.
|
2011-09-30 07:37:47 +02:00
|
|
|
|
|
2011-10-02 20:35:03 +02:00
|
|
|
|
Now, 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.
|
2011-09-18 13:39:36 +02:00
|
|
|
|
|
|
|
|
|
This is meant to be called from message mode's
|
|
|
|
|
`message-sent-hook'."
|
2011-10-02 20:35:03 +02:00
|
|
|
|
(let ((in-reply-to (message-fetch-field "in-reply-to"))
|
|
|
|
|
(forwarded-from)
|
|
|
|
|
(references (message-fetch-field "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))
|
2011-10-04 07:12:47 +02:00
|
|
|
|
(setq forwarded-from (car-safe (last refs)))))))
|
2011-10-03 08:13:58 +02:00
|
|
|
|
|
|
|
|
|
;; remove the <>
|
|
|
|
|
(when (and in-reply-to (string-match "<\\(.*\\)>" in-reply-to))
|
|
|
|
|
(mm/proc-flag (match-string 1 in-reply-to) "+R"))
|
|
|
|
|
(when (and forwarded-from (string-match "<\\(.*\\)>" forwarded-from))
|
|
|
|
|
(mm/proc-flag (match-string 1 forwarded-from) "+P"))))
|
|
|
|
|
|
2011-09-18 13:39:36 +02:00
|
|
|
|
(provide 'mm-send)
|