From 43bed1f97e6f1a229553d7a25dc437741326772e Mon Sep 17 00:00:00 2001 From: Case Duckworth Date: Wed, 10 May 2023 13:08:35 -0500 Subject: Bankruptcy 10 --- lisp/acdw-web.el | 374 ------------------------------------------------------- 1 file changed, 374 deletions(-) delete mode 100644 lisp/acdw-web.el (limited to 'lisp/acdw-web.el') diff --git a/lisp/acdw-web.el b/lisp/acdw-web.el deleted file mode 100644 index 3b78e4d..0000000 --- a/lisp/acdw-web.el +++ /dev/null @@ -1,374 +0,0 @@ -;;; 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 miv - :program (executable-find "miv") - :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")))) - -(with-eval-after-load 'custom-allowed - (add-to-list 'custom-allowed-variables '+browse-url-external-domains)) - -(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))) - -(defun +browse-url-external-domain-add (domain &optional regexp?) - "Add DOMAIN to `+browse-url-external-domains'. -If REGEXP? is non-nil, it will note that the domain is a regexp. -This function will also save `custom-file' with the updated value." - (interactive (pcase current-prefix-arg - (`nil - (list (read-from-minibuffer "Domain: ") - nil)) - (`(4) - (list (read-from-minibuffer "Domain regex: ") - t)) - (_ - (list (read-from-minibuffer "Domain: ") - (y-or-n-p "Regex? "))))) - (let ((new (funcall (if regexp? #'list #'identity) - domain))) - (custom-set-variables - `(+browse-url-external-domains - ',(add-to-list '+browse-url-external-domains new))) - (with-current-buffer (find-file-noselect custom-file) - (custom-save-variables)) - (message "%s added to `+browse-url-external-domains'." - domain))) - -;;; 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))) - -;;; Unfucking the internet - -(defun eww-archiveis-url (url) - "Run URL through archive.is and browse the result." - (interactive (list (plist-get eww-data :url))) - (letrec ((nonce (lambda () - (unwind-protect (eww-readable) - (remove-hook 'eww-after-render-hook nonce))))) - (add-hook 'eww-after-render-hook nonce) - (eww (format "https://archive.is/submit/?url=%s" url)))) - - -;;; Packages - -(use-package eww - :preface - (defun bookmark-eww--make () - "Make eww bookmark record." - `((filename . ,(plist-get eww-data :url)) - (title . ,(plist-get eww-data :title)) - (time . ,(current-time-string)) - (handler . ,#'bookmark-eww-handler) - (defaults . (,(concat - ;; url without the https and path - (replace-regexp-in-string - "/.*" "" - (replace-regexp-in-string - "\\`https?://" "" - (plist-get eww-data :url))) - " - " - ;; page title - (replace-regexp-in-string - "\\` +\\| +\\'" "" - (replace-regexp-in-string - "[\n\t\r ]+" " " - (plist-get eww-data :title)))))))) - (defun bookmark-eww-handler (bm) - "Handler for eww bookmarks." - (eww-browse-url (alist-get 'filename bm))) - (defun bookmark-eww--setup () - "Setup eww bookmark integration." - (setq-local bookmark-make-record-function #'bookmark-eww--make)) - :commands (eww eww-browse-url) - :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)))))) - (add-hook 'eww-mode-hook #'bookmark-eww--setup) - (define-key eww-mode-map "b" #'bookmark-set) - (define-key eww-mode-map "B" #'bookmark-jump) - (define-key eww-mode-map (kbd "M-n") nil) - (define-key eww-mode-map (kbd "M-p") nil) - (define-key eww-mode-map (kbd "*") #'eww-archiveis-url)) - -(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 - browse-url-secondary-browser-function #'browse-url-firefox - browse-url-firefox-program (executable-find "firefox") - browse-url-firefox-arguments '("--new-tab") - ;; 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" "pn" - "bmp" "webp") - eos)) - . +browse-url-with-miv) - ;; 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" - "chromium-browser"))) - (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/browse-url-transform.el/" - :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) - ("M-l M-d" . +link-hint-open:download) - ("M-l d" . +link-hint-open:download)) - :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 -- cgit 1.4.1-21-gabe81