From 0b7edfc61aace7c692c04f1d0f7a6b6eb987b657 Mon Sep 17 00:00:00 2001 From: Daniel Mendler Date: Tue, 24 Dec 2024 01:31:35 +0100 Subject: [PATCH] New function browse-url-with-function `browse-url-with-function' takes a browser function as argument, the URL and rest arguments, which are passed to the browser function. `browse-url-with-function' transforms the URL first with `browse-url-transform-alist' before calling the browser function. Calling browser functions directly is discouraged. Instead `browse-url' or `browse-url-with-function' should be used, such that URL transformations are applied. * lisp/net/browse-url.el (browse-url--transform): New function, extracted from `browse-url'. (browse-url): Use it. (browse-url-with-function): New function. (browse-url-with-browser-kind, browse-url-button-open) (browse-url-button-open-url): * lisp/net/shr.el (shr-browse-url): * lisp/net/eww.el (eww-browse-with-external-browser): * lisp/gnus/gnus-sum.el (gnus-summary-browse-url): * lisp/emacs-lisp/package.el (package-browse-url): Use it. --- lisp/emacs-lisp/package.el | 4 +-- lisp/gnus/gnus-sum.el | 10 +++----- lisp/net/browse-url.el | 50 ++++++++++++++++++++++++-------------- lisp/net/eww.el | 2 +- lisp/net/goto-addr.el | 6 ++--- lisp/net/shr.el | 18 ++++++-------- 6 files changed, 49 insertions(+), 41 deletions(-) diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index 5f785071ea3..ebd56c75677 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -4689,9 +4689,7 @@ package-browse-url (let ((url (cdr (assoc :url (package-desc-extras desc))))) (unless url (user-error "No website for %s" (package-desc-name desc))) - (if secondary - (funcall browse-url-secondary-browser-function url) - (browse-url url)))) + (browse-url-with-function secondary url))) (declare-function ietf-drums-parse-address "ietf-drums" (string &optional decode)) diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index cebeb6d4c37..931952a2885 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el @@ -9408,11 +9408,11 @@ gnus-shorten-url (concat "#" target))))) (concat host (string-truncate-left rest (- max (length host))))))) -(defun gnus-summary-browse-url (&optional external) +(defun gnus-summary-browse-url (&optional secondary) "Scan the current article body for links, and offer to browse them. -Links are opened using `browse-url' unless a prefix argument is -given: then `browse-url-secondary-browser-function' is used instead. +Links are opened using the primary browser unless a prefix argument is +given. Then the secondary browser is used instead. If only one link is found, browse that directly, otherwise use completion to select a link. The first link marked in the @@ -9429,9 +9429,7 @@ gnus-summary-browse-url (gnus-shorten-url (car urls) 40)) urls nil t nil nil (car urls)))))) (if target - (if external - (funcall browse-url-secondary-browser-function target) - (browse-url target)) + (browse-url-with-function secondary target) (message "No URLs found.")))) (defun gnus-summary-isearch-article (&optional regexp-p) diff --git a/lisp/net/browse-url.el b/lisp/net/browse-url.el index 9dd990108df..acc61162e15 100644 --- a/lisp/net/browse-url.el +++ b/lisp/net/browse-url.el @@ -888,6 +888,18 @@ browse-url-of-region ;; A generic command to call the current browse-url-browser-function +(defun browse-url--transform (url) + "Transform URL according to `browse-url-transform-alist'." + (when browse-url-transform-alist + (dolist (trans browse-url-transform-alist) + (when (string-match (car trans) url) + (setq url (replace-match (cdr trans) nil t url))))) + (when (and url-handler-mode + (not (file-name-absolute-p url)) + (not (string-match "\\`[a-z]+:" url))) + (setq url (expand-file-name url))) + url) + (declare-function pgtk-backend-display-class "pgtkfns.c" (&optional terminal)) ;;;###autoload @@ -916,14 +928,7 @@ browse-url (interactive (browse-url-interactive-arg "URL: ")) (unless (called-interactively-p 'interactive) (setq args (or args (list browse-url-new-window-flag)))) - (when browse-url-transform-alist - (dolist (trans browse-url-transform-alist) - (when (string-match (car trans) url) - (setq url (replace-match (cdr trans) nil t url))))) - (when (and url-handler-mode - (not (file-name-absolute-p url)) - (not (string-match "\\`[a-z]+:" url))) - (setq url (expand-file-name url))) + (setq url (browse-url--transform url)) (let ((process-environment (copy-sequence process-environment)) (function (or (browse-url-select-handler url) browse-url-browser-function)) @@ -957,6 +962,19 @@ browse-url (apply function url args) (error "No suitable browser for URL %s" url)))) +;;;###autoload +(defun browse-url-with-function (func url &rest args) + "Open URL with browser FUNC. +If FUNC is a function use this function. +If FUNC is nil use the `browse-url', which either calls a handler or the +primary `browse-url-browser-function'. +For other non-nil values use `browse-url-secondary-browser-function'." + (if (not func) + (apply #'browse-url url args) + (apply + (if (functionp func) func browse-url-secondary-browser-function) + (browse-url--transform url) args))) + ;;;###autoload (defun browse-url-at-point (&optional arg) "Open URL at point using a configurable method. @@ -1008,7 +1026,7 @@ browse-url-with-browser-kind browse-url-secondary-browser-function #'browse-url-default-browser #'eww)))) - (funcall function url arg))) + (browse-url-with-function function url arg))) ;;;###autoload (defun browse-url-at-mouse (event) @@ -1815,27 +1833,23 @@ browse-url-add-buttons browse-url-data ,(match-string 0))))))) ;;;###autoload -(defun browse-url-button-open (&optional external mouse-event) +(defun browse-url-button-open (&optional secondary mouse-event) "Follow the link under point using `browse-url'. -If EXTERNAL (the prefix if used interactively), open with the -external browser instead of the default one." +If SECONDARY (the prefix if used interactively), open with the +secondary browser instead of the default one." (interactive (list current-prefix-arg last-nonmenu-event)) (mouse-set-point mouse-event) (let ((url (get-text-property (point) 'browse-url-data))) (unless url (error "No URL under point")) - (if external - (funcall browse-url-secondary-browser-function url) - (browse-url url)))) + (browse-url-with-function secondary url))) ;;;###autoload (defun browse-url-button-open-url (url) "Open URL using `browse-url'. If `current-prefix-arg' is non-nil, use `browse-url-secondary-browser-function' instead." - (if current-prefix-arg - (funcall browse-url-secondary-browser-function url) - (browse-url url))) + (browse-url-with-function current-prefix-arg url)) (defun browse-url-button-copy () "Copy the URL under point." diff --git a/lisp/net/eww.el b/lisp/net/eww.el index 842db3f27f4..a40232d977b 100644 --- a/lisp/net/eww.el +++ b/lisp/net/eww.el @@ -2166,7 +2166,7 @@ eww-browse-with-external-browser (setq url (or url (plist-get eww-data :url))) (if (eq 'external (browse-url--browser-kind browse-url-secondary-browser-function url)) - (funcall browse-url-secondary-browser-function url) + (browse-url-with-function browse-url-secondary-browser-function url) (browse-url-with-browser-kind 'external url))) (defun eww-remove-tracking (url) diff --git a/lisp/net/goto-addr.el b/lisp/net/goto-addr.el index 3e5bc1ec090..59d6a01f585 100644 --- a/lisp/net/goto-addr.el +++ b/lisp/net/goto-addr.el @@ -227,9 +227,9 @@ goto-address-at-point Compose message to address at point. See documentation for `goto-address-find-address-at-point'. -If no e-mail address is found at point, open the URL at or before -point using `browse-url'. With a prefix argument, open the URL -using `browse-url-secondary-browser-function' instead." +If no e-mail address is found at point, open the URL at or before point +using `browse-url-button-open-url'. With a prefix argument the +secondary browser is used." (interactive (list last-input-event)) (save-excursion (if event (posn-set-point (event-end event))) diff --git a/lisp/net/shr.el b/lisp/net/shr.el index 6d8b235a2b8..da77bbf75a8 100644 --- a/lisp/net/shr.el +++ b/lisp/net/shr.el @@ -1097,24 +1097,22 @@ shr-mouse-browse-url-new-window (mouse-set-point ev) (shr-browse-url nil nil t)) -(defun shr-browse-url (&optional external mouse-event new-window) +(defun shr-browse-url (&optional secondary mouse-event new-window) "Browse the URL at point using `browse-url'. -If EXTERNAL is non-nil (interactively, the prefix argument), browse -the URL using `browse-url-secondary-browser-function'. +If SECONDARY is non-nil (interactively, the prefix argument), browse +the URL with the secondary browser. If this function is invoked by a mouse click, it will browse the URL at the position of the click. Optional argument MOUSE-EVENT describes the mouse click event." (interactive (list current-prefix-arg last-nonmenu-event)) (mouse-set-point mouse-event) (let ((url (get-text-property (point) 'shr-url))) - (cond - ((not url) + (if (not url) (message "No link under point")) - (external - (funcall browse-url-secondary-browser-function url) - (shr--blink-link)) - (t - (browse-url url (xor new-window browse-url-new-window-flag)))))) + (browse-url-with-function secondary url + (xor new-window browse-url-new-window-flag)) + (when secondary + (shr--blink-link)))) (defun shr-save-contents (directory) "Save the contents from URL in a file." -- 2.45.2