summary refs log tree commit diff stats
path: root/lisp
diff options
context:
space:
mode:
authorCase Duckworth2022-11-15 19:51:16 -0600
committerCase Duckworth2022-11-15 19:51:16 -0600
commitdc7b26268398cc72eb7fad17acc4adc07fd6f55e (patch)
tree34c9727bbbb9d99a27fa8567d7ad4f0459468df2 /lisp
parentAdd `yoke-dirs' and functions working on them (diff)
downloademacs-dc7b26268398cc72eb7fad17acc4adc07fd6f55e.tar.gz
emacs-dc7b26268398cc72eb7fad17acc4adc07fd6f55e.zip
Customize browse-url
Diffstat (limited to 'lisp')
-rw-r--r--lisp/+browse-url.el88
-rw-r--r--lisp/browse-url-transform.el45
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.
15This macro also creates a `customize' setting in CUSTOM-GROUP for
16VIEWER's command-line arguments. DEFAULT-ARGS specifies the
17default arguments for that setting.
18
19PROMPT is shown to the user in the function's `interactive' spec,
20as an argument to `browse-url-interactive-arg'.
21
22The resulting function is named NAME, which defaults to
23`+browse-url-wth-VIEWER'. The custom variable is named VARNAME,
24which defaults to `NAME-args'. If DOC or VARDOC are provided,
25they'll be the documentation of the function and variable
26respectively; otherwise, basic docstrings are used.
27
28Finally, if FALLBACK is non-nil (by default, it's
29`browse-url-generic'), the function will call that if unable to
30start 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.
9The keys are regexps matching URLs, and the values are how to
10transform 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.
25ARGS 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'.
30This can be used to \"redirect\" URLs, for example from an
31information silo to a more privacy-respecting one (e.g.,
32\"twitter.com\" -> \"nitter.com\"), by adding advice to `browse-url'.
33
34When 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