diff options
Diffstat (limited to 'lisp')
| -rw-r--r-- | lisp/init-mail.el | 60 |
1 files changed, 39 insertions, 21 deletions
diff --git a/lisp/init-mail.el b/lisp/init-mail.el index 85dae52..c8730d4 100644 --- a/lisp/init-mail.el +++ b/lisp/init-mail.el @@ -92,19 +92,48 @@ is off." (with-current-buffer gnus-summary-buffer (save-window-excursion (gnus-summary-select-article)))) -(defun km/gnus-follow-last-message-link (copy) - "Follow shr link at bottom of message. -With prefix argument COPY, just copy the link." - (interactive "P") - (km/gnus-summary-set-current-article) +(defun km/gnus--last-message-link () (with-current-buffer gnus-article-buffer (save-excursion (goto-char (point-max)) (widget-forward -1) - (if copy - (kill-new (or (get-text-property (point) 'gnus-string) - (get-text-property (point) 'shr-url))) - (widget-button-press (point)))))) + (kill-new (or (get-text-property (point) 'gnus-string) + (get-text-property (point) 'shr-url)))))) + +(defun km/gnus--gmane-link (&optional perma) + (with-current-buffer gnus-original-article-buffer + (-when-let* ((blink (message-field-value "Archived-At")) + (link (or (and (string-match "\\`<\\(.*\\)>\\'" blink) + (match-string 1 blink)) + blink))) + (if perma + link + (replace-regexp-in-string "\\`http://permalink\.gmane\.org/" + "http://thread.gmane.org/" + link))))) + +(defun km/gnus-copy-gmane-link-as-kill (&optional perma) + (interactive "P") + (km/gnus-summary-set-current-article) + (with-current-buffer gnus-original-article-buffer + (--when-let (km/gnus--gmane-link perma) + (kill-new (message it))))) + +(defun km/gnus-copy-message-link (follow) + "Copy link for current message. +If it has an \"Archived-At\" header, use that. Otherwise, get +the link from the last widget in the buffer. With prefix +argument FOLLOW, follow link instead of copying it." + (interactive "P") + (km/gnus-summary-set-current-article) + (with-current-buffer gnus-original-article-buffer + (save-excursion + (--when-let (or (km/gnus--gmane-link) + (km/gnus--last-message-link)) + (funcall (if follow + #'browse-url + (lambda (s) (kill-new (message s)))) + it))))) (defun km/gnus-open-github-patch () "Open patch from github email. @@ -133,17 +162,6 @@ to group buffer instead of moving to next group." (let ((gnus-auto-select-next (unless no-next 'quietly))) (gnus-summary-catchup-and-exit nil t))) -(defun km/gnus-copy-gmane-link-as-kill () - (interactive) - (km/gnus-summary-set-current-article) - (with-current-buffer gnus-original-article-buffer - (save-excursion - (goto-char (point-min)) - (if (re-search-forward "Archived-At: <\\(.*\\)>") - (let ((link (match-string-no-properties 1))) - (kill-new (message "%s" link))) - (user-error "No link found"))))) - (defun km/shr-browse-url-and-goto-next () "Run `shr-browse-url' followed by `shr-next-link'." (interactive) @@ -152,7 +170,7 @@ to group buffer instead of moving to next group." ;; This overrides `gnus-summary-goto-last-article', which is also ;; bound to 'G l'. -(define-key gnus-summary-mode-map "l" 'km/gnus-follow-last-message-link) +(define-key gnus-summary-mode-map "l" 'km/gnus-copy-message-link) (define-key gnus-summary-mode-map ";" 'gnus-summary-universal-argument) ;; This overrides `gnus-summary-post-news', which is also bound to ;; 'S p'. |