path: root/lisp/acdw-web.el

;;; 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