(shr-tag-video): Show the video poster image.

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index ec7a78a..13e7dcb 100644 (file)
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -4,6 +4,7 @@
        control the background color.
        (shr-tag-img): Ignore very small web bug type images.
        (shr-put-image): Add help-echo alt texts to the images.
+       (shr-tag-video): Show the video poster image.
 
 2010-10-29  Lars Magne Ingebrigtsen  <larsi@gnus.org>
 

diff --git a/lisp/shr.el b/lisp/shr.el
index 3e6dbb8..bbb7ff1 100644 (file)
--- a/lisp/shr.el
+++ b/lisp/shr.el
@@ -493,20 +493,35 @@ Return a string with image data."
     (shr-urlify (or shr-start start) url)))
 
 (defun shr-tag-object (cont)
-  (let ((url (cdr (assq :src (cdr (assq 'embed cont)))))
-       (start (point)))
+  (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 url))))
+      (shr-urlify start url))
+    (shr-generic cont)))
+
+(defun shr-tag-video (cont)
+  (let ((image (cdr (assq :poster cont)))
+       (url (cdr (assq :src cont)))
+       (start (point)))
+    (shr-tag-img nil image)
+    (shr-urlify start url)))
 
-(defun shr-tag-img (cont)
-  (when (and cont
-            (cdr (assq :src cont)))
+(defun shr-tag-img (cont &optional url)
+  (when (or url
+           (and cont
+                (cdr (assq :src cont))))
     (when (and (> (current-column) 0)
               (not (eq shr-state 'image)))
       (insert "\n"))
     (let ((alt (cdr (assq :alt cont)))
-         (url (cdr (assq :src cont))))
+         (url (or url (cdr (assq :src cont)))))
       (let ((start (point-marker)))
        (when (zerop (length alt))
          (setq alt "[img]"))