146 lines
6.0 KiB
EmacsLisp
146 lines
6.0 KiB
EmacsLisp
;;; +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 (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+."
|
|
(set-default (if (boundp 'browse-url-handlers)
|
|
'browse-url-handlers
|
|
'browse-url-browser-function)
|
|
handlers))
|
|
|
|
(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" nil "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)
|
|
|
|
(provide '+browse-url)
|
|
;;; +browse-url.el ends here
|