aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorKatsumi Yamaoka2016-11-21 08:21:27 +0000
committerKatsumi Yamaoka2016-11-21 08:21:27 +0000
commitb13d6f2c397419688374f95c99a55d077312ca94 (patch)
treec9965a461dacb13d9d11498243be0c72e4acfdad
parent5be4b9ff9edae9d36954ef004f2faa7630711179 (diff)
downloademacs-b13d6f2c397419688374f95c99a55d077312ca94.tar.gz
emacs-b13d6f2c397419688374f95c99a55d077312ca94.zip
Don't collect strings existing out of <tr>...</tr>
* lisp/net/shr.el (shr-collect-extra-strings-in-table): Don't collect strings existing out of <tr>...</tr> to avoid duplication with what `shr-tag-table' renders.
-rw-r--r--lisp/net/shr.el23
1 files changed, 12 insertions, 11 deletions
diff --git a/lisp/net/shr.el b/lisp/net/shr.el
index f1b0087f9be..75e55801864 100644
--- a/lisp/net/shr.el
+++ b/lisp/net/shr.el
@@ -1899,20 +1899,21 @@ The preference is a float determined from `shr-prefer-media-type'."
1899 (when (zerop shr-table-depth) 1899 (when (zerop shr-table-depth)
1900 (save-excursion 1900 (save-excursion
1901 (shr-expand-alignments start (point))) 1901 (shr-expand-alignments start (point)))
1902 (save-restriction 1902 (let ((strings (shr-collect-extra-strings-in-table dom)))
1903 (narrow-to-region (point) (point)) 1903 (when strings
1904 (insert (mapconcat #'identity 1904 (save-restriction
1905 (shr-collect-extra-strings-in-table dom) 1905 (narrow-to-region (point) (point))
1906 "\n")) 1906 (insert (mapconcat #'identity strings "\n"))
1907 (shr-fill-lines (point-min) (point-max)))))) 1907 (shr-fill-lines (point-min) (point-max))))))))
1908 1908
1909(defun shr-collect-extra-strings-in-table (dom &optional flags) 1909(defun shr-collect-extra-strings-in-table (dom &optional flags)
1910 "Return extra strings in DOM of which the root is a table clause. 1910 "Return extra strings in DOM of which the root is a table clause.
1911Render <img>s and <object>s, and strings and child <table>s of which 1911Render <img>s and <object>s, and strings and child <table>s of which
1912the parent is not <td> or <th> as well. FLAGS is a cons of two 1912the parent <td> or <th> is lacking. FLAGS is a cons of two boolean
1913boolean flags that control whether to collect or render objects." 1913flags that control whether to collect or render objects."
1914 ;; As for strings and child <table>s, it runs recursively and 1914 ;; This function runs recursively and collects strings if the cdr of
1915 ;; collects or renders those objects if the cdr of FLAGS is nil. 1915 ;; FLAGS is nil and the car is not nil, and it renders also child
1916 ;; <table>s if the cdr is nil. Note: FLAGS may be nil, not a cons.
1916 ;; FLAGS becomes (t . nil) if a <tr> clause is found in the children 1917 ;; FLAGS becomes (t . nil) if a <tr> clause is found in the children
1917 ;; of DOM, and becomes (t . t) if a <td> or a <th> clause is found 1918 ;; of DOM, and becomes (t . t) if a <td> or a <th> clause is found
1918 ;; and the car is t then. When a <table> clause is found, FLAGS 1919 ;; and the car is t then. When a <table> clause is found, FLAGS
@@ -1921,7 +1922,7 @@ boolean flags that control whether to collect or render objects."
1921 (cl-loop for child in (dom-children dom) with recurse with tag 1922 (cl-loop for child in (dom-children dom) with recurse with tag
1922 do (setq recurse nil) 1923 do (setq recurse nil)
1923 if (stringp child) 1924 if (stringp child)
1924 unless (cdr flags) 1925 unless (or (not (car flags)) (cdr flags))
1925 when (string-match "\\(?:[^\t\n\r ]+[\t\n\r ]+\\)*[^\t\n\r ]+" 1926 when (string-match "\\(?:[^\t\n\r ]+[\t\n\r ]+\\)*[^\t\n\r ]+"
1926 child) 1927 child)
1927 collect (match-string 0 child) 1928 collect (match-string 0 child)