[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
bug#24831: shr mangling messages
From: |
Katsumi Yamaoka |
Subject: |
bug#24831: shr mangling messages |
Date: |
Fri, 04 Nov 2016 16:19:12 +0900 |
User-agent: |
Gnus/5.13 (Gnus v5.13) Emacs/26.0.50 (i686-pc-cygwin) |
On Wed, 02 Nov 2016 18:49:58 +0900, Katsumi Yamaoka wrote:
> On Tue, 01 Nov 2016 19:43:23 +0100, Lars Ingebrigtsen wrote:
>> And thinking about it a bit more, I think that would perhaps be the most
>> likely solution for shr, too. That is, `shr-tag-table' could, at the
>> end there, go through and find all non-blank non-td/th elements and
>> insert them at the end.
> Thanks. I'm trying it but not succeeded yet though,...
I did it. A patch is below. Bad things in this version I know
at least are:
・It does not support styles -- font, color, etc.
・No way to exclude text existing outside of <html>...</html>.
Thers is no such problems in the first version I posted. ;-)
--- shr.el~ 2016-11-01 02:35:57.788777000 +0000
+++ shr.el 2016-11-04 07:17:19.789855000 +0000
@@ -1897,11 +1897,48 @@
(when (zerop shr-table-depth)
(save-excursion
(shr-expand-alignments start (point)))
+ ;; Insert also non-td/th strings excluding comments and styles.
+ (save-restriction
+ (narrow-to-region (point) (point))
+ (insert (mapconcat #'identity
+ (shr-collect-extra-strings-in-table dom)
+ "\n"))
+ (shr-fill-lines (point-min) (point-max)))
(dolist (elem (dom-by-tag dom 'object))
(shr-tag-object elem))
(dolist (elem (dom-by-tag dom 'img))
(shr-tag-img elem)))))
+(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)
+ 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
+ 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)))
+ append (shr-collect-extra-strings-in-table child flags)))
+
(defun shr-insert-table (table widths)
(let* ((collapse (equal (cdr (assq 'border-collapse shr-stylesheet))
"collapse"))
- bug#24831: shr mangling messages, Katsumi Yamaoka, 2016/11/01
- bug#24831: shr mangling messages, Lars Ingebrigtsen, 2016/11/01
- bug#24831: shr mangling messages, Lars Ingebrigtsen, 2016/11/01
- bug#24831: shr mangling messages, Lars Ingebrigtsen, 2016/11/01
- bug#24831: shr mangling messages, Katsumi Yamaoka, 2016/11/02
- bug#24831: shr mangling messages,
Katsumi Yamaoka <=
- bug#24831: shr mangling messages, Lars Ingebrigtsen, 2016/11/04
- bug#24831: shr mangling messages, Katsumi Yamaoka, 2016/11/04
- bug#24831: shr mangling messages, Lars Ingebrigtsen, 2016/11/04
- bug#24831: shr mangling messages, Katsumi Yamaoka, 2016/11/06