bug#15709: [PATCH 7/8] shr: Handle <source> tag for video/audio elements.

[Rüdiger Sonderfeld]

* lisp/net/shr.el (shr-prefer-media-type-alist): New customizable
  variable.
  (shr--get-media-pref): New function.
  (shr--extract-best-source): New function.
  (shr-tag-video, shr-tag-audio):  Use `shr--extract-best-source' when
  no :src tag was specified.

Signed-off-by: Rüdiger Sonderfeld <ruediger@c-plusplus.de>
---
 lisp/net/shr.el | 63 +++++++++++++++++++++++++++++++++++++++++++++++++++++++--
 1 file changed, 61 insertions(+), 2 deletions(-)

diff --git a/lisp/net/shr.el b/lisp/net/shr.el
index 3ea2829..0015bd4 100644
--- a/lisp/net/shr.el
+++ b/lisp/net/shr.el
@@ -1097,10 +1097,67 @@ (defun shr-tag-object (cont)
       (shr-urlify start (shr-expand-url url)))
     (shr-generic cont)))
 
+(defcustom shr-prefer-media-type-alist '(("webm" . 1.0)
+                                         ("ogv"  . 1.0)
+                                         ("ogg"  . 1.0)
+                                         ("opus" . 1.0)
+                                         ("flac" . 0.9)
+                                         ("wav"  . 0.5))
+  "Preferences for media types.
+The key element should be a regexp matched against the type of the source or
+url if no type is specified.  The value should be a float in the range 0.0 to
+1.0.  Media elements with higher value are preferred."
+  :version "24.4"
+  :group 'shr
+  :type '(alist :key-type regexp :value-type float))
+
+(defun shr--get-media-pref (elem)
+  "Determine the preference for ELEM.
+The preference is a float determined from `shr-prefer-media-type'."
+  (let ((type (cdr (assq :type elem)))
+        (p 0.0))
+    (unless type
+      (setq type (cdr (assq :src elem))))
+    (when type
+      (dolist (pref shr-prefer-media-type-alist)
+        (when (and
+               (> (cdr pref) p)
+               (string-match-p (car pref) type))
+          (setq p (cdr pref)))))
+    p))
+
+(defun shr--extract-best-source (cont &optional url pref)
+  "Extract the best `:src' property from <source> blocks in CONT."
+  (setq pref (or pref -1.0))
+  (let (new-pref)
+    (dolist (elem cont)
+      (when (and (listp elem)
+                 (not (keywordp (car elem)))) ;; skip attributes
+        (when (and (eq (car elem) 'source)
+                   (< pref
+                      (setq new-pref
+                            (shr--get-media-pref elem))))
+          (setq pref new-pref
+                url (cdr (assq :src elem)))
+          (message "new %s %s" url pref))
+        ;; libxml's html parser isn't HML5 compliant and non terminated
+        ;; source tags might end up as children.  So recursion it is...
+        (dolist (child (cdr elem))
+          (when (and (listp child)
+                     (not (keywordp (car child)))  ;; skip attributes
+                     (eq (car child) 'source))
+            (let ((ret (shr--extract-best-source (list child) url pref)))
+              (when (< pref (cdr ret))
+                (setq url (car ret)
+                      pref (cdr ret)))))))))
+  (cons url pref))
+
 (defun shr-tag-video (cont)
   (let ((image (cdr (assq :poster cont)))
-       (url (cdr (assq :src cont)))
-       (start (point)))
+        (url (cdr (assq :src cont)))
+        (start (point)))
+    (unless url
+      (setq url (car (shr--extract-best-source cont))))
     (if image
         (shr-tag-img nil image)
       (shr-insert " [video] "))
@@ -1109,6 +1166,8 @@ (defun shr-tag-video (cont)
 (defun shr-tag-audio (cont)
   (let ((url (cdr (assq :src cont)))
         (start (point)))
+    (unless url
+      (setq url (car (shr--extract-best-source cont))))
     (shr-insert " [audio] ")
     (shr-urlify start (shr-expand-url url))))
 
-- 
1.8.4.1