[Emacs-diffs] shr-fontified a5890e6 3/6: Revert previous change since that didn't really work

[Lars Ingebrigtsen]

branch: shr-fontified
commit a5890e6765d96f7703223fc60af2068366aef8e5
Author: Lars Magne Ingebrigtsen <address@hidden>
Commit: Lars Magne Ingebrigtsen <address@hidden>

    Revert previous change since that didn't really work
---
 lisp/net/shr.el |  172 +++++++++++++++++++++++++------------------------------
 1 files changed, 78 insertions(+), 94 deletions(-)

diff --git a/lisp/net/shr.el b/lisp/net/shr.el
index 1119b85..85eaabd 100644
--- a/lisp/net/shr.el
+++ b/lisp/net/shr.el
@@ -227,9 +227,6 @@ DOM should be a parse tree as generated by
                                    (- (window-width) 2)
                                  (- (window-pixel-width)
                                     (* (frame-fringe-width) 2))))))
-    ;; Do a preliminary sweep over the document to pick out the table
-    ;; elements and fix them up.
-    (shr-get-table-natural-widths dom)
     (shr-descend dom)
     (shr-remove-trailing-whitespace start (point))
     (setq adom dom)
@@ -1476,24 +1473,6 @@ The preference is a float determined from 
`shr-prefer-media-type'."
 
 ;;; Table rendering algorithm.
 
-(defun shr-get-table-natural-widths (dom)
-  (if (and (eq (dom-tag dom) 'table)
-          (not (dom-attr dom 'shr-natural-widths)))
-      (progn
-       (unless (dom-attr dom 'shr-fixed-table)
-         (setcdr dom (cdr (shr-fix-table dom))))
-       (let* ((shr-inhibit-images t)
-              (shr-table-depth (1+ shr-table-depth))
-              (shr-kinsoku-shorten t)
-              (columns (shr-column-specs dom)))
-         ;; Compute the "natural" width by setting each column to 5000
-         ;; characters/pixels and see how wide they really render.
-         (shr-make-table dom (make-vector (length columns) 5000)
-                         nil 'shr-natural-widths)))
-    (dolist (node (dom-children dom))
-      (unless (stringp node)
-       (shr-get-table-natural-widths node)))))
-
 ;; Table rendering is the only complicated thing here.  We do this by
 ;; first counting how many TDs there are in each TR, and registering
 ;; how wide they think they should be ("width=45%", etc).  Then we
@@ -1517,7 +1496,12 @@ The preference is a float determined from 
`shr-prefer-media-type'."
         (sketch (or (dom-attr dom 'shr-suggested-widths)
                     (shr-make-table dom suggested-widths nil
                                     'shr-suggested-widths)))
-        (natural (dom-attr dom 'shr-natural-widths))
+        ;; Compute the "natural" width by setting each column to 5000
+        ;; characters and see how wide they really render.
+        (natural (or (dom-attr dom 'shr-natural-widths)
+                     (shr-make-table
+                      dom (make-vector (length columns) 5000)
+                      nil 'shr-natural-widths)))
         (sketch-widths (shr-table-widths sketch natural suggested-widths)))
     ;; This probably won't work very well.
     (when (> (+ (loop for width across sketch-widths
@@ -1528,12 +1512,17 @@ The preference is a float determined from 
`shr-prefer-media-type'."
     ;; Then render the table again with these new "hard" widths.
     (shr-insert-table (shr-make-table dom sketch-widths t) sketch-widths)))
 
-(defun shr-fix-table (dom)
+(defun shr-tag-table (dom)
+  (shr-ensure-paragraph)
   (let* ((caption (dom-children (dom-child-by-tag dom 'caption)))
         (header (dom-non-text-children (dom-child-by-tag dom 'thead)))
         (body (dom-non-text-children (or (dom-child-by-tag dom 'tbody)
                                          dom)))
         (footer (dom-non-text-children (dom-child-by-tag dom 'tfoot)))
+         (bgcolor (dom-attr dom 'bgcolor))
+        (start (point))
+        (shr-stylesheet (nconc (list (cons 'background-color bgcolor))
+                               shr-stylesheet))
         (nheader (if header (shr-max-columns header)))
         (nbody (if body (shr-max-columns body)))
         (nfooter (if footer (shr-max-columns footer))))
@@ -1543,80 +1532,74 @@ The preference is a float determined from 
`shr-prefer-media-type'."
             (not (dom-child-by-tag dom 'tr))
             (not footer))
        ;; The table is totally invalid and just contains random junk.
-       dom
-      ;; It's a real table, so generate a "fixed" structure.
-      (nconc
-       (list 'table (list (cons 'shr-fixed-table t)))
-       (if caption `((tr nil (td nil ,@caption))))
-       (cond
-       (header
-        (if footer
-            ;; header + body + footer
-            (if (= nheader nbody)
-                (if (= nbody nfooter)
-                    `((tr nil (td nil (table nil
-                                             (tbody nil ,@header
-                                                    ,@body ,@footer)))))
-                  (nconc `((tr nil (td nil (table nil
-                                                  (tbody nil ,@header
-                                                         ,@body)))))
-                         (if (= nfooter 1)
-                             footer
-                           `((tr nil (td nil (table
-                                              nil (tbody
-                                                   nil ,@footer))))))))
-              (nconc `((tr nil (td nil (table nil (tbody
-                                                   nil ,@header)))))
-                     (if (= nbody nfooter)
-                         `((tr nil (td nil (table
-                                            nil (tbody nil ,@body
-                                                       ,@footer)))))
-                       (nconc `((tr nil (td nil (table
-                                                 nil (tbody nil
-                                                            ,@body)))))
-                              (if (= nfooter 1)
-                                  footer
-                                `((tr nil (td nil (table
-                                                   nil
-                                                   (tbody
-                                                    nil
-                                                    ,@footer))))))))))
-          ;; header + body
-          (if (= nheader nbody)
-              `((tr nil (td nil (table nil (tbody nil ,@header
-                                                  ,@body)))))
-            (if (= nheader 1)
-                `(,@header (tr nil (td nil (table
-                                            nil (tbody nil ,@body)))))
-              `((tr nil (td nil (table nil (tbody nil ,@header))))
-                (tr nil (td nil (table nil (tbody nil ,@body)))))))))
-       (footer
-        ;; body + footer
-        (if (= nbody nfooter)
-            `((tr nil (td nil (table
-                               nil (tbody nil ,@body ,@footer)))))
-          (nconc `((tr nil (td nil (table nil (tbody nil ,@body)))))
-                 (if (= nfooter 1)
-                     footer
-                   `((tr nil (td nil (table
-                                      nil (tbody nil ,@footer)))))))))
-       (caption
-        `((tr nil (td nil (table nil (tbody nil ,@body))))))
-       (body))))))
-
-(defun shr-tag-table (dom)
-  (shr-ensure-paragraph)
-  (let* ((bgcolor (dom-attr dom 'bgcolor))
-        (start (point))
-        (shr-stylesheet (nconc (list (cons 'background-color bgcolor))
-                               shr-stylesheet)))
-    (if (and (not (dom-child-by-tag dom 'tbody))
-            (not (dom-child-by-tag dom 'tr)))
-       ;; The table is totally invalid and just contains random junk.
        ;; Try to output it anyway.
        (shr-generic dom)
       ;; It's a real table, so render it.
-      (shr-tag-table-1 dom))
+      (if (dom-attr dom 'shr-fixed-table)
+         (shr-tag-table-1 dom)
+       ;; Only fix up the table once.
+       (let ((table
+              (nconc
+               (list 'table nil)
+               (if caption `((tr nil (td nil ,@caption))))
+               (cond
+                (header
+                 (if footer
+                     ;; header + body + footer
+                     (if (= nheader nbody)
+                         (if (= nbody nfooter)
+                             `((tr nil (td nil (table nil
+                                                      (tbody nil ,@header
+                                                             ,@body 
,@footer)))))
+                           (nconc `((tr nil (td nil (table nil
+                                                           (tbody nil ,@header
+                                                                  ,@body)))))
+                                  (if (= nfooter 1)
+                                      footer
+                                    `((tr nil (td nil (table
+                                                       nil (tbody
+                                                            nil 
,@footer))))))))
+                       (nconc `((tr nil (td nil (table nil (tbody
+                                                            nil ,@header)))))
+                              (if (= nbody nfooter)
+                                  `((tr nil (td nil (table
+                                                     nil (tbody nil ,@body
+                                                                ,@footer)))))
+                                (nconc `((tr nil (td nil (table
+                                                          nil (tbody nil
+                                                                     
,@body)))))
+                                       (if (= nfooter 1)
+                                           footer
+                                         `((tr nil (td nil (table
+                                                            nil
+                                                            (tbody
+                                                             nil
+                                                             ,@footer))))))))))
+                   ;; header + body
+                   (if (= nheader nbody)
+                       `((tr nil (td nil (table nil (tbody nil ,@header
+                                                           ,@body)))))
+                     (if (= nheader 1)
+                         `(,@header (tr nil (td nil (table
+                                                     nil (tbody nil ,@body)))))
+                       `((tr nil (td nil (table nil (tbody nil ,@header))))
+                         (tr nil (td nil (table nil (tbody nil ,@body)))))))))
+                (footer
+                 ;; body + footer
+                 (if (= nbody nfooter)
+                     `((tr nil (td nil (table
+                                        nil (tbody nil ,@body ,@footer)))))
+                   (nconc `((tr nil (td nil (table nil (tbody nil ,@body)))))
+                          (if (= nfooter 1)
+                              footer
+                            `((tr nil (td nil (table
+                                               nil (tbody nil ,@footer)))))))))
+                (caption
+                 `((tr nil (td nil (table nil (tbody nil ,@body))))))
+                (body)))))
+         (dom-set-attribute table 'shr-fixed-table t)
+         (setcdr dom (cdr table))
+         (shr-tag-table-1 dom))))
     (when bgcolor
       (shr-colorize-region start (point) (cdr (assq 'color shr-stylesheet))
                           bgcolor))
@@ -1878,6 +1861,7 @@ The preference is a float determined from 
`shr-prefer-media-type'."
     (or (dom-attr dom cache)
        (let ((natural (dom-attr dom 'shr-td-cache-natural)))
          (and (not fill)
+              nil
               natural
               (>= width natural)
               natural))