From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!.POSTED!not-for-mail From: npostavs@users.sourceforge.net Newsgroups: gmane.emacs.bugs Subject: bug#26826: user trys to copy spam link but ends up contacting spam site Date: Thu, 11 May 2017 21:14:40 -0400 Message-ID: <877f1mkha7.fsf@users.sourceforge.net> References: <871srz8xvu.fsf@jidanni.org> <877f1pdx6a.fsf@jidanni.org> NNTP-Posting-Host: blaine.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Trace: blaine.gmane.org 1494551656 21406 195.159.176.226 (12 May 2017 01:14:16 GMT) X-Complaints-To: usenet@blaine.gmane.org NNTP-Posting-Date: Fri, 12 May 2017 01:14:16 +0000 (UTC) User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/25.2 (gnu/linux) Cc: 26826@debbugs.gnu.org To: =?UTF-8?Q?=E7=A9=8D=E4=B8=B9=E5=B0=BC?= Dan Jacobson Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Fri May 12 03:14:12 2017 Return-path: Envelope-to: geb-bug-gnu-emacs@m.gmane.org Original-Received: from lists.gnu.org ([208.118.235.17]) by blaine.gmane.org with esmtp (Exim 4.84_2) (envelope-from ) id 1d8z9n-0005Oh-GS for geb-bug-gnu-emacs@m.gmane.org; Fri, 12 May 2017 03:14:11 +0200 Original-Received: from localhost ([::1]:50838 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1d8z9p-0000nf-Vf for geb-bug-gnu-emacs@m.gmane.org; Thu, 11 May 2017 21:14:13 -0400 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:50880) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1d8z9k-0000nU-0q for bug-gnu-emacs@gnu.org; Thu, 11 May 2017 21:14:09 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1d8z9f-0001ZL-26 for bug-gnu-emacs@gnu.org; Thu, 11 May 2017 21:14:08 -0400 Original-Received: from debbugs.gnu.org ([208.118.235.43]:36785) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1d8z9e-0001Yx-SY for bug-gnu-emacs@gnu.org; Thu, 11 May 2017 21:14:02 -0400 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1d8z9e-000567-HG for bug-gnu-emacs@gnu.org; Thu, 11 May 2017 21:14:02 -0400 X-Loop: help-debbugs@gnu.org Resent-From: npostavs@users.sourceforge.net Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Fri, 12 May 2017 01:14:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 26826 X-GNU-PR-Package: emacs X-GNU-PR-Keywords: moreinfo Original-Received: via spool by 26826-submit@debbugs.gnu.org id=B26826.149455159719527 (code B ref 26826); Fri, 12 May 2017 01:14:02 +0000 Original-Received: (at 26826) by debbugs.gnu.org; 12 May 2017 01:13:17 +0000 Original-Received: from localhost ([127.0.0.1]:39462 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1d8z8v-00054o-6v for submit@debbugs.gnu.org; Thu, 11 May 2017 21:13:17 -0400 Original-Received: from mail-it0-f66.google.com ([209.85.214.66]:35355) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1d8z8s-00054T-Cn; Thu, 11 May 2017 21:13:14 -0400 Original-Received: by mail-it0-f66.google.com with SMTP id 67so4708206itx.2; Thu, 11 May 2017 18:13:14 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20161025; h=sender:from:to:cc:subject:references:date:in-reply-to:message-id :user-agent:mime-version; bh=TXk6VGRXMdi+BgViHKMbOpGfHf3hOGBZw3+PC1SuwYo=; b=U47WhbUS3ZYOOz4azk2Ci5wQK7R3i3ip/Rl6tCfhKvBFL/hulQ4sbkflU9VQiOqj4D 5VHrsvJ5bHe0KWmx4UAEdIUI80br0YKYjKKxIXR8afPw4JByesKtq71m9JH63glXTgKd FPlI/2QpgTzTjcM2tPVDXR1BdinxYdZCEjLneQ5rFO+R9DwL107b2Ca//AuNU7hnFLdQ veGUodwn+xl+LM7X0PW0Q8bgF7ANuCe2RVxb37FDQypqb6aFlMBJM+rShw55icQ6D2xW vGQ7n7kKZkadgLhVyWjOqf2jsQxX60kgV3LxrPhTZGBwT7NkvihZJl5AzPsXNEjpH1uH PTew== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20161025; h=x-gm-message-state:sender:from:to:cc:subject:references:date :in-reply-to:message-id:user-agent:mime-version; bh=TXk6VGRXMdi+BgViHKMbOpGfHf3hOGBZw3+PC1SuwYo=; b=mP/P3WrBeUtuYWKhumAhqexF9GoUEuk614m7LpkZ6Y9lCAQDdZeIOptXQ0yTfuvc2B ErGAMv986i+qji8P+6if7m+bVNTY3G3MWpkA00DtuNdMxLIkEwB2SFI5EogDxe1mN3qu IiyJYwqWNfoe0zqk+3SrFw640HQMICqkGQPXPBnKC6VfBjMnXe5ORQjVImUajuTwdOeA trP/1GURa/xbf7SP1ZFII6CNTTxiJJVYT0VT3k3AXuWRAjYrV6xMs7aIdxSE3FVFmoSM ZRT8ANoR4acCo5961jCxe730a/wVb1hEL8UVEscS3gwanNiCLv+couFjLI277/Tnk2qc GBxw== X-Gm-Message-State: AODbwcChZPr+jOxN8qHBoco8/OcirQo2w8tm5a1CPPo/c0A7dGdKww7b WVHO6ylWUIENWzKt X-Received: by 10.36.219.4 with SMTP id c4mr1382308itg.49.1494551588916; Thu, 11 May 2017 18:13:08 -0700 (PDT) Original-Received: from zony ([45.2.7.65]) by smtp.googlemail.com with ESMTPSA id 192sm1913046itl.1.2017.05.11.18.13.07 (version=TLS1_2 cipher=ECDHE-RSA-CHACHA20-POLY1305 bits=256/256); Thu, 11 May 2017 18:13:07 -0700 (PDT) In-Reply-To: <877f1pdx6a.fsf@jidanni.org> ("=?UTF-8?Q?=E7=A9=8D=E4=B8=B9=E5=B0=BC?= Dan Jacobson"'s message of "Wed, 10 May 2017 14:48:45 +0800") X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-Received-From: 208.118.235.43 X-BeenThere: bug-gnu-emacs@gnu.org List-Id: "Bug reports for GNU Emacs, the Swiss army knife of text editors" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Original-Sender: "bug-gnu-emacs" Xref: news.gmane.org gmane.emacs.bugs:132453 Archived-At: --=-=-= Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable tags 26826 =3D patch quit =E7=A9=8D=E4=B8=B9=E5=B0=BC Dan Jacobson 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? --=-=-= Content-Type: text/x-diff Content-Disposition: inline; filename=v1-0001-Split-shr-copy-url-dwim-behavior-into-separate-fu.patch Content-Description: patch >From af9fb0ef26f6624c490d8177599e517ed1799ad5 Mon Sep 17 00:00:00 2001 From: Noam Postavsky 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 --=-=-=--