From: Jameson Graef Rollins <jrollins@finestructure.net>
To: Notmuch Mail <notmuch@notmuchmail.org>
Subject: [PATCH 2/2] emacs: new mua mailto: URI handler
Date: Sun, 29 Jan 2012 11:33:44 -0800
Message-Id: <1327865624-7673-2-git-send-email-jrollins@finestructure.net>
In-Reply-To: <1327865624-7673-1-git-send-email-jrollins@finestructure.net>
References: <1327865624-7673-1-git-send-email-jrollins@finestructure.net>
Precedence: list

The new function 'notmuch-mua-mailto' provides an interactive handler
for rfc6068 "mailto:" URIs.  It attempts to implement the rfc6068
specification: http://tools.ietf.org/html/rfc6068

More decoding of the mailto string needs to be done, as is evident by
the fact that the mailto test remains broken.
---
Unfortunately I'm not sure how best to do the URI decoding, so I've
left a FIXME in the code, and the test as known_broken.  I'm hoping an
elisp/encodings expert out there will pick this up.

 emacs/notmuch-mua.el |   62 ++++++++++++++++++++++++++++++++++++++++++++++++++
 1 files changed, 62 insertions(+), 0 deletions(-)

diff --git a/emacs/notmuch-mua.el b/emacs/notmuch-mua.el
index 023645e..750e8d6 100644
--- a/emacs/notmuch-mua.el
+++ b/emacs/notmuch-mua.el
@@ -24,6 +24,10 @@
 (require 'notmuch-lib)
 (require 'notmuch-address)
 
+(require 'rfc2368)
+(require 'rfc2047)
+(require 'mailheader)
+
 ;;
 
 (defcustom notmuch-mua-send-hook '(notmuch-mua-message-send-hook)
@@ -131,6 +135,64 @@ list."
 
   (message-goto-to))
 
+(defun notmuch-mua-mailto (mailto)
+  "Invoke the notmuch mail composition window for a `mailto:' URI."
+  ;; this should implement implement rfc6068: http://tools.ietf.org/html/rfc6068
+  ;; which obsoleted: http://tools.ietf.org/html/rfc2368
+  ;; this function is based on previous work: http://www.emacswiki.org/emacs/MailtoHandler
+  (interactive)
+  (when (and (stringp mailto)
+	     (string-match "\\`mailto:" mailto))
+    (let* (
+	   ;; FIXME: need to decode all html encodings in uri.
+	   (mailto (replace-regexp-in-string "&amp;" "&" mailto))
+	   (hdr-alist (rfc2368-parse-mailto-url mailto))
+	   to subject other-headers body
+	   (allowed-xtra-hdrs '(cc bcc in-reply-to)))
+
+      (with-temp-buffer
+	;; extract body if it's defined
+	(when (assoc "Body" hdr-alist)
+	  (dolist (hdr hdr-alist)
+	    (when (equal "Body" (car hdr))
+	      (insert (format "%s\n" (cdr hdr)))))
+	  (rfc2047-decode-region (point-min) (point-max))
+	  (setq body (buffer-substring-no-properties
+		      (point-min) (point-max)))
+	  (erase-buffer))
+
+	;; extract headers
+	(dolist (hdr hdr-alist)
+	  (unless (equal "Body" (car hdr))
+	    (insert (format "%s: %s\n" (car hdr) (cdr hdr)))))
+	(rfc2047-decode-region (point-min) (point-max))
+	(goto-char (point-min))
+	(setq hdr-alist (mail-header-extract-no-properties)))
+
+      (setq to (cdr (assoc 'to hdr-alist)))
+      (setq subject (cdr (assoc 'subject hdr-alist)))
+
+      ;; extract allowed other headers, taking only first defined
+      ;; value
+      (dolist (hdr hdr-alist)
+	(if (and (member (car hdr) allowed-xtra-hdrs)
+		 (not (assoc (car hdr) other-headers)))
+	    (add-to-list 'other-headers hdr)))
+
+      (notmuch-mua-mail to subject other-headers)
+
+      ;; insert the message body - but put it in front of the signature
+      ;; if one is present
+      (goto-char (point-max))
+      (if (re-search-backward message-signature-separator nil t)
+	  (forward-line -1)
+	(goto-char (point-max)))
+      (insert body)
+      (push-mark))
+    (set-buffer-modified-p nil)
+
+    (message-goto-body)))
+
 (defun notmuch-mua-mail (&optional to subject other-headers &rest other-args)
   "Invoke the notmuch mail composition window.
 
-- 
1.7.8.3