From 59a1f58695d09ab29ddf992b2c0711c94a4039ea Mon Sep 17 00:00:00 2001 From: Case Duckworth Date: Tue, 3 Jan 2023 23:03:03 -0600 Subject: Switch to use-package --- lisp/+browse-url.el | 189 ++++++++++++++++++++++++++++++++++++++++------------ 1 file changed, 145 insertions(+), 44 deletions(-) (limited to 'lisp/+browse-url.el') diff --git a/lisp/+browse-url.el b/lisp/+browse-url.el index 12e433c..b65b6f9 100644 --- a/lisp/+browse-url.el +++ b/lisp/+browse-url.el @@ -1,60 +1,101 @@ -;;; +browse-url.el -*- lexical-binding: t -*- +;;; +browse-url.el -*- lexical-binding: t; -*- (require 'browse-url) +(require 'cl-lib) +(require 'seq) +(require 'url-util) + +(defgroup +browse-url nil + "My `browse-url' extras." + :group 'browse-url) + +;;; External URL handlers (cl-defmacro +browse-url-make-external-viewer-handler - (viewer default-args - &optional (prompt "URL: ") - &key - (custom-group 'browse-url) - (name (intern (format "+browse-url-with-%s" viewer))) - doc vardoc - (varname (intern (format "%s-args" name))) - (fallback t)) - "Create a `browse-url' handler function calling VIEWER on the url. + (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 -VIEWER's command-line arguments. DEFAULT-ARGS specifies the -default arguments for that setting. +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'. +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-wth-VIEWER'. The custom variable is named VARNAME, -which defaults to `NAME-args'. If DOC or VARDOC are provided, -they'll be the documentation of the function and variable -respectively; otherwise, basic docstrings are used. - -Finally, if FALLBACK is non-nil (by default, it's -`browse-url-generic'), the function will call that if unable to -start VIEWER." +`+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 ,varname ,default-args - ,(or doc (format "Arguments to pass to %s in `%s'." viewer name)) + (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 vardoc (format "Open URL in %s." viewer)) + ,(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 - ,viewer - (append ,varname (list url)))) + (format "%s %s" ',viewer url) + nil + ,program + (append ,var (list url)))) ,@(cond - ((eq fallback t) '((browse-url-generic url new-window))) (fallback `((funcall ,fallback url new-window))) - (:else `((message "Can't find viewer: `%s'" ,viewer) + (: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: ") + +;;; Downloading + (defcustom +browse-url-download-open t - "Whether to open downloaded files afterward." - :group 'browse-url + "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. @@ -71,18 +112,78 @@ start VIEWER." (message "Saved %s" file) file))) -(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)))) +;;; 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 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))) + +;;; Switch to an external browser from an Emacs browser + +(defmacro +browse-url-switch-external-browser (mode url-fetcher-form) + "Create a function for MODE to open an external browser. +URL-FETCHER-FORM will be used to get the URL of the current visited page." + (declare (indent 1)) + `(defun ,(intern (format "+browse-url-external-from-%s" mode)) + (&optional url) + "Browse URL with `browse-url-secondary-browser-function'. +This will close the current buffer." + (interactive nil ,mode) + (condition-case e + (funcall browse-url-secondary-browser-function + (or url ,url-fetcher-form)) + (:success (when (null url) (quit-window))) ; Interactive use + (t (signal (car e) (cdr e)))))) + +;;; Mark `browse-url-browser-function' as safe + +(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))))))) (provide '+browse-url) ;;; +browse-url.el ends here -- cgit 1.4.1-21-gabe81