From ad9a773c5057e0ddb9de5c582d36572dbcfd5d23 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?R=C3=BCdiger=20Sonderfeld?= Date: Sun, 1 Dec 2013 16:49:18 +0100 Subject: [PATCH] Allow preferring some media types over others * 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. --- lisp/ChangeLog | 7 ++++++ lisp/net/shr.el | 63 +++++++++++++++++++++++++++++++++++++++++++++++-- 2 files changed, 68 insertions(+), 2 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 9df9c5f7721..a251f102590 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,5 +1,12 @@ 2013-12-01 Rüdiger Sonderfeld + * 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. + * net/eww.el (eww-use-external-browser-for-content-type): New variable. (eww-render): Handle `eww-use-external-browser-for-content-type'. diff --git a/lisp/net/shr.el b/lisp/net/shr.el index 30d97105bd7..fff1898df51 100644 --- a/lisp/net/shr.el +++ b/lisp/net/shr.el @@ -1096,10 +1096,67 @@ ones, in case fg and bg are nil." (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 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] ")) @@ -1108,6 +1165,8 @@ ones, in case fg and bg are nil." (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))))