From b5ea24cb44a34ee433a6212d9791fe7aff711d3d Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Thu, 6 Aug 2020 14:50:40 +0200 Subject: [PATCH] Make it possible to use Message as a mailto: desktop handler * doc/misc/message.texi (System Mailer Setup): Document the usage. * lisp/gnus/gnus-art.el (gnus-url-mailto): Move most of the code here to 'message-mailto-1' (bug#38314). * lisp/gnus/message.el (message-parse-mailto-url): Mark as obsolete. (message-parse-mailto-url): Rewritten slightly from the above. (message-mailto): New command. (message-mailto-1): New function. --- doc/misc/message.texi | 24 ++++++++++++++++++ etc/NEWS | 10 ++++++++ etc/emacs-mail.desktop | 20 +++++++++++++++ lisp/gnus/gnus-art.el | 28 +++------------------ lisp/gnus/message.el | 57 ++++++++++++++++++++++++++++++++++++++++++ 5 files changed, 114 insertions(+), 25 deletions(-) create mode 100644 etc/emacs-mail.desktop diff --git a/doc/misc/message.texi b/doc/misc/message.texi index 7a66422b17e..c9a466eae9f 100644 --- a/doc/misc/message.texi +++ b/doc/misc/message.texi @@ -99,6 +99,7 @@ sending it. * Resending:: Resending a mail message. * Bouncing:: Bouncing a mail message. * Mailing Lists:: Send mail to mailing lists. +* System Mailer Setup:: Using Message as the system mailer. @end menu You can customize the Message Mode tool bar, see @kbd{M-x @@ -529,6 +530,29 @@ It is considered good netiquette to honor MFT, as it is assumed the fellow who posted a message knows where the followups need to go better than you do. + +@node System Mailer Setup +@section System Mailer Setup +@cindex mailto: + +Emacs can be set up as the system mailer, so that Emacs is opened when +you click on @samp{mailto:} links in other programs. + +How this is done varies from system to system, but commonly there's a +way to set the default application for a @acronym{MIME} type, and the +relevant type here is @samp{x-scheme-handler/mailto;}. + +The application to start should be @samp{"emacs -f message-mailto %u"}. +This will start Emacs, and then run the @code{message-mailto} +command. It will parse the given @acronym{URL}, and set up a Message +buffer with the given parameters. + +For instance, @samp{mailto:larsi@@gnus.org;subject=This+is+a+test} +will open a Message buffer with the @samp{To:} header filled in with +@samp{"larsi@@gnus.org"} and the @samp{Subject:} header with +@samp{"This is a test"}. + + @node Commands @chapter Commands diff --git a/etc/NEWS b/etc/NEWS index cbb1842e139..2df7bac9d73 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -236,6 +236,16 @@ not. ** Message ++++ +*** New function to start Emacs in Message mode to send an email. +Emacs can be defined as a handler for the "x-scheme-handler/mailto" +MIME type with the following command: "emacs -f message-mailto %u". +An emacs-mail.desktop file has been included, suitable for installing +in desktop directories like /usr/share/applications. Clicking on a +mailto: link in other applications will then open Emacs with headers +filled out according to the link, e.g. +"mailto:larsi@gnus.org;subject=This+is+a+test". + --- *** Change to default value of 'message-draft-headers' user option. The 'Date' symbol has been removed from the default value, meaning that diff --git a/etc/emacs-mail.desktop b/etc/emacs-mail.desktop new file mode 100644 index 00000000000..dec6cdb3459 --- /dev/null +++ b/etc/emacs-mail.desktop @@ -0,0 +1,20 @@ +Desktop Entry] +Categories=Network;Email; +Comment=GNU Emacs is an extensible, customizable text editor - and more +Exec=/home/larsi/src/emacs/trunk/src/emacs -f message-mailto %u +Icon=emacs +Name=Emacs (Mail) +MimeType=x-scheme-handler/mailto; +NoDisplay=false +Terminal=false +Type=Application +Desktop Entry] +Categories=Network;Email; +Comment=GNU Emacs is an extensible, customizable text editor - and more +Exec=emacs -f message-mailto %u +Icon=emacs +Name=Emacs (Mail) +MimeType=x-scheme-handler/mailto; +NoDisplay=false +Terminal=false +Type=Application diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index d33539bc7f7..1be8c48bcfc 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el @@ -8341,6 +8341,7 @@ url is put as the `gnus-button-url' overlay property on the button." (and (match-end 6) (list (string-to-number (match-string 6 address)))))))) (defun gnus-url-parse-query-string (query &optional downcase) + (declare (obsolete message-parse-mailto-url "28.1")) (let (retval pairs cur key val) (setq pairs (split-string query "&")) (while pairs @@ -8360,31 +8361,8 @@ url is put as the `gnus-button-url' overlay property on the button." (defun gnus-url-mailto (url) ;; Send mail to someone - (setq url (replace-regexp-in-string "\n" " " url)) - (when (string-match "mailto:/*\\(.*\\)" url) - (setq url (substring url (match-beginning 1) nil))) - (let* ((args (gnus-url-parse-query-string - (if (string-match "^\\?" url) - (substring url 1) - (if (string-match "^\\([^?]+\\)\\?\\(.*\\)" url) - (concat "to=" (match-string 1 url) "&" - (match-string 2 url)) - (concat "to=" url))))) - (subject (cdr-safe (assoc "subject" args))) - func) - (gnus-msg-mail) - (while args - (setq func (intern-soft (concat "message-goto-" (downcase (caar args))))) - (if (fboundp func) - (funcall func) - (message-position-on-field (caar args))) - (insert (replace-regexp-in-string - "\r\n" "\n" - (mapconcat #'identity (reverse (cdar args)) ", ") nil t)) - (setq args (cdr args))) - (if subject - (message-goto-body) - (message-goto-subject)))) + (gnus-msg-mail) + (message-mailto-1 url)) (defun gnus-button-embedded-url (address) "Activate ADDRESS with `browse-url'." diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index cf2b8eebc30..71ab63de39e 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -8708,6 +8708,63 @@ used to take the screenshot." (insert "\n\n") (message ""))) +(declare-function gnus-url-unhex-string "gnus-util") + +(defun message-parse-mailto-url (url) + "Parse a mailto: url." + (setq url (replace-regexp-in-string "\n" " " url)) + (when (string-match "mailto:/*\\(.*\\)" url) + (setq url (substring url (match-beginning 1) nil))) + (setq url (if (string-match "^\\?" url) + (substring url 1) + (if (string-match "^\\([^?]+\\)\\?\\(.*\\)" url) + (concat "to=" (match-string 1 url) "&" + (match-string 2 url)) + (concat "to=" url)))) + (let (retval pairs cur key val) + (setq pairs (split-string url "&")) + (while pairs + (setq cur (car pairs) + pairs (cdr pairs)) + (if (not (string-match "=" cur)) + nil ; Grace + (setq key (downcase (gnus-url-unhex-string + (substring cur 0 (match-beginning 0)))) + val (gnus-url-unhex-string (substring cur (match-end 0) nil) t)) + (setq cur (assoc key retval)) + (if cur + (setcdr cur (cons val (cdr cur))) + (setq retval (cons (list key val) retval))))) + retval)) + +;;;###autoload +(defun message-mailto () + "Function to be run to parse command line mailto: links. +This is meant to be used for MIME handlers: Setting the handler +for \"x-scheme-handler/mailto;\" to \"emacs -fn message-mailto %u\" +will then start up Emacs ready to compose mail." + (interactive) + ;; Send email + (message-mail) + (message-mailto-1 (car command-line-args-left)) + (setq command-line-args-left (cdr command-line-args-left))) + +(defun message-mailto-1 (url) + (let ((args (message-parse-mailto-url url))) + (dolist (arg args) + (unless (equal (car arg) "body") + (message-position-on-field (capitalize (car arg))) + (insert (replace-regexp-in-string + "\r\n" "\n" + (mapconcat #'identity (reverse (cdr arg)) ", ") nil t)))) + (when (assoc "body" args) + (message-goto-body) + (dolist (body (cdr (assoc "body" args))) + (insert body "\n"))) + (if (assoc "subject" args) + (message-goto-body) + (message-goto-subject)))) + (provide 'message) (run-hooks 'message-load-hook) -- 2.39.2