[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] shr-fontified 5a8ef7f 2/6: Get line breaking again in comp
|
From: |
Lars Ingebrigtsen |
|
Subject: |
[Emacs-diffs] shr-fontified 5a8ef7f 2/6: Get line breaking again in complex layouts |
|
Date: |
Sun, 08 Feb 2015 05:06:25 +0000 |
branch: shr-fontified
commit 5a8ef7fef1dcde92c7ffe585ffee22f4281fbd7d
Author: Lars Magne Ingebrigtsen <address@hidden>
Commit: Lars Magne Ingebrigtsen <address@hidden>
Get line breaking again in complex layouts
* lisp/net/shr.el (shr-get-table-natural-widths): Ensure that we get
proper line breaking by sweeping over the document first and just
collect the natural widths.
---
lisp/ChangeLog | 4 +
lisp/net/shr.el | 172 ++++++++++++++++++++++++++++++-------------------------
2 files changed, 98 insertions(+), 78 deletions(-)
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index e51bd5e..345728c 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,5 +1,9 @@
2015-02-08 Lars Ingebrigtsen <address@hidden>
+ * net/shr.el (shr-get-table-natural-widths): Ensure that we get
+ proper line breaking by sweeping over the document first and just
+ collect the natural widths.
+
* net/eww.el (eww-toggle-fonts): New command.
2015-02-07 Lars Ingebrigtsen <address@hidden>
diff --git a/lisp/net/shr.el b/lisp/net/shr.el
index 5b3659d..1119b85 100644
--- a/lisp/net/shr.el
+++ b/lisp/net/shr.el
@@ -227,6 +227,9 @@ 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)
@@ -1473,6 +1476,24 @@ 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
@@ -1490,18 +1511,13 @@ The preference is a float determined from
`shr-prefer-media-type'."
(columns (shr-column-specs dom))
;; Compute how many pixels wide each TD should be.
(suggested-widths (shr-pro-rate-columns columns))
- ;; 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)))
;; Do a "test rendering" to see how big each TD is (this can
;; be smaller (if there's little text) or bigger (if there's
;; unbreakable text).
(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))
(sketch-widths (shr-table-widths sketch natural suggested-widths)))
;; This probably won't work very well.
(when (> (+ (loop for width across sketch-widths
@@ -1512,17 +1528,12 @@ 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-tag-table (dom)
- (shr-ensure-paragraph)
+(defun shr-fix-table (dom)
(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))))
@@ -1532,74 +1543,80 @@ 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.
- (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))))
+ (shr-tag-table-1 dom))
(when bgcolor
(shr-colorize-region start (point) (cdr (assq 'color shr-stylesheet))
bgcolor))
@@ -1861,7 +1878,6 @@ 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))
- [Emacs-diffs] shr-fontified updated (bf7aeb3 -> 70199c1), Lars Ingebrigtsen, 2015/02/08
- [Emacs-diffs] shr-fontified 1a2c4b6 1/6: * lisp/net/eww.el (eww-toggle-fonts): New command., Lars Ingebrigtsen, 2015/02/08
- [Emacs-diffs] shr-fontified 6a63431 4/6: Compute the natural widths of nested layouts better, Lars Ingebrigtsen, 2015/02/08
- [Emacs-diffs] shr-fontified 5a8ef7f 2/6: Get line breaking again in complex layouts,
Lars Ingebrigtsen <=
- [Emacs-diffs] shr-fontified a5890e6 3/6: Revert previous change since that didn't really work, Lars Ingebrigtsen, 2015/02/08
- [Emacs-diffs] shr-fontified f3dc41b 5/6: Use a single `with-window-excursion' instead of two, Lars Ingebrigtsen, 2015/02/08
- [Emacs-diffs] shr-fontified 70199c1 6/6: Further <td> speedups, Lars Ingebrigtsen, 2015/02/08