mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-15 10:30:25 -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
(sort (mapcar
(lambda (elem)
(let ((spec (split-string elem "[\t\n ]+")))
(let ((spec (split-string elem "[\t\n\r ]+")))
(cond
((= (length spec) 1)
;; Make sure it's well formed.
@ -1544,8 +1544,8 @@ The preference is a float determined from `shr-prefer-media-type'."
(list (car spec)
(string-to-number (cadr spec)))))))
(split-string (replace-regexp-in-string
"\\`[\t\n ]+\\|[\t\n ]+\\'" "" srcset)
"[\t\n ]*,[\t\n ]*"))
"\\`[\t\n\r ]+\\|[\t\n\r ]+\\'" "" srcset)
"[\t\n\r ]*,[\t\n\r ]*"))
(lambda (e1 e2)
(> (cadr e1) (cadr e2)))))
;; 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)
(save-excursion
(shr-expand-alignments start (point)))
;; Insert also non-td/th strings excluding comments and styles.
;; Insert also non-td/th objects.
(save-restriction
(narrow-to-region (point) (point))
(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)
"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."
;; If and only if the cdr is not set, the car will be set to t when
;; a <td> or a <th> clause is found in the children of DOM, and reset
;; to nil when a <table> clause is found in the children of DOM.
;; The cdr will be set to t when a <table> clause is found if the car
;; is not set then, and will never be reset.
;; This function collects strings if the car of FLAGS is not set.
(unless flags (setq flags (cons nil nil)))
(cl-loop for child in (dom-children dom)
Render extra child tables of which the parent is not td or th as well.
FLAGS is a cons of two boolean flags that control whether to collect
or render objects."
;; Currently this function supports extra strings and <table>s that
;; are children of <table> or <tr> clauses, not <td> nor <th>.
;; It runs recursively and collects strings or renders <table>s if
;; the cdr of FLAGS is nil. FLAGS becomes (t . nil) if a <tr>
;; clause is found in the children of DOM, and becomes (t . t) if
;; 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)
when (and (not (car flags))
(string-match "\\(?:[^\t\n\r ]+[\t\n\r ]+\\)*[^\t\n\r ]+"
child))
collect (match-string 0 child)
end
unless (cdr flags)
when (string-match "\\(?:[^\t\n\r ]+[\t\n\r ]+\\)*[^\t\n\r ]+"
child)
collect (match-string 0 child)
end end
else
unless (let ((tag (dom-tag child)))
(or (memq tag '(comment style))
(progn
(cond ((memq tag '(td th))
(unless (cdr flags) (setcar flags t)))
((eq tag 'table)
(if (car flags)
(unless (cdr flags) (setcar flags nil))
(setcdr flags t))))
nil)))
do (setq tag (dom-tag child)
recurse t)
and
if (eq tag 'tr)
do (setq flags '(t . nil))
else if (memq tag '(td th))
when (car flags)
do (setq flags '(t . t))
end
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)))
(defun shr-insert-table (table widths)