emacs/lisp/+browse-url.el

;;; +browse-url.el -*- lexical-binding: t; -*-

;;; Code:

(require 'browse-url)
(require 'cl-lib)

(defgroup +browse-url nil
  "Group for my `browse-url' extras."
  :group 'browse-url)

;;; URL Handlers

(defun +browse-url-set-handlers (&optional handlers)
  "Set HANDLERS for `browse-url'.
Set `browse-url-handlers', if they exist; else
`browse-url-browser-function'.  The reason for this switch is
that the latter is deprecated in Emacs 28+.

If HANDLERS is absent or nil, recompute handlers.  This can be
useful when changing the default browser."
  (let ((h (if (boundp 'browse-url-handlers)
               'browse-url-handlers
             'browse-url-browser-function)))
    (set-default h (or handlers (symbol-value h)))))

(cl-defmacro +browse-url-make-external-viewer-handler
    (viewer default-args &optional (prompt "URL: ")
            &key
            (custom-group '+browse-url)
            (name (format "+browse-url-with-%s" viewer))
            (fallback #'browse-url-generic))
  "Create a `browse-url' handler function that calls VIEWER on the url.
Also create a `customize' setting in CUSTOM-GROUP for VIEWER's
arguments.  DEFAULT-ARGS specifies the default arguments that
setting should have.  PROMPT will be shown to user in the
function's `interactive' spec, as an argument to
`browse-url-interactive-arg'.  The resulting function will be
named NAME, defaulting to \"+browse-url-with-VIEWER\", and the variable
\"NAME-args\".

If FALLBACK is non-nil, it's a function to fallback on if the
`start-process' call fails in anyway."
  (declare (indent 1))
  `(progn
     (defcustom ,(intern (format "%s-args" name))
       ,default-args
       ,(format "Arguments to pass to %s in `%s'." viewer name)
       :type '(repeat :tag "Command-line argument" string)
       :group ',custom-group)
     (defun ,(intern name) (url &optional new-window)
       ,(format "Open URL in %s." viewer)
       (interactive (browse-url-interactive-arg ,prompt))
       (let* ((url (browse-url-encode-url url))
              (process-environment (browse-url-process-environment)))
         (message ,(format "Opening %%s in %s..." viewer) url)
         (unless (ignore-errors
                   (apply #'start-process
                          (concat ,viewer " " url) nil
                          ,viewer
                          (append ,(intern (format "%s-args" name))
                                  (list url))))
           (funcall fallback url new-window))))))

;; Reference implementation: mpv
(+browse-url-make-external-viewer-handler "mpv" '("--cache-pause-wait=30"
                                                  "--cache-pause-initial=yes")
                                          "Video URL: ")
;; And feh too
(+browse-url-make-external-viewer-handler "feh" '("--auto-zoom"
                                                  "--geometry" "800x600"))
;; And ... mpv, but for images
(+browse-url-make-external-viewer-handler "mpv"
  '("--image-display-duration=inf")
  "Image URL: "
  :name "+browse-image-with-mpv")

;;; Easily add extra domains to open in `browse-url-secondary-browser-function'
;; I like to open most websites in eww, but a lot of website on the modern web
;; just make that hard to do. Right now I have a list in `browse-url-handlers'
;; with domains in an (rx (or ...)) form, but that's not super easy to config.
;; With this custom setting, I'm making it a list that'll be way easier to
;; customize.

(defcustom +browse-url-secondary-browser-regexps nil
  "List of URL regexps to open with `browse-url-secondary-browser-function'."
  :type '(repeat regexp))

;; Because `browse-url-browser-function', when set to an alist, must be of the
;; form (REGEXP . FUNCTION), I need to convert
;; `+browse-url-secondary-browser-regexps' into a regexp.

(defun +browse-url-secondary-browser-regexps-combine ()
  "Combine `+browse-url-secondary-browser-regexps'.
This combines a list of regexps into one regexp."
  (mapconcat #'identity +browse-url-secondary-browser-regexps "\\\|"))

;;; URL Transformation Functions
;; There's a lot of bad websites out there.  Luckily we can easily redirect
;; requests to more privacy-respecting, or just less javascript-ridden, sites
;; using some basic regex magic.  Inspired by add-ons like
;; https://einaregilsson.com/redirector/.

(defcustom +browse-url-transformations nil
  "Transformation rules for various URLs.
This is an alist, the keys of which are regexen to match URLs
against, and the values are how to transform them.  Match capture
data will be used in the transformations."
  :type
  '(alist :key-type (string :tag "URL regex match")
          :value-type (string :tag "URL regex transformation"))
  :group '+browse-url)

(defun +browse-url-transform-advice (url &rest args)
  "ADVICE to transform URL for later opening by `browse-url'.
ARGS are ignored here, but passed on for later processing."
  ;; Basically, loop through `+browse-url-transformations' until finding a CAR
  ;; that matches the URL.  If one is found, transform it using `replace-match'
  ;; with the CDR of that cell, or if one isn't, just pass the URL unchanged,
  ;; along with the rest of the args, in a list to the original caller (probably
  ;; `browse-url'.)
  (apply 'list
         (cl-loop with url = (substring-no-properties
                              (if (consp url) (car url) url))
                  for (regex . transformation) in +browse-url-transformations
                  if (string-match regex url)
                  return (replace-match transformation nil nil url)
                  ;; else
                  finally return url)
         args))

(define-minor-mode +browse-url-transform-url-mode
  "Minor mode to transform a URL before passing it to `browse-url'.
This can be used to \"redirect\" URLs, for example from an
information silo to a more privacy-respecting one (e.g.,
\"twitter.com\" -> \"nitter.com\"), by adding advice to `browse-url'.

When using this mode, ensure that the transformed URL is also in
`browse-url-handlers', since that's what `browse-url' will see."
  :lighter " Xurl"
  :keymap nil
  (if +browse-url-transform-url-mode
      (advice-add 'browse-url :filter-args '+browse-url-transform-advice)
    (advice-remove 'browse-url '+browse-url-transform-advice)))

(define-global-minor-mode +browse-url-transform-url-global-mode
  +browse-url-transform-url-mode +browse-url-transform-url-mode)

(defun +browse-url-other-window (&rest args)
  "Browse URL in the other window."
  (let ((browsed (apply #'browse-url args)))
    (when (bufferp browsed)
      (switch-to-buffer-other-window browsed))))

(provide '+browse-url)
;;; +browse-url.el ends here