diff options
| author | Katsumi Yamaoka | 2016-11-21 08:21:27 +0000 |
|---|---|---|
| committer | Katsumi Yamaoka | 2016-11-21 08:21:27 +0000 |
| commit | b13d6f2c397419688374f95c99a55d077312ca94 (patch) | |
| tree | c9965a461dacb13d9d11498243be0c72e4acfdad | |
| parent | 5be4b9ff9edae9d36954ef004f2faa7630711179 (diff) | |
| download | emacs-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.el | 23 |
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. |
| 1911 | Render <img>s and <object>s, and strings and child <table>s of which | 1911 | Render <img>s and <object>s, and strings and child <table>s of which |
| 1912 | the parent is not <td> or <th> as well. FLAGS is a cons of two | 1912 | the parent <td> or <th> is lacking. FLAGS is a cons of two boolean |
| 1913 | boolean flags that control whether to collect or render objects." | 1913 | flags 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) |