diff options
Diffstat (limited to 'lisp/acdw-web.el')
-rw-r--r-- | lisp/acdw-web.el | 374 |
1 files changed, 0 insertions, 374 deletions
diff --git a/lisp/acdw-web.el b/lisp/acdw-web.el deleted file mode 100644 index 3b78e4d..0000000 --- a/lisp/acdw-web.el +++ /dev/null | |||
@@ -1,374 +0,0 @@ | |||
1 | ;;; acdw.web.el --- Web browsing and such -*- lexical-binding: t; -*- | ||
2 | |||
3 | ;;; Code: | ||
4 | |||
5 | (require 'cl-lib) | ||
6 | |||
7 | (defcustom +browse-url-other-safe-browser-functions nil | ||
8 | "Other safe browser functions." | ||
9 | :type '(repeat function)) | ||
10 | |||
11 | (defun +browse-url-browser-function-safe-p (f) | ||
12 | "Return t if F is a safe browser function." | ||
13 | (memq f (append +browse-url-other-safe-browser-functions | ||
14 | (mapcar (lambda (i) | ||
15 | (plist-get (cdr i) :value)) | ||
16 | (seq-filter (lambda (i) | ||
17 | (eq (car i) 'function-item)) | ||
18 | (cdr (get 'browse-url-browser-function | ||
19 | 'custom-type))))))) | ||
20 | |||
21 | ;;; URL matcher generators | ||
22 | |||
23 | (defun +browse-url-matches (&rest regexps) | ||
24 | "Return a lambda that will determine if a url matches REGEXPS. | ||
25 | Each regexp will be tested in turn. The first one that matches | ||
26 | is returned by the lambda. | ||
27 | |||
28 | This is a good function to use in key positions in `browse-url-handlers'." | ||
29 | `(lambda (url &optional new-window) | ||
30 | (cl-loop for regexp in ',regexps | ||
31 | if (string-match-p regexp url) | ||
32 | return regexp))) | ||
33 | |||
34 | ;;; External URL handlers | ||
35 | |||
36 | (cl-defmacro +browse-url-make-external-viewer-handler | ||
37 | (viewer | ||
38 | &key | ||
39 | args | ||
40 | (prompt "URL: ") | ||
41 | (program (executable-find (format "%s" viewer))) | ||
42 | (name (intern (format "+browse-url-with-%s" viewer))) | ||
43 | doc | ||
44 | (var (intern (format "%s-args" name))) | ||
45 | vardoc | ||
46 | (custom-group '+browse-url) | ||
47 | (fallback '(function browse-url-generic))) | ||
48 | "Create a `browse-url' handler function calling PROGRAM on the URL. | ||
49 | This macro also creates a `customize' setting in CUSTOM-GROUP for | ||
50 | PROGRAM's command-line arguments. ARGS specifies the | ||
51 | default arguments for this user option. | ||
52 | |||
53 | PROGRAM defaults to the result of calling `executable-find' on VIEWER. | ||
54 | |||
55 | PROMPT is shown to the user in the function's `interactive' spec, as an argument | ||
56 | to `browse-url-interactive-arg'. | ||
57 | |||
58 | The resulting function is named NAME, which defaults to | ||
59 | `+browse-url-with-VIEWER'. The custom variable is named VAR, which defaults | ||
60 | to `NAME-args'. If DOC or VARDOC are provided, they'll be the documentation of | ||
61 | the function and variable respectively; otherwise a basic default doc-string is | ||
62 | used. | ||
63 | |||
64 | If FALLBACK is non-nil (the default is `browse-url-generic'), the | ||
65 | generated function will call FALLBACK if unable to start PROGRAM | ||
66 | for some reason." | ||
67 | (declare (indent 1)) | ||
68 | `(progn | ||
69 | (defcustom ,var ,args | ||
70 | ,(or vardoc (format "Arguments to pass to %s in `%s'." | ||
71 | viewer name)) | ||
72 | :type '(repeat :tag "Command-line argument" string) | ||
73 | :group ',custom-group) | ||
74 | (defun ,name (url &optional new-window) | ||
75 | ,(or doc (format "Open URL in %s." viewer)) | ||
76 | (interactive (browse-url-interactive-arg ,prompt)) | ||
77 | (let* ((url (browse-url-encode-url url)) | ||
78 | (process-environment (browse-url-process-environment))) | ||
79 | (message ,(format "Opening %%s in %s..." viewer) url) | ||
80 | (unless (ignore-errors (apply #'start-process | ||
81 | (format "%s %s" ',viewer url) | ||
82 | nil | ||
83 | ,program | ||
84 | (append ,var (list url)))) | ||
85 | ,@(cond | ||
86 | (fallback `((funcall ,fallback url new-window))) | ||
87 | (:else `((message "Can't find viewer: %s" ,viewer) | ||
88 | nil)))))))) | ||
89 | |||
90 | ;; Some default handlers | ||
91 | |||
92 | (+browse-url-make-external-viewer-handler mpv | ||
93 | :args '("--cache-pause-wait=15" | ||
94 | "--cache-pause-initial=yes") | ||
95 | :prompt "Video URL: ") | ||
96 | |||
97 | (+browse-url-make-external-viewer-handler miv | ||
98 | :program (executable-find "miv") | ||
99 | :prompt "Image URL: ") | ||
100 | |||
101 | ;;; External domains | ||
102 | ;; Some domains just don't open well in `eww'. The following function and user | ||
103 | ;; option define an easy way to automatically open those. | ||
104 | |||
105 | (defcustom +browse-url-external-domains nil | ||
106 | "Domains to open in `browse-url-secondary-browser-function'. | ||
107 | This is just a list of strings. They'll be regexp-escaped and | ||
108 | passed to `+browse-url-external-url-p', which is a good function | ||
109 | to put in `browse-url-handlers'. | ||
110 | |||
111 | If an item in this list is a list itself, it should contain one string, a valid | ||
112 | regexp that will not be regexp-quoted when matching against a url." | ||
113 | :type '(repeat (choice | ||
114 | (list :tag "Regexp" regexp) | ||
115 | (string :tag "Literal string")))) | ||
116 | |||
117 | (with-eval-after-load 'custom-allowed | ||
118 | (add-to-list 'custom-allowed-variables '+browse-url-external-domains)) | ||
119 | |||
120 | (defun +browse-url-external-url-p (url) | ||
121 | "Return t if URL is a member of `+browse-url-external-domains'. | ||
122 | This function only tests URL's domain." | ||
123 | (let ((host (url-host (url-generic-parse-url url)))) | ||
124 | (cl-loop for domain in +browse-url-external-domains | ||
125 | if (string-match-p (if (stringp domain) | ||
126 | (regexp-quote domain) | ||
127 | (car domain)) | ||
128 | host) | ||
129 | return t))) | ||
130 | |||
131 | (defun +browse-url-external-domain-add (domain &optional regexp?) | ||
132 | "Add DOMAIN to `+browse-url-external-domains'. | ||
133 | If REGEXP? is non-nil, it will note that the domain is a regexp. | ||
134 | This function will also save `custom-file' with the updated value." | ||
135 | (interactive (pcase current-prefix-arg | ||
136 | (`nil | ||
137 | (list (read-from-minibuffer "Domain: ") | ||
138 | nil)) | ||
139 | (`(4) | ||
140 | (list (read-from-minibuffer "Domain regex: ") | ||
141 | t)) | ||
142 | (_ | ||
143 | (list (read-from-minibuffer "Domain: ") | ||
144 | (y-or-n-p "Regex? "))))) | ||
145 | (let ((new (funcall (if regexp? #'list #'identity) | ||
146 | domain))) | ||
147 | (custom-set-variables | ||
148 | `(+browse-url-external-domains | ||
149 | ',(add-to-list '+browse-url-external-domains new))) | ||
150 | (with-current-buffer (find-file-noselect custom-file) | ||
151 | (custom-save-variables)) | ||
152 | (message "%s added to `+browse-url-external-domains'." | ||
153 | domain))) | ||
154 | |||
155 | ;;; Downloading | ||
156 | |||
157 | (defcustom +browse-url-download-open t | ||
158 | "Whether to open downloaded files after downloading." | ||
159 | :type 'boolean) | ||
160 | |||
161 | (defun +browse-url-download (url &rest _) | ||
162 | "Download URL to `eww-download-directory'." | ||
163 | (interactive "sDownload URL: ") | ||
164 | (let ((dir eww-download-directory)) | ||
165 | (when (functionp dir) (setq dir (funcall dir))) | ||
166 | (make-directory dir :parents) | ||
167 | (url-retrieve url | ||
168 | (lambda (s u d) | ||
169 | (let ((file (+browse-url-download-callback s u d))) | ||
170 | (when +browse-url-download-open | ||
171 | (browse-url-xdg-open file)))) | ||
172 | (list url dir)))) | ||
173 | |||
174 | (defun +browse-url-download-callback (status url dir) | ||
175 | ;; A slight change to `eww-download-callback' that returns the downloaded | ||
176 | ;; filename. | ||
177 | (unless (plist-get status :error) | ||
178 | (let* ((obj (url-generic-parse-url url)) | ||
179 | (path (directory-file-name (car (url-path-and-query obj)))) | ||
180 | (file (eww-make-unique-file-name | ||
181 | (eww-decode-url-file-name (file-name-nondirectory path)) | ||
182 | dir))) | ||
183 | (goto-char (point-min)) | ||
184 | (re-search-forward "\r?\n\r?\n") | ||
185 | (let ((coding-system-for-write 'no-conversion)) | ||
186 | (write-region (point) (point-max) file)) | ||
187 | (message "Saved %s" file) | ||
188 | file))) | ||
189 | |||
190 | ;;; Unfucking the internet | ||
191 | |||
192 | (defun eww-archiveis-url (url) | ||
193 | "Run URL through archive.is and browse the result." | ||
194 | (interactive (list (plist-get eww-data :url))) | ||
195 | (letrec ((nonce (lambda () | ||
196 | (unwind-protect (eww-readable) | ||
197 | (remove-hook 'eww-after-render-hook nonce))))) | ||
198 | (add-hook 'eww-after-render-hook nonce) | ||
199 | (eww (format "https://archive.is/submit/?url=%s" url)))) | ||
200 | |||
201 | |||
202 | ;;; Packages | ||
203 | |||
204 | (use-package eww | ||
205 | :preface | ||
206 | (defun bookmark-eww--make () | ||
207 | "Make eww bookmark record." | ||
208 | `((filename . ,(plist-get eww-data :url)) | ||
209 | (title . ,(plist-get eww-data :title)) | ||
210 | (time . ,(current-time-string)) | ||
211 | (handler . ,#'bookmark-eww-handler) | ||
212 | (defaults . (,(concat | ||
213 | ;; url without the https and path | ||
214 | (replace-regexp-in-string | ||
215 | "/.*" "" | ||
216 | (replace-regexp-in-string | ||
217 | "\\`https?://" "" | ||
218 | (plist-get eww-data :url))) | ||
219 | " - " | ||
220 | ;; page title | ||
221 | (replace-regexp-in-string | ||
222 | "\\` +\\| +\\'" "" | ||
223 | (replace-regexp-in-string | ||
224 | "[\n\t\r ]+" " " | ||
225 | (plist-get eww-data :title)))))))) | ||
226 | (defun bookmark-eww-handler (bm) | ||
227 | "Handler for eww bookmarks." | ||
228 | (eww-browse-url (alist-get 'filename bm))) | ||
229 | (defun bookmark-eww--setup () | ||
230 | "Setup eww bookmark integration." | ||
231 | (setq-local bookmark-make-record-function #'bookmark-eww--make)) | ||
232 | :commands (eww eww-browse-url) | ||
233 | :config | ||
234 | (setopt eww-use-browse-url ".") | ||
235 | (add-hook 'eww-mode-hook | ||
236 | (defun eww-mode@setup () | ||
237 | (add-hook 'visual-fill-column-mode-hook | ||
238 | (defun visual-fill-column@eww-reload () | ||
239 | (eww-reload :local)))) | ||
240 | nil :local) | ||
241 | (keymap-set eww-mode-map "&" | ||
242 | (defun eww-browse-url-external (&optional url) | ||
243 | (interactive nil eww-mode) | ||
244 | (condition-case e | ||
245 | (funcall | ||
246 | browse-url-secondary-browser-function | ||
247 | (or url (plist-get eww-data :url))) | ||
248 | (:success (when (null url) (quit-window))) ; Interactive use | ||
249 | (t (signal (car e) (cdr e)))))) | ||
250 | (add-hook 'eww-mode-hook #'bookmark-eww--setup) | ||
251 | (define-key eww-mode-map "b" #'bookmark-set) | ||
252 | (define-key eww-mode-map "B" #'bookmark-jump) | ||
253 | (define-key eww-mode-map (kbd "M-n") nil) | ||
254 | (define-key eww-mode-map (kbd "M-p") nil) | ||
255 | (define-key eww-mode-map (kbd "*") #'eww-archiveis-url)) | ||
256 | |||
257 | (use-package browse-url | ||
258 | :demand t | ||
259 | :config | ||
260 | (put 'browse-url-browser-function 'safe-local-variable | ||
261 | '+browse-url-browser-function-safe-p) | ||
262 | (setopt browse-url-browser-function #'eww-browse-url | ||
263 | browse-url-secondary-browser-function #'browse-url-firefox | ||
264 | browse-url-firefox-program (executable-find "firefox") | ||
265 | browse-url-firefox-arguments '("--new-tab") | ||
266 | ;; Dispatch browser based on URL | ||
267 | browse-url-handlers | ||
268 | `(;; Videos | ||
269 | (,(+browse-url-matches "youtube\\.com" "youtu\\.be" | ||
270 | "invidious" "yewtu\\.be" | ||
271 | "twitch\\.tv" | ||
272 | (rx "." (or "mp4" "gif" "mov" "MOV" "webm") | ||
273 | eos)) | ||
274 | . +browse-url-with-mpv) | ||
275 | ;; Music | ||
276 | (,(+browse-url-matches "soundcloud\\.com" "bandcamp\\.com" | ||
277 | (rx "." (or "ogg" "mp3" "opus" "m4a") eos)) | ||
278 | . +browse-url-with-mpv) | ||
279 | ;; Images | ||
280 | (,(+browse-url-matches "pbs\\.twimg\\.com" | ||
281 | (rx "." (or "jpeg" "jpg" "png" "pn" | ||
282 | "bmp" "webp") | ||
283 | eos)) | ||
284 | . +browse-url-with-miv) | ||
285 | ;; Blobs | ||
286 | (,(+browse-url-matches (rx "." (or ".tar.gz" ".pdf") eos)) | ||
287 | . +browse-url-download) | ||
288 | ;; External URLs --- see `+browse-url-external-domains' | ||
289 | (+browse-url-external-url-p | ||
290 | . ,browse-url-secondary-browser-function)) | ||
291 | ;; External domains | ||
292 | ;; +browse-url-external-domains | ||
293 | ;; '("github.com" "gitlab.com" "codeberg.org" | ||
294 | ;; "tildegit.org" "git.tilde.town" | ||
295 | ;; "google.com" "imgur.com" "twitch.tv" | ||
296 | ;; "pixelfed" "instagram.com" | ||
297 | ;; "bibliogram.art" "reddit.com" | ||
298 | ;; "teddit.net" "libreddit.de" | ||
299 | ;; "streamable.com" "spotify.com" | ||
300 | ;; "hetzner.cloud" "melpa.org" | ||
301 | ;; "twitter.com" ("^t\\.co$") | ||
302 | ;; "nitter.snopyta.org" "nitter.net") | ||
303 | ) | ||
304 | ;; External browsers: firefox > chromium > chrome | ||
305 | (when-let ((firefox (choose-executable "firefox" | ||
306 | "firefox-esr"))) | ||
307 | (setopt browse-url-firefox-program firefox | ||
308 | browse-url-firefox-new-window-is-tab t | ||
309 | browse-url-firefox-arguments '("--new-tab") | ||
310 | browse-url-generic-program firefox | ||
311 | browse-url-generic-args browse-url-firefox-arguments)) | ||
312 | (when-let ((chromium (choose-executable "chromium" | ||
313 | "chromium-browser"))) | ||
314 | (setopt browse-url-chromium-program chromium | ||
315 | browse-url-generic-program chromium)) | ||
316 | (when-let ((chrome (choose-executable "chrome" | ||
317 | "google-chrome-stable"))) | ||
318 | (setopt browse-url-chrome-program chrome | ||
319 | browse-url-generic-program chrome))) | ||
320 | |||
321 | (use-package browse-url-transform | ||
322 | :after browse-url | ||
323 | :load-path "~/src/browse-url-transform.el/" | ||
324 | :config | ||
325 | (setopt browse-url-transform-alist | ||
326 | `(;; Privacy-respecting alternatives | ||
327 | ("twitter\\.com" . "nitter.snopyta.org") | ||
328 | ("\\(?:\\(?:old\\.\\)?reddit\\.com\\)" . "libreddit.de") | ||
329 | ("medium\\.com" . "scribe.rip") | ||
330 | (".*substack\\.com.*" . ,substack-proxy) | ||
331 | ;; Text-mode of non-text-mode sites | ||
332 | ("www\\.npr\\.org" . "text.npr.org") | ||
333 | ;; Ask for raw versions of paste sites | ||
334 | ("^.*dpaste\\.com.*$" . "\\&.txt") | ||
335 | ("bpa\\.st/\\(.*\\)" . "bpa.st/raw/\\1") | ||
336 | ("\\(paste\\.debian\\.net\\)/\\(.*\\)" . "\\1/plain/\\2") | ||
337 | ("\\(pastebin\\.com\\)/\\\(.*\\)" . "\\1/raw/\\2") | ||
338 | ("\\(paste\\.centos\\.org/view\\)/\\(.*\\)" . "\\1/raw/\\2"))) | ||
339 | (browse-url-transform-mode)) | ||
340 | |||
341 | ;;; Link hint | ||
342 | |||
343 | (use-package link-hint | ||
344 | :ensure t :demand t | ||
345 | :preface (keymap-global-unset "M-l") | ||
346 | :bind | ||
347 | (("M-l M-l" . +link-hint-open-link) | ||
348 | ("M-l l" . +link-hint-open-link) | ||
349 | ("M-l M-o" . +link-hint-open:secondary) | ||
350 | ("M-l o" . +link-hint-open:secondary) | ||
351 | ("M-l M-m" . +link-hint-open-multiple-links) | ||
352 | ("M-l m" . +link-hint-open-multiple-links) | ||
353 | ("M-l M-w" . link-hint-copy-link) | ||
354 | ("M-l w" . link-hint-copy-link) | ||
355 | ("M-l M-c" . +link-hint-open:chrome) | ||
356 | ("M-l c" . +link-hint-open:chrome) | ||
357 | ("M-l M-d" . +link-hint-open:download) | ||
358 | ("M-l d" . +link-hint-open:download)) | ||
359 | :config | ||
360 | (require '+link-hint) | ||
361 | (setopt link-hint-avy-style 'at-full | ||
362 | link-hint-avy-all-windows t) | ||
363 | ;; For some reason, `link-hint-completion-list-candidate' freezes Emacs. | ||
364 | ;; Removing it fixes the problem, so ... that's what I've done. It's quite | ||
365 | ;; possible this problem isn't caused by `link-hint' at all, but rather by | ||
366 | ;; another package's configuration, but I don't care enough to fix it. | ||
367 | (setq link-hint-types | ||
368 | (delq 'link-hint-completion-list-candidate link-hint-types)) | ||
369 | ;; (+link-hint-open-secondary-setup) | ||
370 | ;; (+link-hint-open-chrome-setup) | ||
371 | ) | ||
372 | |||
373 | (provide 'acdw-web) | ||
374 | ;;; acdw-web.el ends here | ||