diff options
Diffstat (limited to 'lisp/browse-url-transform.el')
-rw-r--r-- | lisp/browse-url-transform.el | 45 |
1 files changed, 45 insertions, 0 deletions
diff --git a/lisp/browse-url-transform.el b/lisp/browse-url-transform.el new file mode 100644 index 0000000..c290a1f --- /dev/null +++ b/lisp/browse-url-transform.el | |||
@@ -0,0 +1,45 @@ | |||
1 | ;;; browse-url-transform --- transform URLs | ||
2 | |||
3 | (defgroup browse-url-transform nil | ||
4 | "Transformations for urls passed to `browse-url'." | ||
5 | :group 'browse-url) | ||
6 | |||
7 | (defcustom browse-url-transform-alist nil | ||
8 | "Transformation rules for URLs. | ||
9 | The keys are regexps matching URLs, and the values are how to | ||
10 | transform them. The replacements will use match capture data." | ||
11 | :type '(alist :key-type (string :tag "URL regexp match") | ||
12 | :value-type (string :tag "URL regexp transformation"))) | ||
13 | |||
14 | (defun browse-url-transform-url (url) | ||
15 | "Transform URL before passing it to `browse-url'." | ||
16 | (cl-loop with url = (substring-no-properties | ||
17 | (if (consp url) (car url) url)) | ||
18 | for (regex . transformation) in browse-url-transform-alist | ||
19 | if (string-match regex url) | ||
20 | return (replace-match transformation nil nil url) | ||
21 | finally return url)) | ||
22 | |||
23 | (defun browse-url-transform-advice (url &rest args) | ||
24 | "Advice to `browse-url' for URL transformations. | ||
25 | ARGS are passed on for further processing." | ||
26 | (apply #'list (and url (browse-url-transform-url url)) args)) | ||
27 | |||
28 | (define-minor-mode browse-url-transform-mode | ||
29 | "Minor mode to transform a URL before passing it to `browse-url'. | ||
30 | This can be used to \"redirect\" URLs, for example from an | ||
31 | information silo to a more privacy-respecting one (e.g., | ||
32 | \"twitter.com\" -> \"nitter.com\"), by adding advice to `browse-url'. | ||
33 | |||
34 | When using this mode, ensure that the transformed URL is also in | ||
35 | `browse-url-handlers', since that's what `browse-url' will see." | ||
36 | :lighter " Turl" | ||
37 | :keymap nil | ||
38 | :global t | ||
39 | (cond (browse-url-transform-mode | ||
40 | (advice-add 'browse-url :filter-args #'browse-url-transform-advice)) | ||
41 | (:else | ||
42 | (advice-remove 'browse-url #'browse-url-transform-advice)))) | ||
43 | |||
44 | (provide 'browse-url-transform) | ||
45 | ;;; browse-url-transform.el ends here | ||