mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2024-12-02 08:22:22 +00:00
Code Issues Releases Activity

Allow preferring some media types over others

Browse Source 
* 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.
This commit is contained in:
Rüdiger Sonderfeld 2013-12-01 16:49:18 +01:00 committed by Lars Magne Ingebrigtsen
parent 450c7b358c
commit ad9a773c50
2 changed files with 68 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
lisp/ChangeLog
View File

@ -1,5 +1,12 @@
2013-12-01 Rüdiger Sonderfeld <ruediger@c-plusplus.de>
* 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'.

63
lisp/net/shr.el
View File

@ -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 <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] "))
@ -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))))