From fcd52c21dc8a1b7d93738fd34aafe9b350b08b9d Mon Sep 17 00:00:00 2001 From: Jameson Graef Rollins Date: Sun, 15 Apr 2012 14:27:48 +1700 Subject: [PATCH] [PATCH v2 2/2] emacs: new mua mailto: URI handler --- f8/7319039ff9b775196c70a636b1b38c13f0d9a1 | 147 ++++++++++++++++++++++ 1 file changed, 147 insertions(+) create mode 100644 f8/7319039ff9b775196c70a636b1b38c13f0d9a1 diff --git a/f8/7319039ff9b775196c70a636b1b38c13f0d9a1 b/f8/7319039ff9b775196c70a636b1b38c13f0d9a1 new file mode 100644 index 000000000..011c8f1c9 --- /dev/null +++ b/f8/7319039ff9b775196c70a636b1b38c13f0d9a1 @@ -0,0 +1,147 @@ +Return-Path: +X-Original-To: notmuch@notmuchmail.org +Delivered-To: notmuch@notmuchmail.org +Received: from localhost (localhost [127.0.0.1]) + by olra.theworths.org (Postfix) with ESMTP id CBFB2429E25 + for ; Sat, 14 Apr 2012 14:27:54 -0700 (PDT) +X-Virus-Scanned: Debian amavisd-new at olra.theworths.org +X-Spam-Flag: NO +X-Spam-Score: -2.3 +X-Spam-Level: +X-Spam-Status: No, score=-2.3 tagged_above=-999 required=5 + tests=[RCVD_IN_DNSWL_MED=-2.3] autolearn=disabled +Received: from olra.theworths.org ([127.0.0.1]) + by localhost (olra.theworths.org [127.0.0.1]) (amavisd-new, port 10024) + with ESMTP id jLhXEnOyG-Hn for ; + Sat, 14 Apr 2012 14:27:52 -0700 (PDT) +Received: from outgoing-mail.its.caltech.edu (outgoing-mail.its.caltech.edu + [131.215.239.19]) + by olra.theworths.org (Postfix) with ESMTP id EBA8F431FAF + for ; Sat, 14 Apr 2012 14:27:51 -0700 (PDT) +Received: from earth-doxen.imss.caltech.edu (localhost [127.0.0.1]) + by earth-doxen-postvirus (Postfix) with ESMTP id BC32166E0123 + for ; Sat, 14 Apr 2012 14:27:51 -0700 (PDT) +X-Spam-Scanned: at Caltech-IMSS on earth-doxen by amavisd-new +Received: from finestructure.net (unknown [76.89.193.65]) + (Authenticated sender: jrollins) + by earth-doxen-submit (Postfix) with ESMTP id 31E5866E0018 + for ; Sat, 14 Apr 2012 14:27:49 -0700 (PDT) +Received: by finestructure.net (Postfix, from userid 1000) + id E17F445D; Sat, 14 Apr 2012 14:27:48 -0700 (PDT) +From: Jameson Graef Rollins +To: Notmuch Mail +Subject: [PATCH v2 2/2] emacs: new mua mailto: URI handler +Date: Sat, 14 Apr 2012 14:27:48 -0700 +Message-Id: <1334438868-17168-1-git-send-email-jrollins@finestructure.net> +X-Mailer: git-send-email 1.7.9.5 +In-Reply-To: <1327865624-7673-2-git-send-email-jrollins@finestructure.net> +References: <1327865624-7673-2-git-send-email-jrollins@finestructure.net> +X-BeenThere: notmuch@notmuchmail.org +X-Mailman-Version: 2.1.13 +Precedence: list +List-Id: "Use and development of the notmuch mail system." + +List-Unsubscribe: , + +List-Archive: +List-Post: +List-Help: +List-Subscribe: , + +X-List-Received-Date: Sat, 14 Apr 2012 21:27:55 -0000 + +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. +--- +Rebased against current master. + + emacs/notmuch-mua.el | 62 ++++++++++++++++++++++++++++++++++++++++++++++++++ + 1 file changed, 62 insertions(+) + +diff --git a/emacs/notmuch-mua.el b/emacs/notmuch-mua.el +index 87bd88d..59b4cf4 100644 +--- a/emacs/notmuch-mua.el ++++ b/emacs/notmuch-mua.el +@@ -26,6 +26,10 @@ + (require 'notmuch-lib) + (require 'notmuch-address) + ++(require 'rfc2368) ++(require 'rfc2047) ++(require 'mailheader) ++ + (eval-when-compile (require 'cl)) + + ;; +@@ -198,6 +202,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 "&" "&" 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.9.5 + -- 2.26.2