;;; acdw.web.el --- Web browsing and such -*- lexical-binding: t; -*- ;;; Code: (require 'cl-lib) (defcustom +browse-url-other-safe-browser-functions nil "Other safe browser functions." :type '(repeat function)) (defun +browse-url-browser-function-safe-p (f) "Return t if F is a safe browser function." (memq f (append +browse-url-other-safe-browser-functions (mapcar (lambda (i) (plist-get (cdr i) :value)) (seq-filter (lambda (i) (eq (car i) 'function-item)) (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 eww :config (setopt eww-use-browse-url ".") (add-hook 'eww-mode-hook (defun eww-mode@setup () (add-hook 'visual-fill-column-mode-hook (defun visual-fill-column@eww-reload () (eww-reload :local)))) nil :local) (keymap-set eww-mode-map "&" (defun eww-browse-url-external (&optional url) (interactive nil eww-mode) (condition-case e (funcall browse-url-secondary-browser-function (or url (plist-get eww-data :url))) (:success (when (null url) (quit-window))) ; Interactive use (t (signal (car e) (cdr e))))))) (use-package browse-url :demand t :config (put 'browse-url-browser-function 'safe-local-variable '+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" "youtu\\.be" "invidious" "yewtu\\.be" "twitch\\.tv" (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))) (use-package browse-url-transform :after browse-url :load-path "~/src/emacs/browse-url-transform/" :config (setopt browse-url-transform-alist `(;; Privacy-respecting alternatives ("twitter\\.com" . "nitter.snopyta.org") ("\\(?:\\(?:old\\.\\)?reddit\\.com\\)" . "libreddit.de") ("medium\\.com" . "scribe.rip") (".*substack\\.com.*" . ,substack-proxy) ;; Text-mode of non-text-mode sites ("www\\.npr\\.org" . "text.npr.org") ;; Ask for raw versions of paste sites ("^.*dpaste\\.com.*$" . "\\&.txt") ("bpa\\.st/\\(.*\\)" . "bpa.st/raw/\\1") ("\\(paste\\.debian\\.net\\)/\\(.*\\)" . "\\1/plain/\\2") ("\\(pastebin\\.com\\)/\\\(.*\\)" . "\\1/raw/\\2") ("\\(paste\\.centos\\.org/view\\)/\\(.*\\)" . "\\1/raw/\\2"))) (browse-url-transform-mode)) ;;; Link hint (use-package link-hint :ensure t :demand t :preface (keymap-global-unset "M-l") :bind (("M-l M-l" . +link-hint-open-link) ("M-l l" . +link-hint-open-link) ("M-l M-o" . +link-hint-open-secondary) ("M-l o" . +link-hint-open-secondary) ("M-l M-m" . +link-hint-open-multiple-links) ("M-l m" . +link-hint-open-multiple-links) ("M-l M-w" . link-hint-copy-link) ("M-l w" . link-hint-copy-link) ("M-l M-c" . +link-hint-open-chrome) ("M-l c" . +link-hint-open-chrome)) :config (require '+link-hint) (setopt link-hint-avy-style 'at-full link-hint-avy-all-windows t) ;; For some reason, `link-hint-completion-list-candidate' freezes Emacs. ;; Removing it fixes the problem, so ... that's what I've done. It's quite ;; possible this problem isn't caused by `link-hint' at all, but rather by ;; another package's configuration, but I don't care enough to fix it. (setq link-hint-types (delq 'link-hint-completion-list-candidate link-hint-types)) (+link-hint-open-secondary-setup) (+link-hint-open-chrome-setup)) (provide 'acdw-web) ;;; acdw-web.el ends here