* message.el (message-mailto): New function.

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index c956bff..52f4e56 100644 (file)
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,7 @@
+2010-11-08  Lars Magne Ingebrigtsen  <larsi@gnus.org>
+
+       * message.el (message-mailto): New function.
+
 2010-11-07  Lars Magne Ingebrigtsen  <larsi@gnus.org>
 
        * gnus-start.el (gnus-get-unread-articles): Ignore totally non-existent

diff --git a/lisp/message.el b/lisp/message.el
index 9b5f63c..4de2c20 100644 (file)
--- a/lisp/message.el
+++ b/lisp/message.el
@@ -6551,6 +6551,31 @@ is a function used to switch to and display the mail buffer."
     ;; FIXME: Should return nil if failure.
     t))
 
+;;;###autoload
+(defun message-mailto (url)
+  "Send a mail message to URL.
+The URL should be on the form \"mailto:<address>?params\"."
+  (when (string-match "\\`mailto:" url)
+    (setq url (substring url (match-end 0)))
+    (let (to args)
+      (if (string-match "\\?" url)
+         (setq to (substring url 0 (match-beginning 0))
+               args (substring url (match-end 0)))
+       (setq to url))
+      (if (not args)
+         (message-mail to)
+       (let ((pairs
+              (mapcar (lambda (elem)
+                        (let ((key-val (split-string elem "=")))
+                          (list (capitalize (car key-val))
+                                (cadr key-val))))
+                      (split-string args "&")))
+             subject)
+         (when (setq subject (assoc "Subject" pairs))
+           (setq pairs (delq subject pairs)
+                 subject (cadr subject)))
+         (message-mail to subject pairs))))))
+
 ;;;###autoload
 (defun message-news (&optional newsgroups subject)
   "Start editing a news article to be sent."