emacs: Buttonize mid: links

This adds support for RFC 2392 mid: message ID links.
This commit is contained in:
Austin Clements 2012-11-15 14:49:54 -05:00 committed by David Bremner
parent 580997252f
commit 87a05adba3
2 changed files with 40 additions and 13 deletions

View file

@ -1014,23 +1014,44 @@ message at DEPTH in the current thread."
"\\)") "\\)")
"The regexp used to match id: links in messages.") "The regexp used to match id: links in messages.")
(defvar notmuch-mid-regexp
;; goto-address-url-regexp matched cid: links, which have the same
;; grammar as the message ID part of a mid: link. Construct the
;; regexp using the same technique as goto-address-url-regexp.
(concat "\\<mid:\\(" thing-at-point-url-path-regexp "\\)")
"The regexp used to match mid: links in messages.
See RFC 2392.")
(defun notmuch-show-buttonise-links (start end) (defun notmuch-show-buttonise-links (start end)
"Buttonise URLs and mail addresses between START and END. "Buttonise URLs and mail addresses between START and END.
This also turns id:\"<message id>\"-parts into buttons for This also turns id:\"<message id>\"-parts and mid: links into
a corresponding notmuch search." buttons for a corresponding notmuch search."
(goto-address-fontify-region start end) (goto-address-fontify-region start end)
(save-excursion (save-excursion
(goto-char start) (let (links)
(while (re-search-forward notmuch-id-regexp end t) (goto-char start)
;; remove the overlay created by goto-address-mode (while (re-search-forward notmuch-id-regexp end t)
(remove-overlays (match-beginning 0) (match-end 0) 'goto-address t) (push (list (match-beginning 0) (match-end 0)
(make-text-button (match-beginning 0) (match-end 0) (match-string-no-properties 0)) links))
'action `(lambda (arg) (goto-char start)
(notmuch-show ,(match-string-no-properties 0))) (while (re-search-forward notmuch-mid-regexp end t)
'follow-link t (let* ((mid-cid (match-string-no-properties 1))
'help-echo "Mouse-1, RET: search for this message" (mid (save-match-data
'face goto-address-mail-face)))) (string-match "^[^/]*" mid-cid)
(url-unhex-string (match-string 0 mid-cid)))))
(push (list (match-beginning 0) (match-end 0)
(notmuch-id-to-query mid)) links)))
(dolist (link links)
;; Remove the overlay created by goto-address-mode
(remove-overlays (first link) (second link) 'goto-address t)
(make-text-button (first link) (second link)
'action `(lambda (arg)
(notmuch-show ,(third link)))
'follow-link t
'help-echo "Mouse-1, RET: search for this message"
'face goto-address-mail-face)))))
;;;###autoload ;;;###autoload
(defun notmuch-show (thread-id &optional parent-buffer query-context buffer-name) (defun notmuch-show (thread-id &optional parent-buffer query-context buffer-name)

View file

@ -125,7 +125,10 @@ id:\"abc
\" \"
id:) id:)
id: id:
cid:xxx"' cid:xxx
mid:abc mid:abc/def
mid:abc%20def
mid:abc. mid:abc, mid:abc;"'
test_emacs '(notmuch-show "id:'$gen_msg_id'") test_emacs '(notmuch-show "id:'$gen_msg_id'")
(notmuch-test-mark-links) (notmuch-test-mark-links)
(test-visible-output)' (test-visible-output)'
@ -153,6 +156,9 @@ id:"abc
id:) id:)
id: id:
cid:xxx cid:xxx
<<mid:abc>> <<mid:abc/def>>
<<mid:abc%20def>>
<<mid:abc>>. <<mid:abc>>, <<mid:abc>>;
EOF EOF
test_expect_equal_file OUTPUT EXPECTED test_expect_equal_file OUTPUT EXPECTED