1 files changed, 145 insertions, 44 deletions

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