bug#19556: eww: make URI rewriting fully customizable

[Ivan Shmakov]

Package:  emacs
Severity: minor

        As of 88bc8332eb14 (2015-01-07 13:51:41 +0000), the ‘eww’
        command follows a hard-coded set of rules to rewrite the
        argument given into a URI suitable for url-retrieve.

        I hereby suggest to make these rules fully customizable, per the
        patch MIMEd.

        * lisp/net/eww.el
        (eww-uri-rewrite-hook): New customizable variable.
        (eww): Use eww-uri-rewrite-hook.
        (eww-search-words): Use eww-uri-search.
        (eww-uri-file, eww-uri-not-supported, eww-uri-search)
        (eww-uri-remote-prepend-http): New functions, split off eww.

        FWIW, removing eww-search-words from the hook allows one to type
        something like https://en.wikipedia.org/wiki/Free software RET
        (note the blank) at the prompt and be with that.

        On top of this, eww-uri-file may then be changed slightly to
        deal with #19472.

-- 
FSF associate member #7257  np. Tree of Love — Jami Sieber   … B6A0 230E 334A

--- a/lisp/net/eww.el
+++ b/lisp/net/eww.el
@@ -75,6 +75,26 @@ defcustom eww-suggest-uris
             url-get-url-at-point
             eww-current-url))
 
+(defcustom eww-uri-rewrite-hook
+  '(eww-uri-file
+    eww-uri-not-supported
+    eww-uri-remote-prepend-http
+    eww-uri-search)
+  "List of functions called to deal with the argument to `eww'.
+These functions will be called in order, with the argument given to
+`eww' passed as their only argument, until one returns non-nil.  The
+value returned will be used as the URI to fetch.
+
+Should no function of those listed return non-nil, `eww' will use its
+argument unaltered."
+  :version "25.1"
+  :group 'eww
+  :type 'hook
+  :options '(eww-uri-file
+            eww-uri-not-supported
+            eww-uri-remote-prepend-http
+            eww-uri-search))
+
 (defcustom eww-bookmarks-directory user-emacs-directory
   "Directory where bookmark files will be stored."
   :version "25.1"
@@ -250,23 +270,9 @@ defun eww (url)
                          ": ")))
      (list (read-string prompt nil nil uris))))
   (setq url (string-trim url))
-  (cond ((string-match-p "\\`file:/" url))
-       ;; Don't mangle file: URLs at all.
-        ((string-match-p "\\`ftp://"; url)
-         (user-error "FTP is not supported."))
-        (t
-         (if (and (= (length (split-string url)) 1)
-                 (or (and (not (string-match-p "\\`[\"\'].*[\"\']\\'" url))
-                          (> (length (split-string url "[.:]")) 1))
-                     (string-match eww-local-regex url)))
-             (progn
-               (unless (string-match-p "\\`[a-zA-Z][-a-zA-Z0-9+.]*://" url)
-                 (setq url (concat "http://"; url)))
-               ;; some site don't redirect final /
-               (when (string= (url-filename (url-generic-parse-url url)) "")
-                 (setq url (concat url "/"))))
-           (setq url (concat eww-search-prefix
-                             (replace-regexp-in-string " " "+" url))))))
+  (when-let ((new (run-hook-with-args-until-success
+                  'eww-uri-rewrite-hook url)))
+    (setq url new))
   (if (eq major-mode 'eww-mode)
       (when (or (plist-get eww-data :url)
                (plist-get eww-data :dom))
@@ -292,11 +299,11 @@ defun eww-open-file (file)
               (expand-file-name file))))
 
 ;;;###autoload
-(defun eww-search-words (&optional beg end)
+(defun eww-search-words (beg end)
   "Search the web for the text between the point and marker.
 See the `eww-search-prefix' variable for the search engine used."
   (interactive "r")
-  (eww (buffer-substring beg end)))
+  (eww (eww-uri-search (buffer-substring beg end))))
 
 (defun eww-render (status url &optional point buffer encode)
   (let ((redirect (plist-get status :redirect)))
@@ -551,6 +559,46 @@ defun eww-links-at-point (&optional pt)
        (list (get-text-property (point) 'shr-url)
              (get-text-property (point) 'image-url))))
 
+(defun eww-uri-file (uri)
+  "Return URI unaltered if it looks like a valid file: scheme URI."
+  (and (string-match-p "\\`file:/" uri)
+       uri))
+
+(defun eww-uri-not-supported (uri)
+  "Raise an error if URI uses the ftp: scheme."
+  (when (string-match-p "\\`ftp://"; url)
+    (user-error "FTP is not supported.")))
+
+(defun eww-uri-remote-prepend-http (uri)
+  "Return URI if it looks like a reference to a remote resource.
+Specifically, return URI if it contains no whitespace characters
+ (except for leading and trailing whitespace, which is ignored) and
+either matches `eww-local-regex', or contains a . or :, but no single-
+or double-quoted parts.
+
+Prepend http:// to URI unless it already has a scheme."
+  (when (and (= (length (split-string uri)) 1)
+            (or (and (not (string-match-p "\\`[\"\'].*[\"\']\\'" uri))
+                     (> (length (split-string uri "[.:]")) 1))
+                (string-match eww-local-regex uri)))
+    (unless (string-match-p "\\`[a-zA-Z][-a-zA-Z0-9+.]*://" uri)
+      (setq uri (concat "http://"; uri)))
+    (setq uri (replace-regexp-in-string " " "%20" uri))
+    ;; Some sites don't redirect final /.
+    (if (string= (url-filename (url-generic-parse-url uri)) "")
+       (concat uri "/")
+      uri)))
+
+(defun eww-uri-search (keywords)
+  "Return an URI for the search given by KEYWORDS.
+KEYWORDS may be either a list or a string.
+
+See the `eww-search-prefix' variable for the search engine used."
+  (concat eww-search-prefix
+         (if (listp keywords)
+             (mapconcat #'identity keywords "+")
+           (subst-char-in-string 32 ?+ keywords))))
+
 (defun eww-view-source ()
   "View the HTML source code of the current page."
   (interactive)