bug#19556: eww: make URI rewriting fully customizable

[Ivan Shmakov]

>>>>> Eli Zaretskii <eliz@gnu.org> writes:

[…]

 > Similarly, eww's job is to find and visit a URL, which includes
 > processing file:// URLs, and that functionality should always be in
 > the function, not in any hook.

        file: URIs’ processing is the responsibility of url-file.el.
        There’s nothing in ‘eww’ which ever deals with such URIs, –
        /except/ for a simple guard which tells: “if it begins with
        ‘file:/’, do /not/ never, ever mangle it.”

        Personally, I’d rather appreciate having such a guard for https:
        and http: URIs at the least, – if only for the sake of
        consistency.

[…]

 > To _override_ behavior, we provide function variables that get used
 > _instead_ of the default.  Like indent-region-function, for example.
 > So in that case, you'd need to make 'eww' call the value of
 > eww-mangle-uri-function, whose default value is a function that does
 > what the current code does inside eww itself, and then users could
 > override that by providing their own URI-mangling function.

        Please consider the patch MIMEd.

        * lisp/net/eww.el
        (eww-uri-rewrite-function): New customizable variable.
        (eww): Use eww-uri-rewrite-function.
        (eww-mangle-uri): New function, split off eww.

-- 
FSF associate member #7257  http://boycottsystemd.org/  … 3013 B6A0 230E 334A

--- a/lisp/net/eww.el   2015-01-10 16:26:37 +0000
+++ b/lisp/net/eww.el   2015-01-10 17:59:44 +0000
@@ -75,6 +75,15 @@
             url-get-url-at-point
             eww-current-url))
 
+(defcustom eww-uri-rewrite-function
+  'eww-uri-rewrite
+  "A function to call to pre-process the argument to `eww'."
+  :version "25.1"
+  :group 'eww
+  :type 'hook
+  :options '(eww-uri-rewrite
+            identity))
+
 (defcustom eww-bookmarks-directory user-emacs-directory
   "Directory where bookmark files will be stored."
   :version "25.1"
@@ -249,28 +258,7 @@
                          (if uris (format " (default %s)" (car uris)) "")
                          ": ")))
      (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 (or (string-match "\\`https?:" url)
-                ;; Also try to match "naked" URLs like
-                ;; en.wikipedia.org/wiki/Free software
-                (string-match "\\`[A-Za-z_]+\\.[A-Za-z._]+/" url)
-                (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 sites do not 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))))))
+  (setq url (funcall eww-uri-rewrite-function (string-trim url)))
   (if (eq major-mode 'eww-mode)
       (when (or (plist-get eww-data :url)
                (plist-get eww-data :dom))
@@ -556,6 +545,31 @@
        (list (get-text-property (point) 'shr-url)
              (get-text-property (point) 'image-url))))
 
+(defun eww-uri-rewrite (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 (or (string-match "\\`https?:" url)
+                ;; Also try to match "naked" URLs like
+                ;; en.wikipedia.org/wiki/Free software
+                (string-match "\\`[A-Za-z_]+\\.[A-Za-z._]+/" url)
+                (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 sites do not 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))))))
+  ;; .
+  url)
+
 (defun eww-view-source ()
   "View the HTML source code of the current page."
   (interactive)