mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-15 18:40:39 -08:00
Code Issues Projects Releases Wiki Activity

* lisp/net/shr.el (shr--preferred-image): Add CR to whitespace regexps.

Browse source 
(shr-collect-extra-strings-in-table):
Render extra tables in an invalid html as well.
This commit is contained in:
Katsumi Yamaoka 2016-11-11 08:17:41 +00:00
parent dd91362565
commit 06b7e73b3e
1 changed files with 42 additions and 28 deletions
Download patch file Download diff file Expand all files Collapse all files

70
lisp/net/shr.el
View file

@ -1529,7 +1529,7 @@ The preference is a float determined from `shr-prefer-media-type'."
(setq srcset (setq srcset
(sort (mapcar (sort (mapcar
(lambda (elem) (lambda (elem)
(let ((spec (split-string elem "[\t\n ]+"))) (let ((spec (split-string elem "[\t\n\r ]+")))
(cond (cond
((= (length spec) 1) ((= (length spec) 1)
;; Make sure it's well formed. ;; Make sure it's well formed.
@ -1544,8 +1544,8 @@ The preference is a float determined from `shr-prefer-media-type'."
(list (car spec) (list (car spec)
(string-to-number (cadr spec))))))) (string-to-number (cadr spec)))))))
(split-string (replace-regexp-in-string (split-string (replace-regexp-in-string
"\\`[\t\n ]+\\|[\t\n ]+\\'" "" srcset) "\\`[\t\n\r ]+\\|[\t\n\r ]+\\'" "" srcset)
"[\t\n ]*,[\t\n ]*")) "[\t\n\r ]*,[\t\n\r ]*"))
(lambda (e1 e2) (lambda (e1 e2)
(> (cadr e1) (cadr e2))))) (> (cadr e1) (cadr e2)))))
;; Choose the smallest picture that's bigger than the current ;; Choose the smallest picture that's bigger than the current
@ -1899,7 +1899,7 @@ The preference is a float determined from `shr-prefer-media-type'."
(when (zerop shr-table-depth) (when (zerop shr-table-depth)
(save-excursion (save-excursion
(shr-expand-alignments start (point))) (shr-expand-alignments start (point)))
;; Insert also non-td/th strings excluding comments and styles. ;; Insert also non-td/th objects.
(save-restriction (save-restriction
(narrow-to-region (point) (point)) (narrow-to-region (point) (point))
(insert (mapconcat #'identity (insert (mapconcat #'identity
@ -1913,32 +1913,46 @@ The preference is a float determined from `shr-prefer-media-type'."
(defun shr-collect-extra-strings-in-table (dom &optional flags) (defun shr-collect-extra-strings-in-table (dom &optional flags)
"Return extra strings in DOM of which the root is a table clause. "Return extra strings in DOM of which the root is a table clause.
FLAGS is a cons of two flags that control whether to collect strings." Render extra child tables of which the parent is not td or th as well.
;; If and only if the cdr is not set, the car will be set to t when FLAGS is a cons of two boolean flags that control whether to collect
;; a <td> or a <th> clause is found in the children of DOM, and reset or render objects."
;; to nil when a <table> clause is found in the children of DOM. ;; Currently this function supports extra strings and <table>s that
;; The cdr will be set to t when a <table> clause is found if the car ;; are children of <table> or <tr> clauses, not <td> nor <th>.
;; is not set then, and will never be reset. ;; It runs recursively and collects strings or renders <table>s if
;; This function collects strings if the car of FLAGS is not set. ;; the cdr of FLAGS is nil. FLAGS becomes (t . nil) if a <tr>
(unless flags (setq flags (cons nil nil))) ;; clause is found in the children of DOM, and becomes (t . t) if
(cl-loop for child in (dom-children dom) ;; a <td> or a <th> clause is found and the car is t then.
;; When a <table> clause is found, FLAGS becomes nil if the cdr is t
;; then. But if the cdr is nil then, render the <table>.
(cl-loop for child in (dom-children dom) with tag with recurse
if (stringp child) if (stringp child)
when (and (not (car flags)) unless (cdr flags)
(string-match "\\(?:[^\t\n\r ]+[\t\n\r ]+\\)*[^\t\n\r ]+" when (string-match "\\(?:[^\t\n\r ]+[\t\n\r ]+\\)*[^\t\n\r ]+"
child)) child)
collect (match-string 0 child) collect (match-string 0 child)
end end end
else else
unless (let ((tag (dom-tag child))) do (setq tag (dom-tag child)
(or (memq tag '(comment style)) recurse t)
(progn and
(cond ((memq tag '(td th)) if (eq tag 'tr)
(unless (cdr flags) (setcar flags t))) do (setq flags '(t . nil))
((eq tag 'table) else if (memq tag '(td th))
(if (car flags) when (car flags)
(unless (cdr flags) (setcar flags nil)) do (setq flags '(t . t))
(setcdr flags t)))) end
nil))) else if (eq tag 'table)
if (cdr flags)
do (setq flags nil)
else
do (setq recurse nil)
(shr-tag-table child)
end
else
when (memq tag '(comment style))
do (setq recurse nil)
end end end end and
when recurse
append (shr-collect-extra-strings-in-table child flags))) append (shr-collect-extra-strings-in-table child flags)))
(defun shr-insert-table (table widths) (defun shr-insert-table (table widths)