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: Fri, 02 Jun 2017 23:40:53 -0400 Message-ID: <87inkd20xm.fsf@users.sourceforge.net> References: <871srz8xvu.fsf@jidanni.org> <877f1pdx6a.fsf@jidanni.org> <877f1mkha7.fsf@users.sourceforge.net> NNTP-Posting-Host: blaine.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Trace: blaine.gmane.org 1496461221 14966 195.159.176.226 (3 Jun 2017 03:40:21 GMT) X-Complaints-To: usenet@blaine.gmane.org NNTP-Posting-Date: Sat, 3 Jun 2017 03:40:21 +0000 (UTC) User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/25.2.50 (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 Sat Jun 03 05:40: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 1dGzv9-0003Oy-U1 for geb-bug-gnu-emacs@m.gmane.org; Sat, 03 Jun 2017 05:40:12 +0200 Original-Received: from localhost ([::1]:52305 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1dGzvF-0002B3-3i for geb-bug-gnu-emacs@m.gmane.org; Fri, 02 Jun 2017 23:40:17 -0400 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:51208) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1dGzv4-00028N-Dr for bug-gnu-emacs@gnu.org; Fri, 02 Jun 2017 23:40:07 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1dGzv1-0000C5-9X for bug-gnu-emacs@gnu.org; Fri, 02 Jun 2017 23:40:06 -0400 Original-Received: from debbugs.gnu.org ([208.118.235.43]:49584) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1dGzv1-0000Bc-3i for bug-gnu-emacs@gnu.org; Fri, 02 Jun 2017 23:40:03 -0400 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1dGzv0-0006QY-2Y for bug-gnu-emacs@gnu.org; Fri, 02 Jun 2017 23:40: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: Sat, 03 Jun 2017 03:40: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: patch Original-Received: via spool by 26826-submit@debbugs.gnu.org id=B26826.149646116424657 (code B ref 26826); Sat, 03 Jun 2017 03:40:02 +0000 Original-Received: (at 26826) by debbugs.gnu.org; 3 Jun 2017 03:39:24 +0000 Original-Received: from localhost ([127.0.0.1]:52260 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1dGzuN-0006Pd-RM for submit@debbugs.gnu.org; Fri, 02 Jun 2017 23:39:24 -0400 Original-Received: from mail-it0-f65.google.com ([209.85.214.65]:33236) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1dGzuL-0006PQ-Pv for 26826@debbugs.gnu.org; Fri, 02 Jun 2017 23:39:22 -0400 Original-Received: by mail-it0-f65.google.com with SMTP id l145so14205877ita.0 for <26826@debbugs.gnu.org>; Fri, 02 Jun 2017 20:39:21 -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=vRIOfFBMES5ya+eKlt5WYoSBOjfKakKTRSIRT+t1Oig=; b=fowGD9tc0TuukFo+bDJfDjhJRC0uCrbQFdgUL/At8odY4gg4Z4VoMPFVGX3mqauPwg 6K7kCQCZW1g/oZ2QmD4NCQpN8xLYjiXB/wda3E8DYjl7RBECiTfPasAb52veMg+iK4EF PELrpMatZj52SnVLiugFn9+qBMs8MCiaEfm9oItiZWobsfHs2BoDjlKzLJCKy6xTCMwD zxmhcMW3vFog21W2KvEmRDpveUcHOFHj7BWZhEFNacka3sGmVxRQY8Qd7cmIuyICPgLt 8yK4A2uVYOfgwCTEnasGbZdnJ+kZy8k0DUcfkeV8m3qfpxlE8wS7xfq8aj4CkUEGKBhd WZ4g== 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=vRIOfFBMES5ya+eKlt5WYoSBOjfKakKTRSIRT+t1Oig=; b=Nm2loLMc8UTvTFNKhMKXN1ExUWPSsS8VlXYCiW7QUap6oUOTplcmA4nKfvFDGk4im+ X+be+9sRXEL+14HCZBdISfPG9r0+6mls6jFn9jF46ApG4OpaMb+vRmjAyF+PQcu6on27 hyOxBfBRwGqGRs1hKTHrUX7m2ewDcOCZMrttvM+Qh5FJHKwOks/IMrCtfY7kELFGl0r2 +v6VhmDo5S0ZWeO+QUId9ZEimp9ML/2TimDHRRi67zlWPmab2gYgSwLp2BslwQGMDuc3 D+OiNO4Tq3tWNh1Z5P1WGFR6gR0pxOUERrV6MEiA84TTjfOE3ddtqneCKshtqGlPwE+0 9uMA== X-Gm-Message-State: AODbwcCwr5gg1ZOC1qw6ZES4pczc8TtoxUJqOLj2wWznztLKsAhEZQ/+ 4rNjktlOfNNIXdjX X-Received: by 10.36.44.201 with SMTP id i192mr2595227iti.21.1496461156114; Fri, 02 Jun 2017 20:39:16 -0700 (PDT) Original-Received: from zony ([45.2.7.65]) by smtp.googlemail.com with ESMTPSA id f19sm10910222ioe.1.2017.06.02.20.39.14 (version=TLS1_2 cipher=ECDHE-RSA-CHACHA20-POLY1305 bits=256/256); Fri, 02 Jun 2017 20:39:15 -0700 (PDT) In-Reply-To: <877f1mkha7.fsf@users.sourceforge.net> (npostavs@users.sourceforge.net's message of "Thu, 11 May 2017 21:14:40 -0400") 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:133206 Archived-At: --=-=-= Content-Type: text/plain npostavs@users.sourceforge.net writes: > 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. Here's a non-broken version of that: --=-=-= Content-Type: text/x-diff Content-Disposition: inline; filename=v2-0001-Split-shr-copy-url-dwim-behavior-into-separate-fu.patch Content-Description: patch >From 7d3f680e204d8525f4d518777f7ace76ce000192 Mon Sep 17 00:00:00 2001 From: Noam Postavsky Date: Thu, 11 May 2017 19:40:45 -0400 Subject: [PATCH v2] 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 | 85 +++++++++++++++++++++++++++++++++------------------------ 1 file changed, 50 insertions(+), 35 deletions(-) diff --git a/lisp/net/shr.el b/lisp/net/shr.el index 2a6b3960c4..749d250022 100644 --- a/lisp/net/shr.el +++ b/lisp/net/shr.el @@ -185,8 +185,8 @@ (defvar 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,58 @@ (defun shr--remove-blank-lines-at-the-end (start 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 cont) + "Pass URL's redirect destination to CONT, if it has one. +CONT should be a function of one argument. If URL is not +redirected, then CONT is never called." (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. + (funcall cont (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))) + (if url (shr-probe-url url #'shr-copy-url) + (shr-copy-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 --=-=-=--