1 files changed, 195 insertions, 1 deletions

@@ -16,13 +16,207 @@
                                       (cdr (get 'browse-url-browser-function
                                                 'custom-type)))))))
 
+;;; URL matcher generators
+
+(defun +browse-url-matches (&rest regexps)
+  "Return a lambda that will determine if a url matches REGEXPS.
+Each regexp will be tested in turn.  The first one that matches
+is returned by the lambda.
+
+This is a good function to use in key positions in `browse-url-handlers'."
+  `(lambda (url &optional new-window)
+     (cl-loop for regexp in ',regexps
+              if (string-match-p regexp url)
+              return regexp)))
+;;; External URL handlers
+
+(cl-defmacro +browse-url-make-external-viewer-handler
+    (viewer
+     &key
+     args
+     (prompt "URL: ")
+     (program (executable-find (format "%s" viewer)))
+     (name (intern (format "+browse-url-with-%s" viewer)))
+     doc
+     (var (intern (format "%s-args" name)))
+     vardoc
+     (custom-group '+browse-url)
+     (fallback '(function browse-url-generic)))
+  "Create a `browse-url' handler function calling PROGRAM on the URL.
+This macro also creates a `customize' setting in CUSTOM-GROUP for
+PROGRAM's command-line arguments.  ARGS specifies the
+default arguments for this user option.
+
+PROGRAM defaults to the result of calling `executable-find' on VIEWER.
+
+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-with-VIEWER'.  The custom variable is named VAR, which defaults
+to `NAME-args'.  If DOC or VARDOC are provided, they'll be the documentation of
+the function and variable respectively; otherwise a basic default doc-string is
+used.
+
+If FALLBACK is non-nil (the default is `browse-url-generic'), the
+generated function will call FALLBACK if unable to start PROGRAM
+for some reason."
+  (declare (indent 1))
+  `(progn
+     (defcustom ,var ,args
+       ,(or vardoc (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 doc (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
+                                       ,program
+                                       (append ,var (list url))))
+           ,@(cond
+              (fallback `((funcall ,fallback url new-window)))
+              (:else `((message "Can't find viewer: %s" ,viewer)
+                       nil))))))))
+
+;; Some default handlers
+
+(+browse-url-make-external-viewer-handler mpv
+  :args '("--cache-pause-wait=15"
+          "--cache-pause-initial=yes")
+  :prompt "Video URL: ")
+
+(+browse-url-make-external-viewer-handler mpv-image
+  :program (executable-find "mpv")
+  :args '("--image-display-duration=inf")
+  :prompt "Image URL: ")
+
+;;; External domains
+;; Some domains just don't open well in `eww'.  The following function and user
+;; option define an easy way to automatically open those.
+
+(defcustom +browse-url-external-domains nil
+  "Domains to open in `browse-url-secondary-browser-function'.
+This is just a list of strings.  They'll be regexp-escaped and
+passed to `+browse-url-external-url-p', which is a good function
+to put in `browse-url-handlers'.
+
+If an item in this list is a list itself, it should contain one string, a valid
+regexp that will not be regexp-quoted when matching against a url."
+  :type '(repeat (choice
+                  (list :tag "Regexp" regexp)
+                  (string :tag "Literal string"))))
+
+(defun +browse-url-external-url-p (url)
+  "Return t if URL is a member of `+browse-url-external-domains'.
+This function only tests URL's domain."
+  (let ((host (url-host (url-generic-parse-url url))))
+    (cl-loop for domain in +browse-url-external-domains
+             if (string-match-p (if (stringp domain)
+                                    (regexp-quote domain)
+                                  (car domain))
+                                host)
+             return t)))
+
+
+;;; Downloading
+
+(defcustom +browse-url-download-open t
+  "Whether to open downloaded files after downloading."
+  :type 'boolean)
+
+(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))))
+
+(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)))
+
 
 ;;; Packages
 
 (use-package browse-url
+  :demand t
   :config
   (put 'browse-url-browser-function 'safe-local-variable
-       '+browse-url-browser-function-safe-p))
+       '+browse-url-browser-function-safe-p)
+  (setopt browse-url-browser-function #'eww-browse-url
+          ;; Dispatch browser based on URL
+          browse-url-handlers
+          `(;; Videos
+            (,(+browse-url-matches "youtube\\.com" "yoiutu\\.be"
+                                   "invidious" "yewtu\\.be"
+                                   (rx "." (or "mp4" "gif" "mov" "MOV" "webm")
+                                       eos))
+             . +browse-url-with-mpv)
+            ;; Music
+            (,(+browse-url-matches "soundcloud\\.com" "bandcamp\\.com"
+                                   (rx "." (or "ogg" "mp3" "opus" "m4a") eos))
+             . +browse-url-with-mpv)
+            ;; Images
+            (,(+browse-url-matches "pbs\\.twimg\\.com"
+                                   (rx "." (or "jpeg" "jpg" "png" "bmp" "webp")
+                                       eos))
+             . +browse-url-with-mpv-image)
+            ;; Blobs
+            (,(+browse-url-matches (rx "." (or ".tar.gz" ".pdf") eos))
+             . +browse-url-download)
+            ;; External URLs --- see `+browse-url-external-domains'
+            (+browse-url-external-url-p
+             . ,browse-url-secondary-browser-function))
+          ;; External domains
+          +browse-url-external-domains '("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" "libreddit.de"
+                                         "streamable.com" "spotify.com"
+                                         "hetzner.cloud" "melpa.org"
+                                         "twitter.com" ("^t\\.co$")
+                                         "nitter.snopyta.org" "nitter.net"))
+  ;; External browsers: firefox > chromium > chrome
+  (when-let ((firefox (choose-executable "firefox"
+                                         "firefox-esr")))
+    (setopt browse-url-firefox-program firefox
+            browse-url-firefox-new-window-is-tab t
+            browse-url-firefox-arguments '("--new-tab")
+            browse-url-generic-program firefox
+            browse-url-generic-args browse-url-firefox-arguments))
+  (when-let ((chromium (choose-executable "chromium")))
+    (setopt browse-url-chromium-program chromium
+            browse-url-generic-program chromium))
+  (when-let ((chrome (choose-executable "chrome"
+                                        "google-chrome-stable")))
+    (setopt browse-url-chrome-program chrome
+            browse-url-generic-program chrome)))
 
 (provide 'acdw-web)
 ;;; acdw-web.el ends here