diff options
Diffstat (limited to 'lisp')
-rw-r--r-- | lisp/+browse-url.el | 88 | ||||
-rw-r--r-- | lisp/browse-url-transform.el | 45 |
2 files changed, 133 insertions, 0 deletions
diff --git a/lisp/+browse-url.el b/lisp/+browse-url.el new file mode 100644 index 0000000..12e433c --- /dev/null +++ b/lisp/+browse-url.el | |||
@@ -0,0 +1,88 @@ | |||
1 | ;;; +browse-url.el -*- lexical-binding: t -*- | ||
2 | |||
3 | (require 'browse-url) | ||
4 | |||
5 | (cl-defmacro +browse-url-make-external-viewer-handler | ||
6 | (viewer default-args | ||
7 | &optional (prompt "URL: ") | ||
8 | &key | ||
9 | (custom-group 'browse-url) | ||
10 | (name (intern (format "+browse-url-with-%s" viewer))) | ||
11 | doc vardoc | ||
12 | (varname (intern (format "%s-args" name))) | ||
13 | (fallback t)) | ||
14 | "Create a `browse-url' handler function calling VIEWER on the url. | ||
15 | This macro also creates a `customize' setting in CUSTOM-GROUP for | ||
16 | VIEWER's command-line arguments. DEFAULT-ARGS specifies the | ||
17 | default arguments for that setting. | ||
18 | |||
19 | PROMPT is shown to the user in the function's `interactive' spec, | ||
20 | as an argument to `browse-url-interactive-arg'. | ||
21 | |||
22 | The resulting function is named NAME, which defaults to | ||
23 | `+browse-url-wth-VIEWER'. The custom variable is named VARNAME, | ||
24 | which defaults to `NAME-args'. If DOC or VARDOC are provided, | ||
25 | they'll be the documentation of the function and variable | ||
26 | respectively; otherwise, basic docstrings are used. | ||
27 | |||
28 | Finally, if FALLBACK is non-nil (by default, it's | ||
29 | `browse-url-generic'), the function will call that if unable to | ||
30 | start VIEWER." | ||
31 | (declare (indent 1)) | ||
32 | `(progn | ||
33 | (defcustom ,varname ,default-args | ||
34 | ,(or doc (format "Arguments to pass to %s in `%s'." viewer name)) | ||
35 | :type '(repeat :tag "Command-line argument" string) | ||
36 | :group ',custom-group) | ||
37 | (defun ,name (url &optional new-window) | ||
38 | ,(or vardoc (format "Open URL in %s." viewer)) | ||
39 | (interactive (browse-url-interactive-arg ,prompt)) | ||
40 | (let* ((url (browse-url-encode-url url)) | ||
41 | (process-environment (browse-url-process-environment))) | ||
42 | (message ,(format "Opening %%s in %s..." viewer) url) | ||
43 | (unless (ignore-errors (apply #'start-process | ||
44 | (format "%s %s" ,viewer url) nil | ||
45 | ,viewer | ||
46 | (append ,varname (list url)))) | ||
47 | ,@(cond | ||
48 | ((eq fallback t) '((browse-url-generic url new-window))) | ||
49 | (fallback `((funcall ,fallback url new-window))) | ||
50 | (:else `((message "Can't find viewer: `%s'" ,viewer) | ||
51 | nil)))))))) | ||
52 | |||
53 | (defcustom +browse-url-download-open t | ||
54 | "Whether to open downloaded files afterward." | ||
55 | :group 'browse-url | ||
56 | :type 'boolean) | ||
57 | |||
58 | (defun +browse-url-download-callback (status url dir) | ||
59 | ;; A slight change to `eww-download-callback' that returns the downloaded | ||
60 | ;; filename. | ||
61 | (unless (plist-get status :error) | ||
62 | (let* ((obj (url-generic-parse-url url)) | ||
63 | (path (directory-file-name (car (url-path-and-query obj)))) | ||
64 | (file (eww-make-unique-file-name | ||
65 | (eww-decode-url-file-name (file-name-nondirectory path)) | ||
66 | dir))) | ||
67 | (goto-char (point-min)) | ||
68 | (re-search-forward "\r?\n\r?\n") | ||
69 | (let ((coding-system-for-write 'no-conversion)) | ||
70 | (write-region (point) (point-max) file)) | ||
71 | (message "Saved %s" file) | ||
72 | file))) | ||
73 | |||
74 | (defun +browse-url-download (url &rest _) | ||
75 | "Download URL to `eww-download-directory'." | ||
76 | (interactive "sDownload URL: ") | ||
77 | (let ((dir eww-download-directory)) | ||
78 | (when (functionp dir) (setq dir (funcall dir))) | ||
79 | (make-directory dir :parents) | ||
80 | (url-retrieve url | ||
81 | (lambda (s u d) | ||
82 | (let ((file (+browse-url-download-callback s u d))) | ||
83 | (when +browse-url-download-open | ||
84 | (browse-url-xdg-open file)))) | ||
85 | (list url dir)))) | ||
86 | |||
87 | (provide '+browse-url) | ||
88 | ;;; +browse-url.el ends here | ||
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 | ||