Customize browse-url

3 files changed, 208 insertions, 0 deletions

@@ -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))
+
@@ -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
@@ -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