From dc7b26268398cc72eb7fad17acc4adc07fd6f55e Mon Sep 17 00:00:00 2001 From: Case Duckworth Date: Tue, 15 Nov 2022 19:51:16 -0600 Subject: Customize browse-url --- init.el | 75 +++++++++++++++++++++++++++++++++++++ lisp/+browse-url.el | 88 ++++++++++++++++++++++++++++++++++++++++++++ lisp/browse-url-transform.el | 45 ++++++++++++++++++++++ 3 files changed, 208 insertions(+) create mode 100644 lisp/+browse-url.el create mode 100644 lisp/browse-url-transform.el diff --git a/init.el b/init.el index f7dcd7e..0bd11d4 100644 --- a/init.el +++ b/init.el @@ -17,6 +17,7 @@ read-file-name-completion-ignore-case t comment-auto-fill-only-comments t password-cache t + eww-use-browse-url "." ; use `browse-url' in every link password-cache-expiry (* 60 60) initial-buffer-choice (defun +initial-buffer-choose () (cond @@ -904,3 +905,77 @@ CAPES defaults to `+capes'. CAPF will be made un-exclusive." (spinner "https://github.com/Malabarba/spinner.el") (sesman "https://github.com/vspinu/sesman")) :when (executable-find "clojure")) + +(yoke browse-url + (require '+browse-url) + (setf browse-url-browser-function #'eww-browse-url + browse-url-chrome-program (seq-some #'executable-find + '("chromium" "chrome" "google-chrome-stable")) + browse-url-firefox-program (seq-some #'executable-find + '("firefox" "firefox-esr")) + browse-url-generic-program (or browse-url-firefox-program + browse-url-chrome-program) + browse-url-firefox-new-window-is-tab t + browse-url-firefox-arguments "-new-tab" + browse-url-handlers `((video-url-p . +browse-url-with-mpv) + (music-url-p . +browse-url-with-mpv) + (image-url-p . +browse-image-with-mpv) + (blobp . +browse-url-download) + (external-url-p . ,browse-url-secondary-browser-function))) + (+browse-url-make-external-viewer-handler "mpv" '("--cache-pause-wait=30" + "--cache-pause-initial=yes") + "Video URL: " + :fallback browse-url-secondary-browser-function) + (+browse-url-make-external-viewer-handler "mpv" '("--image-display-duration=inf") + "Image URL: " + :name +browse-image-with-mpv) + (defun video-url-p (url) "Is URL a video?" + (string-match-p (rx (or "youtube.com" "youtu.be" "invidious" "yewtu.be" + (seq "." (or "mp4" "gif" "mov" "MOV" "webm") eos))) + url)) + (defun music-url-p (url) "Is URL music?" + (string-match-p (rx "soundcloud.com" "bandcamp.com" + (seq "." (or "ogg" "mp3" "opus" "m4a") eos)) + url)) + (defun image-url-p (url) "Is URL an image?" + (string-match-p (rx "." (or "jpeg" "jpg" "png" "bmp" "webp") eos) + url)) + (defun external-url-p (url) "Should URL open in an external browser?" + (string-match-p (rx (or "github.com" "gitlab.com" "codeberg.org" + "tildegit.org" "git.tilde.town" "google.com" + "imgur.com" "twitch.tv" "pixelfed" "instagram.com" + "bibliogram.art" "reddit.com" "teddit.net" + "twitter.com" "nitter" "t.co" + "streamable.com" "spotify.com" + "hetzner.cloud" "melpa.org")) + url)) + (defun blobp (url) "Is URL some other blob that can't open in Emacs?" + (string-match-p (rx (or (: (or ".tar.gz" ".pdf") + eos))) + url)) + (eval-after chd + (add-to-list 'browse-url-handlers (cons chd/url-regexps #'browse-url-chrome))) + (require 'browse-url-transform) + (setf browse-url-transform-alist `(("twitter\\.com" . "nitter.net") + ("\\(?:\\(?:old\\.\\)?reddit\\.com\\)" + . "libreddit.de") + ("medium\\.com" . "scribe.rip") + ("www\\.npr\\.org" . "text.npr.org"))) + (browse-url-transform-mode)) + +(yoke eww + (defun +eww-browse-with-external-browser (&optional url) + "Browse URL with an external browser and close eww." + (interactive nil eww-mode) + (condition-case e + ;; This is wrapped in a `condition-case' so that the eww window won't + ;; close if there's an error calling the browser. + (funcall browse-url-secondary-browser-function + (or url (plist-get eww-data :url))) + (:success + (when (null url) ; interactive + (quit-window))) + (t (signal (car e) (cdr e))))) + (define-key* eww-mode-map + "&" #'+eww-browse-with-external-browser)) + 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 @@ +;;; +browse-url.el -*- lexical-binding: t -*- + +(require 'browse-url) + +(cl-defmacro +browse-url-make-external-viewer-handler + (viewer default-args + &optional (prompt "URL: ") + &key + (custom-group 'browse-url) + (name (intern (format "+browse-url-with-%s" viewer))) + doc vardoc + (varname (intern (format "%s-args" name))) + (fallback t)) + "Create a `browse-url' handler function calling VIEWER on the url. +This macro also creates a `customize' setting in CUSTOM-GROUP for +VIEWER's command-line arguments. DEFAULT-ARGS specifies the +default arguments for that setting. + +PROMPT is shown to the user in the function's `interactive' spec, +as an argument to `browse-url-interactive-arg'. + +The resulting function is named NAME, which defaults to +`+browse-url-wth-VIEWER'. The custom variable is named VARNAME, +which defaults to `NAME-args'. If DOC or VARDOC are provided, +they'll be the documentation of the function and variable +respectively; otherwise, basic docstrings are used. + +Finally, if FALLBACK is non-nil (by default, it's +`browse-url-generic'), the function will call that if unable to +start VIEWER." + (declare (indent 1)) + `(progn + (defcustom ,varname ,default-args + ,(or doc (format "Arguments to pass to %s in `%s'." viewer name)) + :type '(repeat :tag "Command-line argument" string) + :group ',custom-group) + (defun ,name (url &optional new-window) + ,(or vardoc (format "Open URL in %s." viewer)) + (interactive (browse-url-interactive-arg ,prompt)) + (let* ((url (browse-url-encode-url url)) + (process-environment (browse-url-process-environment))) + (message ,(format "Opening %%s in %s..." viewer) url) + (unless (ignore-errors (apply #'start-process + (format "%s %s" ,viewer url) nil + ,viewer + (append ,varname (list url)))) + ,@(cond + ((eq fallback t) '((browse-url-generic url new-window))) + (fallback `((funcall ,fallback url new-window))) + (:else `((message "Can't find viewer: `%s'" ,viewer) + nil)))))))) + +(defcustom +browse-url-download-open t + "Whether to open downloaded files afterward." + :group 'browse-url + :type 'boolean) + +(defun +browse-url-download-callback (status url dir) + ;; A slight change to `eww-download-callback' that returns the downloaded + ;; filename. + (unless (plist-get status :error) + (let* ((obj (url-generic-parse-url url)) + (path (directory-file-name (car (url-path-and-query obj)))) + (file (eww-make-unique-file-name + (eww-decode-url-file-name (file-name-nondirectory path)) + dir))) + (goto-char (point-min)) + (re-search-forward "\r?\n\r?\n") + (let ((coding-system-for-write 'no-conversion)) + (write-region (point) (point-max) file)) + (message "Saved %s" file) + file))) + +(defun +browse-url-download (url &rest _) + "Download URL to `eww-download-directory'." + (interactive "sDownload URL: ") + (let ((dir eww-download-directory)) + (when (functionp dir) (setq dir (funcall dir))) + (make-directory dir :parents) + (url-retrieve url + (lambda (s u d) + (let ((file (+browse-url-download-callback s u d))) + (when +browse-url-download-open + (browse-url-xdg-open file)))) + (list url dir)))) + +(provide '+browse-url) +;;; +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 @@ +;;; browse-url-transform --- transform URLs + +(defgroup browse-url-transform nil + "Transformations for urls passed to `browse-url'." + :group 'browse-url) + +(defcustom browse-url-transform-alist nil + "Transformation rules for URLs. +The keys are regexps matching URLs, and the values are how to +transform them. The replacements will use match capture data." + :type '(alist :key-type (string :tag "URL regexp match") + :value-type (string :tag "URL regexp transformation"))) + +(defun browse-url-transform-url (url) + "Transform URL before passing it to `browse-url'." + (cl-loop with url = (substring-no-properties + (if (consp url) (car url) url)) + for (regex . transformation) in browse-url-transform-alist + if (string-match regex url) + return (replace-match transformation nil nil url) + finally return url)) + +(defun browse-url-transform-advice (url &rest args) + "Advice to `browse-url' for URL transformations. +ARGS are passed on for further processing." + (apply #'list (and url (browse-url-transform-url url)) args)) + +(define-minor-mode browse-url-transform-mode + "Minor mode to transform a URL before passing it to `browse-url'. +This can be used to \"redirect\" URLs, for example from an +information silo to a more privacy-respecting one (e.g., +\"twitter.com\" -> \"nitter.com\"), by adding advice to `browse-url'. + +When using this mode, ensure that the transformed URL is also in +`browse-url-handlers', since that's what `browse-url' will see." + :lighter " Turl" + :keymap nil + :global t + (cond (browse-url-transform-mode + (advice-add 'browse-url :filter-args #'browse-url-transform-advice)) + (:else + (advice-remove 'browse-url #'browse-url-transform-advice)))) + +(provide 'browse-url-transform) +;;; browse-url-transform.el ends here -- cgit 1.4.1-21-gabe81