From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.io!.POSTED.ciao.gmane.io!not-for-mail From: "Basil L. Contovounesios" Newsgroups: gmane.emacs.bugs Subject: bug#41133: 28.0.50; Respect browse-url user options in shr/eww Date: Fri, 08 May 2020 02:18:17 +0100 Message-ID: <87wo5njkbq.fsf@tcd.ie> Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Injection-Info: ciao.gmane.io; posting-host="ciao.gmane.io:159.69.161.202"; logging-data="73687"; mail-complaints-to="usenet@ciao.gmane.io" User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/28.0.50 (gnu/linux) Cc: lars ingebrigtsen , tassilo horn To: 41133@debbugs.gnu.org Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Fri May 08 03:19:10 2020 Return-path: Envelope-to: geb-bug-gnu-emacs@m.gmane-mx.org Original-Received: from lists.gnu.org ([209.51.188.17]) by ciao.gmane.io with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.92) (envelope-from ) id 1jWrfS-000J3n-7t for geb-bug-gnu-emacs@m.gmane-mx.org; Fri, 08 May 2020 03:19:10 +0200 Original-Received: from localhost ([::1]:43052 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1jWrfQ-0006gu-Sj for geb-bug-gnu-emacs@m.gmane-mx.org; Thu, 07 May 2020 21:19:08 -0400 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]:54796) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1jWrfK-0006gm-Hw for bug-gnu-emacs@gnu.org; Thu, 07 May 2020 21:19:02 -0400 Original-Received: from debbugs.gnu.org ([209.51.188.43]:60885) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1jWrfK-0001Kp-97; Thu, 07 May 2020 21:19:02 -0400 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1jWrfK-00060F-2W; Thu, 07 May 2020 21:19:02 -0400 X-Loop: help-debbugs@gnu.org Resent-From: "Basil L. Contovounesios" Original-Sender: "Debbugs-submit" Resent-CC: larsi@gnus.org, tsdh@gnu.org, bug-gnu-emacs@gnu.org Resent-Date: Fri, 08 May 2020 01:19:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: report 41133 X-GNU-PR-Package: emacs X-GNU-PR-Keywords: patch X-Debbugs-Original-To: bug-gnu-emacs@gnu.org X-Debbugs-Original-Xcc: lars ingebrigtsen , tassilo horn Original-Received: via spool by submit@debbugs.gnu.org id=B.158890070623028 (code B ref -1); Fri, 08 May 2020 01:19:01 +0000 Original-Received: (at submit) by debbugs.gnu.org; 8 May 2020 01:18:26 +0000 Original-Received: from localhost ([127.0.0.1]:44198 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1jWrej-0005zL-CH for submit@debbugs.gnu.org; Thu, 07 May 2020 21:18:26 -0400 Original-Received: from lists.gnu.org ([209.51.188.17]:48330) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1jWreh-0005zC-Kr for submit@debbugs.gnu.org; Thu, 07 May 2020 21:18:24 -0400 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]:54722) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1jWreh-0006eZ-Ev for bug-gnu-emacs@gnu.org; Thu, 07 May 2020 21:18:23 -0400 Original-Received: from mail-wr1-x42c.google.com ([2a00:1450:4864:20::42c]:33892) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1jWref-0000m4-Qw for bug-gnu-emacs@gnu.org; Thu, 07 May 2020 21:18:23 -0400 Original-Received: by mail-wr1-x42c.google.com with SMTP id y3so8664695wrt.1 for ; Thu, 07 May 2020 18:18:21 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=tcd-ie.20150623.gappssmtp.com; s=20150623; h=from:to:subject:date:message-id:user-agent:mime-version; bh=RVtXQSOqfiJnG5UocBWwsKPQoJ7VO7eQPwZcCeMa/HU=; b=fnoKaCek51JVC1VWZR7oWFxF2tmfR+i5JeeE1VdUmcSlQt1MpABcSSiu5RSl0WFlAv vo5yZt/pNaOM13kTRyX4Jiyy3Ug0TjZfOcGkBXg5jBXFmpnmy3JTezW/V0kl07V37mmD tt5yi4J2nHAiGszn4rCEVR9Kb724DYjYNWMAAjM8RZlETZJoQ5sW3I9ZvlpqRdJgEcrc ka6AkPBLYp1Srf+Oydhn+lzgD12Pl8MLKH47D3qjlPc36mJ0eDQ2pOYrCPVb7hRBvAZd jTXufxQsHYj9YMWOd2Gc/9Q8bhM3FKAL9/YqYPvz5NRvSyauroYDMDdkmDBzfizjJ7Z1 lgIA== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20161025; h=x-gm-message-state:from:to:subject:date:message-id:user-agent :mime-version; bh=RVtXQSOqfiJnG5UocBWwsKPQoJ7VO7eQPwZcCeMa/HU=; b=VoEIEwi3uD4/X4gPhLe3zAzV2oS0Y8Ri5d5/vR1L0cjOE85gZGcdZ7ufF90xjgHwTl 522UvR7i6GS87YzF7Dfq0VYpzSK1GyFC+HyvbJD5EHEdeld571v+0ZZ0R/XxCrs8rGY3 oUJEMZnjHiXigGtFAJhkBKqP2JTSOhVhYDlSoTWD/uSp7Lt4N/JsqjnV42uPg8MCMD2Q UzsJjF4nthX6dh8sb+4yD6+f8D4rbsWFPRyAwbAXd6hT2XZf0Pt7p/4XA50JBFkwkfD/ rm/aA7McfoYTO+CmQhhBFkkcaBaDCDxJb0qHaT8NBDgpslhc8TMQLaIQ3Sm24rZv+Egf VUlw== X-Gm-Message-State: AGi0PuZRaRkoakX4srIOt+MoijiADm/4qfwWVhbkWSDNm/7Yi/4AeQND ccKnZIgX1T1MS1q98qxtde8G7VmaSv8= X-Google-Smtp-Source: APiQypK4Az9B7jRvVnUU5vADlYy1unMsZfNlwa94WQ18kmPEjyLgW4wE+5DG8x8w0fl/o5NHoh2ktw== X-Received: by 2002:a5d:4e06:: with SMTP id p6mr17954460wrt.35.1588900699746; Thu, 07 May 2020 18:18:19 -0700 (PDT) Original-Received: from localhost ([2a02:8084:20e2:c380:1f68:7ff5:120d:64e]) by smtp.gmail.com with ESMTPSA id 128sm3125875wme.39.2020.05.07.18.18.18 for (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Thu, 07 May 2020 18:18:18 -0700 (PDT) Received-SPF: none client-ip=2a00:1450:4864:20::42c; envelope-from=contovob@tcd.ie; helo=mail-wr1-x42c.google.com X-detected-operating-system: by eggs.gnu.org: No matching host in p0f cache. That's all we know. X-Spam_score_int: -18 X-Spam_score: -1.9 X-Spam_bar: - X-Spam_report: (-1.9 / 5.0 requ) BAYES_00=-1.9, DKIM_SIGNED=0.1, DKIM_VALID=-0.1, RCVD_IN_DNSWL_NONE=-0.0001, URIBL_BLOCKED=0.001 autolearn=_AUTOLEARN X-Spam_action: no action X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list 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-mx.org@gnu.org Original-Sender: "bug-gnu-emacs" Xref: news.gmane.io gmane.emacs.bugs:179905 Archived-At: --=-=-= Content-Type: text/plain X-Debbugs-Cc: Lars Ingebrigtsen , Tassilo Horn Severity: wishlist Tags: patch The commands shr-browse-url and eww-follow-link currently pass mailto URLs directly to browse-url-mail, which doesn't respect the user options browse-url-handlers and browse-url-mailto-function. Can't/shouldn't the commands call browse-url instead? WDYT of the attached patch that does this? --=-=-= Content-Type: text/x-diff Content-Disposition: attachment; filename=0001-Improve-shr-eww-handling-of-mailto-URLs.patch >From 7a15f9a0a3aad8cae9d4f5da2250ca0ac054c4ee Mon Sep 17 00:00:00 2001 From: "Basil L. Contovounesios" Date: Wed, 6 May 2020 18:02:32 +0100 Subject: [PATCH] Improve shr/eww handling of mailto URLs * lisp/net/eww.el (eww): Use function-put in place of put, as recommended in "(elisp) Symbol Plists". (eww-follow-link): * lisp/net/shr.el (shr-browse-url): Rather than call browse-url-mail directly, call browse-url which respects the user options browse-url-handlers and browse-url-mailto-function. (shr--current-link-region): Return nil if there is no link at point. (shr--blink-link): Adapt accordingly. (shr-fill-line, shr-indent, shr-table-body): Refactor to avoid some unnecessary allocations. --- lisp/net/eww.el | 30 +++++++++--------- lisp/net/shr.el | 84 +++++++++++++++++++++---------------------------- 2 files changed, 52 insertions(+), 62 deletions(-) diff --git a/lisp/net/eww.el b/lisp/net/eww.el index a6c1abdbb1..2a70560ca7 100644 --- a/lisp/net/eww.el +++ b/lisp/net/eww.el @@ -307,10 +307,10 @@ eww (insert (format "Loading %s..." url)) (goto-char (point-min))) (let ((url-mime-accept-string eww-accept-content-types)) - (url-retrieve url 'eww-render + (url-retrieve url #'eww-render (list url nil (current-buffer))))) -(put 'eww 'browse-url-browser-kind 'internal) +(function-put 'eww 'browse-url-browser-kind 'internal) (defun eww--dwim-expand-url (url) (setq url (string-trim url)) @@ -375,8 +375,8 @@ eww-search-words (let ((region-string (buffer-substring (region-beginning) (region-end)))) (if (not (string-match-p "\\`[ \n\t\r\v\f]*\\'" region-string)) (eww region-string) - (call-interactively 'eww))) - (call-interactively 'eww))) + (call-interactively #'eww))) + (call-interactively #'eww))) (defun eww-open-in-new-buffer () "Fetch link at point in a new EWW buffer." @@ -1013,7 +1013,7 @@ eww-reload (eww-display-html 'utf-8 url (plist-get eww-data :dom) (point) (current-buffer))) (let ((url-mime-accept-string eww-accept-content-types)) - (url-retrieve url 'eww-render + (url-retrieve url #'eww-render (list url (point) (current-buffer) encode)))))) ;; Form support. @@ -1576,8 +1576,10 @@ eww-follow-link (cond ((not url) (message "No link under point")) - ((string-match "^mailto:" url) - (browse-url-mail url)) + ((string-match-p "\\`mailto:" url) + ;; This respects the user options `browse-url-handlers' + ;; and `browse-url-mailto-function'. + (browse-url url)) ((and (consp external) (<= (car external) 4)) (funcall browse-url-secondary-browser-function url) (shr--blink-link)) @@ -1615,7 +1617,7 @@ eww-download (eww-current-url)))) (if (not url) (message "No URL under point") - (url-retrieve url 'eww-download-callback (list url))))) + (url-retrieve url #'eww-download-callback (list url))))) (defun eww-download-callback (status url) (unless (plist-get status :error) @@ -2128,12 +2130,12 @@ eww-desktop-misc-data Only the properties listed in `eww-desktop-data-save' are included. Generally, the list should not include the (usually overly large) :dom, :source and :text properties." - (let ((history (mapcar 'eww-desktop-data-1 - (cons eww-data eww-history)))) - (list :history (if eww-desktop-remove-duplicates - (cl-remove-duplicates - history :test 'eww-desktop-history-duplicate) - history)))) + (let ((history (mapcar #'eww-desktop-data-1 + (cons eww-data eww-history)))) + (list :history (if eww-desktop-remove-duplicates + (cl-remove-duplicates + history :test #'eww-desktop-history-duplicate) + history)))) (defun eww-restore-desktop (file-name buffer-name misc-data) "Restore an eww buffer from its desktop file record. diff --git a/lisp/net/shr.el b/lisp/net/shr.el index 1f80ab74db..03260c9e70 100644 --- a/lisp/net/shr.el +++ b/lisp/net/shr.el @@ -135,7 +135,7 @@ shr-content-function This is used for cid: URLs, and the function is called with the cid: URL as the argument.") -(defvar shr-put-image-function 'shr-put-image +(defvar shr-put-image-function #'shr-put-image "Function called to put image and alt string.") (defface shr-strike-through '((t :strike-through t)) @@ -365,25 +365,20 @@ shr-maybe-probe-and-copy-url (shr-copy-url url))) (defun shr--current-link-region () - (let ((current (get-text-property (point) 'shr-url)) - start) - (save-excursion - ;; Go to the beginning. - (while (and (not (bobp)) - (equal (get-text-property (point) 'shr-url) current)) - (forward-char -1)) - (unless (equal (get-text-property (point) 'shr-url) current) - (forward-char 1)) - (setq start (point)) - ;; Go to the end. - (while (and (not (eobp)) - (equal (get-text-property (point) 'shr-url) current)) - (forward-char 1)) - (list start (point))))) + "Return the start and end positions of the URL at point, if any. +Value is a pair of positions (START . END) if there is a non-nil +`shr-url' text property at point; otherwise nil." + (when (get-text-property (point) 'shr-url) + (let* ((end (or (next-single-property-change (point) 'shr-url) + (point-max))) + (beg (or (previous-single-property-change end 'shr-url) + (point-min)))) + (cons beg end)))) (defun shr--blink-link () - (let* ((region (shr--current-link-region)) - (overlay (make-overlay (car region) (cadr region)))) + "Briefly fontify URL at point with the face `shr-selected-link'." + (when-let* ((region (shr--current-link-region)) + (overlay (make-overlay (car region) (cdr region)))) (overlay-put overlay 'face 'shr-selected-link) (run-at-time 1 nil (lambda () (delete-overlay overlay))))) @@ -437,7 +432,7 @@ shr-insert-image (if (not url) (message "No image under point") (message "Inserting %s..." url) - (url-retrieve url 'shr-image-fetched + (url-retrieve url #'shr-image-fetched (list (current-buffer) (1- (point)) (point-marker)) t)))) @@ -463,7 +458,7 @@ shr-zoom-image (when (> (- (point) start) 2) (delete-region start (1- (point))))) (message "Inserting %s..." url) - (url-retrieve url 'shr-image-fetched + (url-retrieve url #'shr-image-fetched (list (current-buffer) (1- (point)) (point-marker) (list (cons 'size (cond ((or (eq size 'default) @@ -493,7 +488,7 @@ shr-indirect-call ((fboundp function) (apply function dom args)) (t - (apply 'shr-generic dom args))))) + (apply #'shr-generic dom args))))) (defun shr-descend (dom) (let ((function @@ -730,9 +725,10 @@ shr-fill-line (let ((gap-start (point)) (face (get-text-property (point) 'face))) ;; Extend the background to the end of the line. - (if face - (insert (propertize "\n" 'face (shr-face-background face))) - (insert "\n")) + (insert ?\n) + (when face + (put-text-property (1- (point)) (point) + 'face (shr-face-background face))) (shr-indent) (when (and (> (1- gap-start) (point-min)) (get-text-property (point) 'shr-url) @@ -935,12 +931,11 @@ shr-ensure-paragraph (defun shr-indent () (when (> shr-indentation 0) - (insert - (if (not shr-use-fonts) - (make-string shr-indentation ?\s) - (propertize " " - 'display - `(space :width (,shr-indentation))))))) + (if (not shr-use-fonts) + (insert-char ?\s shr-indentation) + (insert ?\s) + (put-text-property (1- (point)) (point) + 'display `(space :width (,shr-indentation)))))) (defun shr-fontize-dom (dom &rest types) (let ((start (point))) @@ -987,16 +982,11 @@ shr-browse-url (cond ((not url) (message "No link under point")) - ((string-match "^mailto:" url) - (browse-url-mail url)) + (external + (funcall browse-url-secondary-browser-function url) + (shr--blink-link)) (t - (if external - (progn - (funcall browse-url-secondary-browser-function url) - (shr--blink-link)) - (browse-url url (if new-window - (not browse-url-new-window-flag) - browse-url-new-window-flag))))))) + (browse-url url (xor new-window browse-url-new-window-flag)))))) (defun shr-save-contents (directory) "Save the contents from URL in a file." @@ -1005,7 +995,7 @@ shr-save-contents (if (not url) (message "No link under point") (url-retrieve (shr-encode-url url) - 'shr-store-contents (list url directory))))) + #'shr-store-contents (list url directory))))) (defun shr-store-contents (status url directory) (unless (plist-get status :error) @@ -1156,7 +1146,6 @@ shr-rescale-image ;; url-cache-extract autoloads url-cache. (declare-function url-cache-create-filename "url-cache" (url)) -(autoload 'browse-url-mail "browse-url") (defun shr-get-image-data (url) "Get image data for URL. @@ -1230,7 +1219,7 @@ shr-image-displayer (funcall shr-put-image-function image (buffer-substring start end)) (delete-region (point) end)))) - (url-retrieve url 'shr-image-fetched + (url-retrieve url #'shr-image-fetched (list (current-buffer) start end) t t))))) @@ -1679,7 +1668,7 @@ shr-tag-img (or alt ""))) (insert " ") (url-queue-retrieve - (shr-encode-url url) 'shr-image-fetched + (shr-encode-url url) #'shr-image-fetched (list (current-buffer) start (set-marker (make-marker) (point)) (list :width width :height height)) t @@ -2006,12 +1995,11 @@ shr-table-body (cond ((null tbodies) dom) - ((= (length tbodies) 1) + ((null (cdr tbodies)) (car tbodies)) (t ;; Table with multiple tbodies. Convert into a single tbody. - `(tbody nil ,@(cl-reduce 'append - (mapcar 'dom-non-text-children tbodies))))))) + `(tbody nil ,@(mapcan #'dom-non-text-children tbodies)))))) (defun shr--fix-tbody (tbody) (nconc (list 'tbody (dom-attributes tbody)) @@ -2311,8 +2299,8 @@ shr-table-widths (dolist (column row) (aset natural-widths i (max (aref natural-widths i) column)) (setq i (1+ i))))) - (let ((extra (- (apply '+ (append suggested-widths nil)) - (apply '+ (append widths nil)) + (let ((extra (- (apply #'+ (append suggested-widths nil)) + (apply #'+ (append widths nil)) (* shr-table-separator-pixel-width (1+ (length widths))))) (expanded-columns 0)) ;; We have extra, unused space, so divide this space amongst the -- 2.26.2 --=-=-= Content-Type: text/plain Thanks, -- Basil --=-=-=--