[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
bug#26826: user trys to copy spam link but ends up contacting spam site
From: |
npostavs |
Subject: |
bug#26826: user trys to copy spam link but ends up contacting spam site |
Date: |
Thu, 11 May 2017 21:14:40 -0400 |
User-agent: |
Gnus/5.13 (Gnus v5.13) Emacs/25.2 (gnu/linux) |
tags 26826 = patch
quit
積丹尼 Dan Jacobson <jidanni@jidanni.org> writes:
> Have the dangerous commands mapped to a different key,
> not piggybacked on a usually safe key.
Here's a patch to split out dwim behaviour into separate commands. I'm
not sure if we should favour safety or convenience for the default
keybindings. Thoughts, anyone?
>From af9fb0ef26f6624c490d8177599e517ed1799ad5 Mon Sep 17 00:00:00 2001
From: Noam Postavsky <npostavs@gmail.com>
Date: Thu, 11 May 2017 19:40:45 -0400
Subject: [PATCH v1] Split shr-copy-url dwim behavior into separate functions
(Bug#26826)
* lisp/net/shr.el (shr-url-at-point, shr-probe-url)
(shr-probe-and-copy-url, shr-maybe-probe-and-copy-url): New functions,
split out from `shr-copy-url'.
(shr-copy-url): Only copy the url, don't fetch it.
(shr-map): Bind 'w' and 'u' to `shr-maybe-probe-and-copy-url', which
has the same behavior as the old `shr-copy-url'.
---
lisp/net/shr.el | 81 ++++++++++++++++++++++++++++++++-------------------------
1 file changed, 46 insertions(+), 35 deletions(-)
diff --git a/lisp/net/shr.el b/lisp/net/shr.el
index 6b62a05227..2a9283680c 100644
--- a/lisp/net/shr.el
+++ b/lisp/net/shr.el
@@ -185,8 +185,8 @@ shr-map
(define-key map [follow-link] 'mouse-face)
(define-key map [mouse-2] 'shr-browse-url)
(define-key map "I" 'shr-insert-image)
- (define-key map "w" 'shr-copy-url)
- (define-key map "u" 'shr-copy-url)
+ (define-key map "w" 'shr-maybe-probe-and-copy-url)
+ (define-key map "u" 'shr-maybe-probe-and-copy-url)
(define-key map "v" 'shr-browse-url)
(define-key map "O" 'shr-save-contents)
(define-key map "\r" 'shr-browse-url)
@@ -290,43 +290,54 @@ shr--remove-blank-lines-at-the-end
(forward-line 1)
(delete-region (point) (point-max))))))
-(defun shr-copy-url (&optional image-url)
+(defun shr-url-at-point (image-url)
+ "Return the URL under point as a string.
+If IMAGE-URL is non-nil, or there is no link under point, but
+there is an image under point then copy the URL of the image
+under point instead."
+ (if image-url
+ (get-text-property (point) 'image-url)
+ (or (get-text-property (point) 'shr-url)
+ (get-text-property (point) 'image-url))))
+
+(defun shr-copy-url (url)
"Copy the URL under point to the kill ring.
If IMAGE-URL (the prefix) is non-nil, or there is no link under
point, but there is an image under point then copy the URL of the
-image under point instead.
-If called twice, then try to fetch the URL and see whether it
-redirects somewhere else."
+image under point instead."
+ (interactive (list (shr-url-at-point current-prefix-arg)))
+ (if (not url)
+ (message "No URL under point")
+ (setq url (url-encode-url url))
+ (kill-new url)
+ (message "Copied %s" url)))
+
+(defun shr-probe-url (url)
+ "Return URL's redirect destination, if it has one."
(interactive "P")
- (let ((url (if image-url
- (get-text-property (point) 'image-url)
- (or (get-text-property (point) 'shr-url)
- (get-text-property (point) 'image-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)))))
- nil t))
- ;; Copy the URL to the kill ring.
- (t
- (with-temp-buffer
- (insert (url-encode-url url))
- (copy-region-as-kill (point-min) (point-max))
- (message "Copied %s" (buffer-string)))))))
+ (url-retrieve url
+ (lambda (a)
+ (pcase a
+ (`(:redirect ,destination)
+ ;; Remove common tracking junk from the URL.
+ (replace-regexp-in-string ".utm_.*" "" destination))))
+ nil t))
+
+(defun shr-probe-and-copy-url (url)
+ "Copy the URL under point to the kill ring.
+Like `shr-copy-url', but additionally fetch URL and use its
+redirection destination if it has one."
+ (interactive (list (shr-url-at-point current-prefix-arg)))
+ (shr-copy-url (or (if url (shr-probe-url url)) url)))
+
+(defun shr-maybe-probe-and-copy-url (url)
+ "Copy the URL under point to the kill ring.
+If the URL is already at the front of the kill ring act like
+`shr-probe-and-copy-url', otherwise like `shr-copy-url'."
+ (interactive (list (shr-url-at-point current-prefix-arg)))
+ (if (equal url (car kill-ring))
+ (shr-probe-and-copy-url url)
+ (shr-copy-url url)))
(defun shr-next-link ()
"Skip to the next link."
--
2.11.1