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

Previous Next

To add a comment to this bug, you must first unarchive it, by sending
a message to control AT debbugs.gnu.org, with unarchive 15709 in the body.
You can then email your comments to 15709 AT debbugs.gnu.org in the normal way.

Toggle the display of automated, internal messages from the tracker.

Message #5 received at submit <at> debbugs.gnu.org (full text, mbox):

From: Rüdiger Sonderfeld <ruediger <at> c-plusplus.de>
To: bug-gnu-emacs <at> gnu.org
Cc: Lars Magne Ingebrigtsen <larsi <at> gnus.org>
Subject: [PATCH 7/8] shr: Handle <source> tag for video/audio elements.
Date: Fri, 25 Oct 2013 01:44:28 +0200

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

Previous Next

GNU bug tracking system
Copyright (C) 1999 Darren O. Benham, 1997,2003 nCipher Corporation Ltd, 1994-97 Ian Jackson.