From cbf8ea6f7f527fe97039f6f1e99c78258ec18ac2 Mon Sep 17 00:00:00 2001
From: Lars Magne Ingebrigtsen <larsi@gnus.org>
Date: Thu, 13 Nov 2014 17:02:07 +0100
Subject: [PATCH] Display SVG images in external <object> files

Fixes: debbugs:16244

* net/eww.el (eww-form-file): Fix version number.

* net/shr.el (shr-parse-image-data): Remove blocked bits from
external SVG images.
(shr-tag-object): Display images in <object> forms.
(shr-tag-table): Also insert <objects> after the tables.
---
 lisp/net/eww.el | 11 ++++----
 lisp/net/shr.el | 69 +++++++++++++++++++++++++++++++++++--------------
 2 files changed, 55 insertions(+), 25 deletions(-)

diff --git a/lisp/net/eww.el b/lisp/net/eww.el
index f16ecb8c172..329c94407c2 100644
--- a/lisp/net/eww.el
+++ b/lisp/net/eww.el
@@ -420,11 +420,12 @@ word(s) will be searched for via `eww-search-prefix'."
   (let ((buf (get-buffer-create "*eww-source*"))
         (source (plist-get eww-data :source)))
     (with-current-buffer buf
-      (delete-region (point-min) (point-max))
-      (insert (or source "no source"))
-      (goto-char (point-min))
-      (when (fboundp 'html-mode)
-        (html-mode)))
+      (let ((inhibit-read-only t))
+	(delete-region (point-min) (point-max))
+	(insert (or source "no source"))
+	(goto-char (point-min))
+	(when (fboundp 'html-mode)
+	  (html-mode))))
     (view-buffer buf)))
 
 (defun eww-readable ()
diff --git a/lisp/net/shr.el b/lisp/net/shr.el
index 5db03244780..7a5e2942d5d 100644
--- a/lisp/net/shr.el
+++ b/lisp/net/shr.el
@@ -783,6 +783,8 @@ element is the data blob and the second element is the content-type."
 		     ((eq size 'original)
 		      (create-image data nil t :ascent 100
 				    :format content-type))
+		     ((eq content-type 'image/svg+xml)
+		      (create-image data 'svg t :ascent 100))
 		     ((eq size 'full)
 		      (ignore-errors
 			(shr-rescale-image data content-type)))
@@ -845,14 +847,25 @@ Return a string with image data."
 	(shr-parse-image-data)))))
 
 (defun shr-parse-image-data ()
-  (list
-   (buffer-substring (point) (point-max))
-   (save-excursion
-     (save-restriction
-       (narrow-to-region (point-min) (point))
-       (let ((content-type (mail-fetch-field "content-type")))
-	 (and content-type
-	      (intern content-type obarray)))))))
+  (let ((data (buffer-substring (point) (point-max)))
+	(content-type
+	 (save-excursion
+	   (save-restriction
+	     (narrow-to-region (point-min) (point))
+	     (let ((content-type (mail-fetch-field "content-type")))
+	       (and content-type
+		    ;; Remove any comments in the type string.
+		    (intern (replace-regexp-in-string ";.*" "" content-type)
+			    obarray)))))))
+    ;; SVG images may contain references to further images that we may
+    ;; want to block.  So special-case these by parsing the XML data
+    ;; and remove the blocked bits.
+    (when (eq content-type 'image/svg+xml)
+      (setq data
+	    (shr-dom-to-xml
+	     (shr-transform-dom
+	      (libxml-parse-xml-region (point) (point-max))))))
+    (list data content-type)))
 
 (defun shr-image-displayer (content-function)
   "Return a function to display an image.
@@ -1130,18 +1143,32 @@ ones, in case fg and bg are nil."
       (shr-urlify (or shr-start start) (shr-expand-url url) title))))
 
 (defun shr-tag-object (cont)
-  (let ((start (point))
-	url)
-    (dolist (elem cont)
-      (when (eq (car elem) 'embed)
-	(setq url (or url (cdr (assq :src (cdr elem))))))
-      (when (and (eq (car elem) 'param)
-		 (equal (cdr (assq :name (cdr elem))) "movie"))
-	(setq url (or url (cdr (assq :value (cdr elem)))))))
-    (when url
-      (shr-insert " [multimedia] ")
-      (shr-urlify start (shr-expand-url url)))
-    (shr-generic cont)))
+  (unless shr-inhibit-images
+    (let ((start (point))
+	  url multimedia image)
+      (dolist (elem cont)
+	(cond
+	 ((eq (car elem) 'embed)
+	  (setq url (or url (cdr (assq :src (cdr elem))))
+		multimedia t))
+	 ((and (eq (car elem) 'param)
+	       (equal (cdr (assq :name (cdr elem))) "movie"))
+	  (setq url (or url (cdr (assq :value (cdr elem))))
+		multimedia t))
+	 ((and (eq (car elem) :type)
+	       (string-match "\\`image/svg" (cdr elem)))
+	  (setq url (cdr (assq :data cont))
+		image t))))
+      (when url
+	(cond
+	 (image
+	  (shr-tag-img cont url)
+	  (setq cont nil))
+	 (multimedia
+	  (shr-insert " [multimedia] ")
+	  (shr-urlify start (shr-expand-url url)))))
+      (when cont
+	(shr-generic cont)))))
 
 (defcustom shr-prefer-media-type-alist '(("webm" . 1.0)
                                          ("ogv"  . 1.0)
@@ -1483,6 +1510,8 @@ The preference is a float determined from `shr-prefer-media-type'."
     ;; model isn't strong enough to allow us to put the images actually
     ;; into the tables.
     (when (zerop shr-table-depth)
+      (dolist (elem (shr-find-elements cont 'object))
+	(shr-tag-object (cdr elem)))
       (dolist (elem (shr-find-elements cont 'img))
 	(shr-tag-img (cdr elem))))))
 
-- 
2.39.5