diff options
author | Case Duckworth | 2023-01-03 23:03:03 -0600 |
---|---|---|
committer | Case Duckworth | 2023-01-03 23:03:03 -0600 |
commit | 59a1f58695d09ab29ddf992b2c0711c94a4039ea (patch) | |
tree | 1de8114d3b60d11b9a3b92422d178f17e1841ea0 /lisp/+browse-url.el | |
parent | bleh (diff) | |
download | emacs-59a1f58695d09ab29ddf992b2c0711c94a4039ea.tar.gz emacs-59a1f58695d09ab29ddf992b2c0711c94a4039ea.zip |
Switch to use-package
Diffstat (limited to 'lisp/+browse-url.el')
-rw-r--r-- | lisp/+browse-url.el | 189 |
1 files changed, 145 insertions, 44 deletions
diff --git a/lisp/+browse-url.el b/lisp/+browse-url.el index 12e433c..b65b6f9 100644 --- a/lisp/+browse-url.el +++ b/lisp/+browse-url.el | |||
@@ -1,60 +1,101 @@ | |||
1 | ;;; +browse-url.el -*- lexical-binding: t -*- | 1 | ;;; +browse-url.el -*- lexical-binding: t; -*- |
2 | 2 | ||
3 | (require 'browse-url) | 3 | (require 'browse-url) |
4 | (require 'cl-lib) | ||
5 | (require 'seq) | ||
6 | (require 'url-util) | ||
7 | |||
8 | (defgroup +browse-url nil | ||
9 | "My `browse-url' extras." | ||
10 | :group 'browse-url) | ||
11 | |||
12 | ;;; External URL handlers | ||
4 | 13 | ||
5 | (cl-defmacro +browse-url-make-external-viewer-handler | 14 | (cl-defmacro +browse-url-make-external-viewer-handler |
6 | (viewer default-args | 15 | (viewer |
7 | &optional (prompt "URL: ") | 16 | &key |
8 | &key | 17 | args |
9 | (custom-group 'browse-url) | 18 | (prompt "URL: ") |
10 | (name (intern (format "+browse-url-with-%s" viewer))) | 19 | (program (executable-find (format "%s" viewer))) |
11 | doc vardoc | 20 | (name (intern (format "+browse-url-with-%s" viewer))) |
12 | (varname (intern (format "%s-args" name))) | 21 | doc |
13 | (fallback t)) | 22 | (var (intern (format "%s-args" name))) |
14 | "Create a `browse-url' handler function calling VIEWER on the url. | 23 | vardoc |
24 | (custom-group '+browse-url) | ||
25 | (fallback '(function browse-url-generic))) | ||
26 | "Create a `browse-url' handler function calling PROGRAM on the URL. | ||
15 | This macro also creates a `customize' setting in CUSTOM-GROUP for | 27 | This macro also creates a `customize' setting in CUSTOM-GROUP for |
16 | VIEWER's command-line arguments. DEFAULT-ARGS specifies the | 28 | PROGRAM's command-line arguments. ARGS specifies the |
17 | default arguments for that setting. | 29 | default arguments for this user option. |
30 | |||
31 | PROGRAM defaults to the result of calling `executable-find' on VIEWER. | ||
18 | 32 | ||
19 | PROMPT is shown to the user in the function's `interactive' spec, | 33 | PROMPT is shown to the user in the function's `interactive' spec, as an argument |
20 | as an argument to `browse-url-interactive-arg'. | 34 | to `browse-url-interactive-arg'. |
21 | 35 | ||
22 | The resulting function is named NAME, which defaults to | 36 | The resulting function is named NAME, which defaults to |
23 | `+browse-url-wth-VIEWER'. The custom variable is named VARNAME, | 37 | `+browse-url-with-VIEWER'. The custom variable is named VAR, which defaults |
24 | which defaults to `NAME-args'. If DOC or VARDOC are provided, | 38 | to `NAME-args'. If DOC or VARDOC are provided, they'll be the documentation of |
25 | they'll be the documentation of the function and variable | 39 | the function and variable respectively; otherwise a basic default doc-string is |
26 | respectively; otherwise, basic docstrings are used. | 40 | used. |
27 | 41 | ||
28 | Finally, if FALLBACK is non-nil (by default, it's | 42 | If FALLBACK is non-nil (the default is `browse-url-generic'), the |
29 | `browse-url-generic'), the function will call that if unable to | 43 | generated function will call FALLBACK if unable to start PROGRAM |
30 | start VIEWER." | 44 | for some reason." |
31 | (declare (indent 1)) | 45 | (declare (indent 1)) |
32 | `(progn | 46 | `(progn |
33 | (defcustom ,varname ,default-args | 47 | (defcustom ,var ,args |
34 | ,(or doc (format "Arguments to pass to %s in `%s'." viewer name)) | 48 | ,(or vardoc (format "Arguments to pass to %s in `%s'." |
49 | viewer name)) | ||
35 | :type '(repeat :tag "Command-line argument" string) | 50 | :type '(repeat :tag "Command-line argument" string) |
36 | :group ',custom-group) | 51 | :group ',custom-group) |
37 | (defun ,name (url &optional new-window) | 52 | (defun ,name (url &optional new-window) |
38 | ,(or vardoc (format "Open URL in %s." viewer)) | 53 | ,(or doc (format "Open URL in %s." viewer)) |
39 | (interactive (browse-url-interactive-arg ,prompt)) | 54 | (interactive (browse-url-interactive-arg ,prompt)) |
40 | (let* ((url (browse-url-encode-url url)) | 55 | (let* ((url (browse-url-encode-url url)) |
41 | (process-environment (browse-url-process-environment))) | 56 | (process-environment (browse-url-process-environment))) |
42 | (message ,(format "Opening %%s in %s..." viewer) url) | 57 | (message ,(format "Opening %%s in %s..." viewer) url) |
43 | (unless (ignore-errors (apply #'start-process | 58 | (unless (ignore-errors (apply #'start-process |
44 | (format "%s %s" ,viewer url) nil | 59 | (format "%s %s" ',viewer url) |
45 | ,viewer | 60 | nil |
46 | (append ,varname (list url)))) | 61 | ,program |
62 | (append ,var (list url)))) | ||
47 | ,@(cond | 63 | ,@(cond |
48 | ((eq fallback t) '((browse-url-generic url new-window))) | ||
49 | (fallback `((funcall ,fallback url new-window))) | 64 | (fallback `((funcall ,fallback url new-window))) |
50 | (:else `((message "Can't find viewer: `%s'" ,viewer) | 65 | (:else `((message "Can't find viewer: %s" ,viewer) |
51 | nil)))))))) | 66 | nil)))))))) |
52 | 67 | ||
68 | ;; Some default handlers | ||
69 | |||
70 | (+browse-url-make-external-viewer-handler mpv | ||
71 | :args '("--cache-pause-wait=15" | ||
72 | "--cache-pause-initial=yes") | ||
73 | :prompt "Video URL: ") | ||
74 | |||
75 | (+browse-url-make-external-viewer-handler mpv-image | ||
76 | :program (executable-find "mpv") | ||
77 | :args '("--image-display-duration=inf") | ||
78 | :prompt "Image URL: ") | ||
79 | |||
80 | ;;; Downloading | ||
81 | |||
53 | (defcustom +browse-url-download-open t | 82 | (defcustom +browse-url-download-open t |
54 | "Whether to open downloaded files afterward." | 83 | "Whether to open downloaded files after downloading." |
55 | :group 'browse-url | ||
56 | :type 'boolean) | 84 | :type 'boolean) |
57 | 85 | ||
86 | (defun +browse-url-download (url &rest _) | ||
87 | "Download URL to `eww-download-directory'." | ||
88 | (interactive "sDownload URL: ") | ||
89 | (let ((dir eww-download-directory)) | ||
90 | (when (functionp dir) (setq dir (funcall dir))) | ||
91 | (make-directory dir :parents) | ||
92 | (url-retrieve url | ||
93 | (lambda (s u d) | ||
94 | (let ((file (+browse-url-download-callback s u d))) | ||
95 | (when +browse-url-download-open | ||
96 | (browse-url-xdg-open file)))) | ||
97 | (list url dir)))) | ||
98 | |||
58 | (defun +browse-url-download-callback (status url dir) | 99 | (defun +browse-url-download-callback (status url dir) |
59 | ;; A slight change to `eww-download-callback' that returns the downloaded | 100 | ;; A slight change to `eww-download-callback' that returns the downloaded |
60 | ;; filename. | 101 | ;; filename. |
@@ -71,18 +112,78 @@ start VIEWER." | |||
71 | (message "Saved %s" file) | 112 | (message "Saved %s" file) |
72 | file))) | 113 | file))) |
73 | 114 | ||
74 | (defun +browse-url-download (url &rest _) | 115 | ;;; URL matcher generators |
75 | "Download URL to `eww-download-directory'." | 116 | |
76 | (interactive "sDownload URL: ") | 117 | (defun +browse-url-matches (&rest regexps) |
77 | (let ((dir eww-download-directory)) | 118 | "Return a lambda that will determine if a url matches REGEXPS. |
78 | (when (functionp dir) (setq dir (funcall dir))) | 119 | Each regexp will be tested in turn. The first one that matches |
79 | (make-directory dir :parents) | 120 | is returned by the lambda. |
80 | (url-retrieve url | 121 | |
81 | (lambda (s u d) | 122 | This is a good function to use in key positions in `browse-url-handlers'." |
82 | (let ((file (+browse-url-download-callback s u d))) | 123 | `(lambda (url &optional new-window) |
83 | (when +browse-url-download-open | 124 | (cl-loop for regexp in ',regexps |
84 | (browse-url-xdg-open file)))) | 125 | if (string-match-p regexp url) |
85 | (list url dir)))) | 126 | return regexp))) |
127 | |||
128 | ;;; External domains | ||
129 | ;; Some domains just don't open well in `eww'. The following function and user | ||
130 | ;; option define an easy way to automatically open those. | ||
131 | |||
132 | (defcustom +browse-url-external-domains nil | ||
133 | "Domains to open in `browse-url-secondary-browser-function'. | ||
134 | This is just a list of strings. They'll be regexp-escaped and | ||
135 | passed to `+browse-url-external-url-p', which is a good function | ||
136 | to put in `browse-url-handlers'. | ||
137 | |||
138 | If an item in this list is a list itself, it should contain one string, a valid | ||
139 | regexp that will not be regexp-quoted when matching against a url." | ||
140 | :type '(repeat (choice | ||
141 | (list :tag "Regexp" regexp) | ||
142 | (string :tag "Literal string")))) | ||
143 | |||
144 | (defun +browse-url-external-url-p (url) | ||
145 | "Return t if URL is a member of `+browse-url-external-domains'. | ||
146 | This function only tests URL's domain." | ||
147 | (let ((host (url-host (url-generic-parse-url url)))) | ||
148 | (cl-loop for domain in +browse-url-external-domains | ||
149 | if (string-match-p (if (stringp domain) | ||
150 | (regexp-quote domain) | ||
151 | (car domain)) | ||
152 | host) | ||
153 | return t))) | ||
154 | |||
155 | ;;; Switch to an external browser from an Emacs browser | ||
156 | |||
157 | (defmacro +browse-url-switch-external-browser (mode url-fetcher-form) | ||
158 | "Create a function for MODE to open an external browser. | ||
159 | URL-FETCHER-FORM will be used to get the URL of the current visited page." | ||
160 | (declare (indent 1)) | ||
161 | `(defun ,(intern (format "+browse-url-external-from-%s" mode)) | ||
162 | (&optional url) | ||
163 | "Browse URL with `browse-url-secondary-browser-function'. | ||
164 | This will close the current buffer." | ||
165 | (interactive nil ,mode) | ||
166 | (condition-case e | ||
167 | (funcall browse-url-secondary-browser-function | ||
168 | (or url ,url-fetcher-form)) | ||
169 | (:success (when (null url) (quit-window))) ; Interactive use | ||
170 | (t (signal (car e) (cdr e)))))) | ||
171 | |||
172 | ;;; Mark `browse-url-browser-function' as safe | ||
173 | |||
174 | (defcustom +browse-url-other-safe-browser-functions nil | ||
175 | "Other safe browser functions." | ||
176 | :type '(repeat function)) | ||
177 | |||
178 | (defun +browse-url-browser-function-safe-p (f) | ||
179 | "Return t if F is a safe browser function." | ||
180 | (memq f (append +browse-url-other-safe-browser-functions | ||
181 | (mapcar (lambda (i) | ||
182 | (plist-get (cdr i) :value)) | ||
183 | (seq-filter (lambda (i) | ||
184 | (eq (car i) 'function-item)) | ||
185 | (cdr (get 'browse-url-browser-function | ||
186 | 'custom-type))))))) | ||
86 | 187 | ||
87 | (provide '+browse-url) | 188 | (provide '+browse-url) |
88 | ;;; +browse-url.el ends here | 189 | ;;; +browse-url.el ends here |