From 86de4b0c9823135ad75fed861b6c6c691be507e8 Mon Sep 17 00:00:00 2001 From: Case Duckworth Date: Tue, 17 Jan 2023 10:21:25 -0600 Subject: Add acdw-web.el Haven't finished it yet, need specifically link-hint --- lisp/acdw-web.el | 196 ++++++++++++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 195 insertions(+), 1 deletion(-) diff --git a/lisp/acdw-web.el b/lisp/acdw-web.el index 080cd9a..28fcd02 100644 --- a/lisp/acdw-web.el +++ b/lisp/acdw-web.el @@ -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 -- cgit 1.4.1-21-gabe81