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: Sun, 10 May 2020 01:05:55 +0100 Message-ID: <87y2q08xi4.fsf@tcd.ie> References: <87wo5njkbq.fsf@tcd.ie> <83368bj5jl.fsf@gnu.org> <873689utkw.fsf@tcd.ie> <83a72hfcnn.fsf@gnu.org> 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="109152"; mail-complaints-to="usenet@ciao.gmane.io" User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/28.0.50 (gnu/linux) Cc: larsi@gnus.org, 41133@debbugs.gnu.org, tsdh@gnu.org To: Eli Zaretskii Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Sun May 10 02:07:14 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 1jXZUv-000SHl-QF for geb-bug-gnu-emacs@m.gmane-mx.org; Sun, 10 May 2020 02:07:14 +0200 Original-Received: from localhost ([::1]:35258 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1jXZUu-0008Ot-95 for geb-bug-gnu-emacs@m.gmane-mx.org; Sat, 09 May 2020 20:07:12 -0400 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]:54896) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1jXZUk-0008OW-R6 for bug-gnu-emacs@gnu.org; Sat, 09 May 2020 20:07:02 -0400 Original-Received: from debbugs.gnu.org ([209.51.188.43]:37050) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1jXZUk-00069Z-IA for bug-gnu-emacs@gnu.org; Sat, 09 May 2020 20:07:02 -0400 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1jXZUk-00065P-BI for bug-gnu-emacs@gnu.org; Sat, 09 May 2020 20:07:02 -0400 X-Loop: help-debbugs@gnu.org Resent-From: "Basil L. Contovounesios" Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Sun, 10 May 2020 00:07:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 41133 X-GNU-PR-Package: emacs X-GNU-PR-Keywords: patch Original-Received: via spool by 41133-submit@debbugs.gnu.org id=B41133.158906916623323 (code B ref 41133); Sun, 10 May 2020 00:07:02 +0000 Original-Received: (at 41133) by debbugs.gnu.org; 10 May 2020 00:06:06 +0000 Original-Received: from localhost ([127.0.0.1]:48596 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1jXZTp-000647-UW for submit@debbugs.gnu.org; Sat, 09 May 2020 20:06:06 -0400 Original-Received: from mail-wr1-f41.google.com ([209.85.221.41]:45475) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1jXZTo-00063b-3L for 41133@debbugs.gnu.org; Sat, 09 May 2020 20:06:04 -0400 Original-Received: by mail-wr1-f41.google.com with SMTP id v12so6301326wrp.12 for <41133@debbugs.gnu.org>; Sat, 09 May 2020 17:06:04 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=tcd-ie.20150623.gappssmtp.com; s=20150623; h=from:to:cc:subject:references:date:in-reply-to:message-id :user-agent:mime-version; bh=MSDXPUEcYTZXzRAhmGSu+w592MK2MrhZ2Zku9oK0xoE=; b=0ar2ZkQs+rIzeqd37ygROCwWOCJXQV/cGa1g0u21BQ0zkDJWNrEd3jzHqRO4mrjHXa oM1FGwRL0CILTgt05gqYkcbH0Im48CIKNxiqohtQvVlPF04Ys9NH8NMsReSXO9m6x5jU aFhOs3qXeuU6yXcpk6ND+NL8P0yI85Wb+mM561XqoCGiENwIxevWQrnErOln6BAbouMN JO0OYtt/ZwZw0tVPbo7bivzTNXydBt24gmqiKWDqbcDfffgNkveazaqxcG1DTQQsk7Mm FLE7noz80OeeCjKJhze49hdDLZ8EzVJoQv7UwmZoWgXHQdzXjcfkQB/an7yIyD4ossm9 zLxA== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20161025; h=x-gm-message-state:from:to:cc:subject:references:date:in-reply-to :message-id:user-agent:mime-version; bh=MSDXPUEcYTZXzRAhmGSu+w592MK2MrhZ2Zku9oK0xoE=; b=RiMF14VBb3Mnj6HWNz0OrvKTqGg/R8DTmtEcZvy3/4ZywjzchWMqJeNxE5oBiW83D2 AgEYfuXO748qaSbG6zh3U2NaEncDFs64UpKL/a+mk2vJIouRDHwEvp3TB45ifgARZd7O dYEKD7q+S27FWx/Z29CvYJ8sUi4Htc8j5A4nFatOFHuq/JHKpPkCQfOjqbgjSnteyW8I +DqYrqFPR7kFxNPPxE6ptmaKvCODGc5llvqlCJUFELM9cQyUMti2YPA4Q9UTk4lA+26f jC2xfbbwvVSNv6Ncyfa4j6dQSeKuE+ltbptE7MsRv3pzPGp1pxgrEEU5Mslz3gMCdQfq NT4g== X-Gm-Message-State: AGi0PubYszpUtxxVFBzt+QruhvA2bcmDvTKEE/AWtiwKIwMHNsWJTL3s HHPeS55aSDPaddSf3jH0QPmk5w== X-Google-Smtp-Source: APiQypLdnM4oqs2zGSnN3pOLIDfrFQ09DamX2vyo2V2IfKIJJlN5EiU4PDiOIEUKB/d3yfZvykf6zA== X-Received: by 2002:a5d:4f10:: with SMTP id c16mr10095492wru.243.1589069158165; Sat, 09 May 2020 17:05:58 -0700 (PDT) Original-Received: from localhost ([2a02:8084:20e2:c380:1f68:7ff5:120d:64e]) by smtp.gmail.com with ESMTPSA id z7sm10413407wrl.88.2020.05.09.17.05.56 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Sat, 09 May 2020 17:05:57 -0700 (PDT) In-Reply-To: <83a72hfcnn.fsf@gnu.org> (Eli Zaretskii's message of "Sat, 09 May 2020 16:42:04 +0300") 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:179986 Archived-At: --=-=-= Content-Type: text/plain Eli Zaretskii writes: >> ++++ >> +*** The command 'shr-browse-url' now supports custom mailto handlers. >> +Clicking on or otherwise following a 'mailto:' link in a HTML buffer >> +rendered by SHR previously invoked the command 'browse-url-mailto'. >> +This is still the case by default, but which function is invoked can >> +now be customized via the user options 'browse-url-mailto-function' >> +and 'browse-url-handlers'. > > I'd rephrase the last sentence like this: > > This is still the case by default, but if you customized > 'browse-url-mailto-function' to call some other function, it will > now be called instead of the default. Should it not also mention browse-url-handlers as per the attached? > Also, the "+++" means the change is documented in some manual, but no > changes for the manual are part of the patch, so I guess you meant > "---" instead. Oops, I misremembered "+++" as meaning "all necessary doc changes made" instead of just "doc changes made". >> +** EWW >> + >> ++++ >> +*** The command 'eww-follow-link' now supports custom mailto handlers. >> +Clicking on or otherwise following a 'mailto:' link in an EWW buffer >> +previously invoked the command 'browse-url-mailto'. This is still the >> +case by default, but which function is invoked can now be customized >> +via the user options 'browse-url-mailto-function' and >> +'browse-url-handlers'. > > Maybe we should point to the SHR entry instead of repeating almost the > same text. Sure, how's this? --=-=-= Content-Type: text/x-diff Content-Disposition: attachment; filename=0001-Improve-shr-eww-handling-of-mailto-URLs.patch >From 6ab52e1f5c13a231199045acac8f42fca40cb4d5 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. (Bug#41133) (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. * etc/NEWS: Announce that eww-follow-link and shr-browse-url support custom URL handlers. --- etc/NEWS | 18 +++++++++++ lisp/net/eww.el | 30 +++++++++--------- lisp/net/shr.el | 84 +++++++++++++++++++++---------------------------- 3 files changed, 70 insertions(+), 62 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index ae676a9bf8..f4c0890663 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -348,6 +348,24 @@ symbol property to the browsing functions. With a new command 'browse-url-with-browser-kind', an URL can explicitly be browsed with either an internal or external browser. +** SHR + +--- +*** The command 'shr-browse-url' now supports custom mailto handlers. +Clicking on or otherwise following a 'mailto:' link in a HTML buffer +rendered by SHR previously invoked the command 'browse-url-mailto'. +This is still the case by default, but if you customize +'browse-url-mailto-function' or 'browse-url-handlers' to call some +other function, it will now be called instead of the default. + +** EWW + +--- +*** The command 'eww-follow-link' now supports custom mailto handlers. +The function that is invoked when clicking on or otherwise following a +'mailto:' link in an EWW buffer can now be customized. For more +information, see the related entry about 'shr-browse-url' above. + * New Modes and Packages in Emacs 28.1 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 --=-=-=--