diff options
Diffstat (limited to 'lisp/+browse-url.el')
-rw-r--r-- | lisp/+browse-url.el | 117 |
1 files changed, 117 insertions, 0 deletions
diff --git a/lisp/+browse-url.el b/lisp/+browse-url.el new file mode 100644 index 0000000..fad0826 --- /dev/null +++ b/lisp/+browse-url.el | |||
@@ -0,0 +1,117 @@ | |||
1 | ;;; +browse-url.el -*- lexical-binding: t; -*- | ||
2 | |||
3 | ;;; Code: | ||
4 | |||
5 | (require 'cl-lib) | ||
6 | |||
7 | (defgroup +browse-url nil | ||
8 | "Group for my `browse-url' extras." | ||
9 | :group 'browse-url) | ||
10 | |||
11 | ;;; URL Handlers | ||
12 | |||
13 | (defun +browse-url-set-handlers (handlers) | ||
14 | "Set handlers for `browse-url'. | ||
15 | Set `browse-url-handlers', if they exist; else | ||
16 | `browse-url-browser-function'. The reason for this switch is | ||
17 | that the latter is deprecated in Emacs 28+." | ||
18 | (set-default (if (boundp 'browse-url-handlers) | ||
19 | 'browse-url-handlers | ||
20 | 'browse-url-browser-function) | ||
21 | handlers)) | ||
22 | |||
23 | (cl-defmacro +browse-url-make-external-viewer-handler | ||
24 | (viewer default-args &optional (prompt "URL: ") | ||
25 | &key | ||
26 | (custom-group '+browse-url) | ||
27 | (name (format "+browse-url-with-%s" viewer))) | ||
28 | "Create a `browse-url' handler function that calls VIEWER on the url. | ||
29 | Also create a `customize' setting in CUSTOM-GROUP for VIEWER's | ||
30 | arguments. DEFAULT-ARGS specifies the default arguments that | ||
31 | setting should have. PROMPT will be shown to user in the | ||
32 | function's `interactive' spec, as an argument to | ||
33 | `browse-url-interactive-arg'. The resulting function will be | ||
34 | named NAME, defaulting to \"+browse-url-with-VIEWER\", and the variable | ||
35 | \"NAME-args\"." | ||
36 | (declare (indent 1)) | ||
37 | `(progn | ||
38 | (defcustom ,(intern (format "%s-args" name)) | ||
39 | ,default-args | ||
40 | ,(format "Arguments to pass to %s in `%s'." viewer name) | ||
41 | :type '(repeat :tag "Command-line argument" string) | ||
42 | :group ',custom-group) | ||
43 | (defun ,(intern name) (url &optional _new-window) | ||
44 | ,(format "Open URL in %s." viewer) | ||
45 | (interactive (browse-url-interactive-arg ,prompt)) | ||
46 | (let* ((url (browse-url-encode-url url)) | ||
47 | (process-environment (browse-url-process-environment))) | ||
48 | (message ,(format "Opening %%s in %s..." viewer) url) | ||
49 | (apply #'start-process | ||
50 | (concat ,viewer " " url) nil | ||
51 | ,viewer | ||
52 | (append ,(intern (format "%s-args" name)) (list url))))))) | ||
53 | |||
54 | ;; Reference implementation: mpv | ||
55 | (+browse-url-make-external-viewer-handler "mpv" nil "Video URL: ") | ||
56 | ;; And feh too | ||
57 | (+browse-url-make-external-viewer-handler "feh" '("--auto-zoom" | ||
58 | "--geometry" "800x600")) | ||
59 | ;; And ... mpv, but for images | ||
60 | (+browse-url-make-external-viewer-handler "mpv" | ||
61 | '("--image-display-duration=inf") | ||
62 | "Image URL: " | ||
63 | :name "+browse-image-with-mpv") | ||
64 | |||
65 | ;;; URL Transformation Functions | ||
66 | ;; There's a lot of bad websites out there. Luckily we can easily redirect | ||
67 | ;; requests to more privacy-respecting, or just less javascript-ridden, sites | ||
68 | ;; using some basic regex magic. Inspired by add-ons like | ||
69 | ;; https://einaregilsson.com/redirector/. | ||
70 | |||
71 | (defcustom +browse-url-transformations nil | ||
72 | "Transformation rules for various URLs. | ||
73 | This is an alist, the keys of which are regexen to match URLs | ||
74 | against, and the values are how to transform them. Match capture | ||
75 | data will be used in the transformations." | ||
76 | :type | ||
77 | '(alist :key-type (string :tag "URL regex match") | ||
78 | :value-type (string :tag "URL regex transformation")) | ||
79 | :group '+browse-url) | ||
80 | |||
81 | (defun +browse-url-transform-advice (url &rest args) | ||
82 | "ADVICE to transform URL for later opening by `browse-url'. | ||
83 | ARGS are ignored here, but passed on for later processing." | ||
84 | ;; Basically, loop through `+browse-url-transformations' until finding a CAR | ||
85 | ;; that matches the URL. If one is found, transform it using `replace-match' | ||
86 | ;; with the CDR of that cell, or if one isn't, just pass the URL unchanged, | ||
87 | ;; along with the rest of the args, in a list to the original caller (probably | ||
88 | ;; `browse-url'.) | ||
89 | (apply 'list | ||
90 | (cl-loop with url = (substring-no-properties | ||
91 | (if (consp url) (car url) url)) | ||
92 | for (regex . transformation) in +browse-url-transformations | ||
93 | if (string-match regex url) | ||
94 | return (replace-match transformation nil nil url) | ||
95 | ;; else | ||
96 | finally return url) | ||
97 | args)) | ||
98 | |||
99 | (define-minor-mode +browse-url-transform-url-mode | ||
100 | "Minor mode to transform a URL before passing it to `browse-url'. | ||
101 | This can be used to \"redirect\" URLs, for example from an | ||
102 | information silo to a more privacy-respecting one (e.g., | ||
103 | \"twitter.com\" -> \"nitter.com\"), by adding advice to `browse-url'. | ||
104 | |||
105 | When using this mode, ensure that the transformed URL is also in | ||
106 | `browse-url-handlers', since that's what `browse-url' will see." | ||
107 | :lighter " Xurl" | ||
108 | :keymap nil | ||
109 | (if +browse-url-transform-url-mode | ||
110 | (advice-add 'browse-url :filter-args '+browse-url-transform-advice) | ||
111 | (advice-remove 'browse-url '+browse-url-transform-advice))) | ||
112 | |||
113 | (define-global-minor-mode +browse-url-transform-url-global-mode | ||
114 | +browse-url-transform-url-mode +browse-url-transform-url-mode) | ||
115 | |||
116 | (provide '+browse-url) | ||
117 | ;;; +browse-url.el ends here | ||