bug#19556: eww: make URI rewriting fully customizable

[Ivan Shmakov <ivan@siamics.net>]

[-- Attachment #1: Type: text/plain, Size: 1347 bytes --]

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

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: Type: text/diff, Size: 3192 bytes --]

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