Add support for SVG images

[gnus] / lisp / shr.el

diff --git a/lisp/shr.el b/lisp/shr.el
index 8cb1663..5173908 100644 (file)
--- a/lisp/shr.el
+++ b/lisp/shr.el
@@ -115,7 +115,6 @@ cid: URL as the argument.")
 (defvar shr-base nil)
 (defvar shr-ignore-cache nil)
 (defvar shr-external-rendering-functions nil)
-(defvar shr-final-table-render nil)
 
 (defvar shr-map
   (let ((map (make-sparse-keymap)))
@@ -158,6 +157,7 @@ DOM should be a parse tree as generated by
        (shr-state nil)
        (shr-start nil)
        (shr-base nil)
+       (shr-preliminary-table-render 0)
        (shr-width (or shr-width (window-width))))
     (shr-descend (shr-transform-dom dom))
     (shr-remove-trailing-whitespace start (point))))
@@ -484,31 +484,42 @@ size, and full-buffer size."
         (forward-char 1))))
     (not failed)))
 
-(defun shr-expand-url (url)
-  (if (or (not url)
-         (string-match "\\`[a-z]*:" url)
-         (not shr-base))
-      ;; Absolute URL.
-      url
-    (let ((base shr-base))
-      ;; Chop off query string.
-      (when (string-match "\\`\\([^?]+\\)[?]" base)
-       (setq base (match-string 1 base)))
-      ;; Chop off the bit after the last slash.
-      (when (string-match "\\`\\(.*\\)[/][^/]+" base)
-       (setq base (match-string 1 base)))
-      (cond
-       ((and (string-match "\\`//" url)
-            (string-match "\\`[a-z]*:" base))
-       (concat (match-string 0 base) url))
-       ((and (not (string-match "/\\'" base))
-            (not (string-match "\\`/" url)))
-       (concat base "/" url))
-       ((and (string-match "\\`/" url)
-            (string-match "\\(\\`[^:]*://[^/]+\\)/" base))
-       (concat (match-string 1 base) url))
-       (t
-       (concat base url))))))
+(defun shr-parse-base (url)
+  (let* ((parsed (url-generic-parse-url url))
+        (local (url-filename parsed)))
+    (setf (url-filename parsed) "")
+    ;; Chop off the bit after the last slash.
+    (when (string-match "\\`\\(.*/\\)[^/]+\\'" local)
+      (setq local (match-string 1 local)))
+    ;; Always make the local bit end with a slash.
+    (when (and (not (zerop (length local)))
+              (not (eq (aref local (1- (length local))) ?/)))
+      (setq local (concat local "/")))
+    (list (url-recreate-url parsed)
+         local
+         (url-type parsed))))
+
+(defun shr-expand-url (url &optional base)
+  (setq base
+       (if base
+           (shr-parse-base base)
+         ;; Bound by the parser.
+         shr-base))
+  (cond ((or (not url)
+            (not base)
+            (string-match "\\`[a-z]*:" url))
+        ;; Absolute URL.
+        (or url (car base)))
+       ((eq (aref url 0) ?/)
+        (if (and (> (length url) 1)
+                 (eq (aref url 1) ?/))
+            ;; //host...; just use the protocol
+            (concat (nth 2 base) ":" url)
+          ;; Just use the host name part.
+          (concat (car base) url)))
+       (t
+        ;; Totally relative.
+        (concat (car base) (cadr base) url))))
 
 (defun shr-ensure-newline ()
   (unless (zerop (current-column))
@@ -894,8 +905,31 @@ ones, in case fg and bg are nil."
 (defun shr-tag-comment (cont)
   )
 
+(defun shr-dom-to-xml (dom)
+  "Convert DOM into a string containing the xml representation."
+  (let ((arg " ")
+        (text ""))
+    (dolist (sub (cdr dom))
+      (cond
+       ((listp (cdr sub))
+        (setq text (concat text (dom-to-text sub))))
+       ((eq (car sub) 'text)
+        (setq text (concat text (cdr sub))))
+       (t
+        (setq arg (concat arg (format "%s=\"%s\" "
+                                      (substring (symbol-name (car sub)) 1)
+                                      (cdr sub)))))))
+    (format "<%s%s>%s</%s>"
+            (car dom)
+            (substring arg 0 (1- (length arg)))
+            text
+            (car dom))))
+
 (defun shr-tag-svg (cont)
-  )
+  (when (image-type-available-p 'svg)
+    (funcall shr-put-image-function
+             (shr-dom-to-xml (cons 'svg cont))
+             "SVG Image")))
 
 (defun shr-tag-sup (cont)
   (let ((start (point)))
@@ -965,7 +999,7 @@ ones, in case fg and bg are nil."
       plist)))
 
 (defun shr-tag-base (cont)
-  (setq shr-base (cdr (assq :href cont)))
+  (setq shr-base (shr-parse-base (cdr (assq :href cont))))
   (shr-generic cont))
 
 (defun shr-tag-a (cont)
@@ -1188,8 +1222,7 @@ ones, in case fg and bg are nil."
             (frame-width))
       (setq truncate-lines t))
     ;; Then render the table again with these new "hard" widths.
-    (let ((shr-final-table-render t))
-      (shr-insert-table (shr-make-table cont sketch-widths t) sketch-widths)))
+    (shr-insert-table (shr-make-table cont sketch-widths t) sketch-widths))
   ;; Finally, insert all the images after the table.  The Emacs buffer
   ;; model isn't strong enough to allow us to put the images actually
   ;; into the tables.