GNU bug report logs - #24831
shr mangling messages

Previous Next

Package: emacs;

Reported by: 積丹尼 Dan Jacobson <jidanni <at> jidanni.org>

Date: Mon, 31 Oct 2016 02:47:02 UTC

Severity: normal

Done: Katsumi Yamaoka <yamaoka <at> jpl.org>

Bug is archived. No further changes may be made.

Full log

View this message in rfc822 format

From: Katsumi Yamaoka <yamaoka <at> jpl.org>
To: Lars Ingebrigtsen <larsi <at> gnus.org>
Cc: 24831 <at> debbugs.gnu.org, jidanni <at> jidanni.org
Subject: bug#24831: shr mangling messages
Date: Fri, 04 Nov 2016 16:19:18 +0900

[Message part 1 (text/plain, inline)]
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. ;-)


[Message part 2 (text/x-patch, inline)]
--- 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"))
This bug report was last modified 8 years and 254 days ago.

Previous Next

GNU bug tracking system
Copyright (C) 1999 Darren O. Benham, 1997,2003 nCipher Corporation Ltd, 1994-97 Ian Jackson.