+(defun shr-browse-url ()
+ "Browse the URL under point."
+ (interactive)
+ (let ((url (get-text-property (point) 'shr-url)))
+ (if (not url)
+ (message "No link under point")
+ (browse-url url))))
+
+(defun shr-copy-url ()
+ "Copy the URL under point to the kill ring.
+If called twice, then try to fetch the URL and see whether it
+redirects somewhere else."
+ (interactive)
+ (let ((url (get-text-property (point) 'shr-url)))
+ (cond
+ ((not url)
+ (message "No URL under point"))
+ ;; Resolve redirected URLs.
+ ((equal url (car kill-ring))
+ (url-retrieve
+ url
+ (lambda (a)
+ (when (and (consp a)
+ (eq (car a) :redirect))
+ (with-temp-buffer
+ (insert (cadr a))
+ (goto-char (point-min))
+ ;; Remove common tracking junk from the URL.
+ (when (re-search-forward ".utm_.*" nil t)
+ (replace-match "" t t))
+ (message "Copied %s" (buffer-string))
+ (copy-region-as-kill (point-min) (point-max)))))))
+ ;; Copy the URL to the kill ring.
+ (t
+ (with-temp-buffer
+ (insert url)
+ (copy-region-as-kill (point-min) (point-max))
+ (message "Copied %s" url))))))