summary refs log tree commit diff stats
diff options
context:
space:
mode:
-rw-r--r--lisp/acdw-web.el196
1 files changed, 195 insertions, 1 deletions
diff --git a/lisp/acdw-web.el b/lisp/acdw-web.el index 080cd9a..28fcd02 100644 --- a/lisp/acdw-web.el +++ b/lisp/acdw-web.el
@@ -16,13 +16,207 @@
16 (cdr (get 'browse-url-browser-function 16 (cdr (get 'browse-url-browser-function
17 'custom-type))))))) 17 'custom-type)))))))
18 18
19;;; URL matcher generators
20
21(defun +browse-url-matches (&rest regexps)
22 "Return a lambda that will determine if a url matches REGEXPS.
23Each regexp will be tested in turn. The first one that matches
24is returned by the lambda.
25
26This is a good function to use in key positions in `browse-url-handlers'."
27 `(lambda (url &optional new-window)
28 (cl-loop for regexp in ',regexps
29 if (string-match-p regexp url)
30 return regexp)))
31;;; External URL handlers
32
33(cl-defmacro +browse-url-make-external-viewer-handler
34 (viewer
35 &key
36 args
37 (prompt "URL: ")
38 (program (executable-find (format "%s" viewer)))
39 (name (intern (format "+browse-url-with-%s" viewer)))
40 doc
41 (var (intern (format "%s-args" name)))
42 vardoc
43 (custom-group '+browse-url)
44 (fallback '(function browse-url-generic)))
45 "Create a `browse-url' handler function calling PROGRAM on the URL.
46This macro also creates a `customize' setting in CUSTOM-GROUP for
47PROGRAM's command-line arguments. ARGS specifies the
48default arguments for this user option.
49
50PROGRAM defaults to the result of calling `executable-find' on VIEWER.
51
52PROMPT is shown to the user in the function's `interactive' spec, as an argument
53to `browse-url-interactive-arg'.
54
55The resulting function is named NAME, which defaults to
56`+browse-url-with-VIEWER'. The custom variable is named VAR, which defaults
57to `NAME-args'. If DOC or VARDOC are provided, they'll be the documentation of
58the function and variable respectively; otherwise a basic default doc-string is
59used.
60
61If FALLBACK is non-nil (the default is `browse-url-generic'), the
62generated function will call FALLBACK if unable to start PROGRAM
63for some reason."
64 (declare (indent 1))
65 `(progn
66 (defcustom ,var ,args
67 ,(or vardoc (format "Arguments to pass to %s in `%s'."
68 viewer name))
69 :type '(repeat :tag "Command-line argument" string)
70 :group ',custom-group)
71 (defun ,name (url &optional new-window)
72 ,(or doc (format "Open URL in %s." viewer))
73 (interactive (browse-url-interactive-arg ,prompt))
74 (let* ((url (browse-url-encode-url url))
75 (process-environment (browse-url-process-environment)))
76 (message ,(format "Opening %%s in %s..." viewer) url)
77 (unless (ignore-errors (apply #'start-process
78 (format "%s %s" ',viewer url)
79 nil
80 ,program
81 (append ,var (list url))))
82 ,@(cond
83 (fallback `((funcall ,fallback url new-window)))
84 (:else `((message "Can't find viewer: %s" ,viewer)
85 nil))))))))
86
87;; Some default handlers
88
89(+browse-url-make-external-viewer-handler mpv
90 :args '("--cache-pause-wait=15"
91 "--cache-pause-initial=yes")
92 :prompt "Video URL: ")
93
94(+browse-url-make-external-viewer-handler mpv-image
95 :program (executable-find "mpv")
96 :args '("--image-display-duration=inf")
97 :prompt "Image URL: ")
98
99;;; External domains
100;; Some domains just don't open well in `eww'. The following function and user
101;; option define an easy way to automatically open those.
102
103(defcustom +browse-url-external-domains nil
104 "Domains to open in `browse-url-secondary-browser-function'.
105This is just a list of strings. They'll be regexp-escaped and
106passed to `+browse-url-external-url-p', which is a good function
107to put in `browse-url-handlers'.
108
109If an item in this list is a list itself, it should contain one string, a valid
110regexp that will not be regexp-quoted when matching against a url."
111 :type '(repeat (choice
112 (list :tag "Regexp" regexp)
113 (string :tag "Literal string"))))
114
115(defun +browse-url-external-url-p (url)
116 "Return t if URL is a member of `+browse-url-external-domains'.
117This function only tests URL's domain."
118 (let ((host (url-host (url-generic-parse-url url))))
119 (cl-loop for domain in +browse-url-external-domains
120 if (string-match-p (if (stringp domain)
121 (regexp-quote domain)
122 (car domain))
123 host)
124 return t)))
125
126
127;;; Downloading
128
129(defcustom +browse-url-download-open t
130 "Whether to open downloaded files after downloading."
131 :type 'boolean)
132
133(defun +browse-url-download (url &rest _)
134 "Download URL to `eww-download-directory'."
135 (interactive "sDownload URL: ")
136 (let ((dir eww-download-directory))
137 (when (functionp dir) (setq dir (funcall dir)))
138 (make-directory dir :parents)
139 (url-retrieve url
140 (lambda (s u d)
141 (let ((file (+browse-url-download-callback s u d)))
142 (when +browse-url-download-open
143 (browse-url-xdg-open file))))
144 (list url dir))))
145
146(defun +browse-url-download-callback (status url dir)
147 ;; A slight change to `eww-download-callback' that returns the downloaded
148 ;; filename.
149 (unless (plist-get status :error)
150 (let* ((obj (url-generic-parse-url url))
151 (path (directory-file-name (car (url-path-and-query obj))))
152 (file (eww-make-unique-file-name
153 (eww-decode-url-file-name (file-name-nondirectory path))
154 dir)))
155 (goto-char (point-min))
156 (re-search-forward "\r?\n\r?\n")
157 (let ((coding-system-for-write 'no-conversion))
158 (write-region (point) (point-max) file))
159 (message "Saved %s" file)
160 file)))
161
19 162
20;;; Packages 163;;; Packages
21 164
22(use-package browse-url 165(use-package browse-url
166 :demand t
23 :config 167 :config
24 (put 'browse-url-browser-function 'safe-local-variable 168 (put 'browse-url-browser-function 'safe-local-variable
25 '+browse-url-browser-function-safe-p)) 169 '+browse-url-browser-function-safe-p)
170 (setopt browse-url-browser-function #'eww-browse-url
171 ;; Dispatch browser based on URL
172 browse-url-handlers
173 `(;; Videos
174 (,(+browse-url-matches "youtube\\.com" "yoiutu\\.be"
175 "invidious" "yewtu\\.be"
176 (rx "." (or "mp4" "gif" "mov" "MOV" "webm")
177 eos))
178 . +browse-url-with-mpv)
179 ;; Music
180 (,(+browse-url-matches "soundcloud\\.com" "bandcamp\\.com"
181 (rx "." (or "ogg" "mp3" "opus" "m4a") eos))
182 . +browse-url-with-mpv)
183 ;; Images
184 (,(+browse-url-matches "pbs\\.twimg\\.com"
185 (rx "." (or "jpeg" "jpg" "png" "bmp" "webp")
186 eos))
187 . +browse-url-with-mpv-image)
188 ;; Blobs
189 (,(+browse-url-matches (rx "." (or ".tar.gz" ".pdf") eos))
190 . +browse-url-download)
191 ;; External URLs --- see `+browse-url-external-domains'
192 (+browse-url-external-url-p
193 . ,browse-url-secondary-browser-function))
194 ;; External domains
195 +browse-url-external-domains '("github.com" "gitlab.com" "codeberg.org"
196 "tildegit.org" "git.tilde.town"
197 "google.com" "imgur.com" "twitch.tv"
198 "pixelfed" "instagram.com"
199 "bibliogram.art" "reddit.com"
200 "teddit.net" "libreddit.de"
201 "streamable.com" "spotify.com"
202 "hetzner.cloud" "melpa.org"
203 "twitter.com" ("^t\\.co$")
204 "nitter.snopyta.org" "nitter.net"))
205 ;; External browsers: firefox > chromium > chrome
206 (when-let ((firefox (choose-executable "firefox"
207 "firefox-esr")))
208 (setopt browse-url-firefox-program firefox
209 browse-url-firefox-new-window-is-tab t
210 browse-url-firefox-arguments '("--new-tab")
211 browse-url-generic-program firefox
212 browse-url-generic-args browse-url-firefox-arguments))
213 (when-let ((chromium (choose-executable "chromium")))
214 (setopt browse-url-chromium-program chromium
215 browse-url-generic-program chromium))
216 (when-let ((chrome (choose-executable "chrome"
217 "google-chrome-stable")))
218 (setopt browse-url-chrome-program chrome
219 browse-url-generic-program chrome)))
26 220
27(provide 'acdw-web) 221(provide 'acdw-web)
28;;; acdw-web.el ends here 222;;; acdw-web.el ends here