[gnus git] branch no-gnus updated: m0-1-86-g72286f4 =1= Rework how shr computes natural table cell widths

       via  72286f4679b3980964cbe4584c259760b2d4a941 (commit)
      from  333f5fb73e2fb37bbd91cc23461ac7ba58e197d0 (commit)


- Log -----------------------------------------------------------------
commit 72286f4679b3980964cbe4584c259760b2d4a941
Author: Lars Magne Ingebrigtsen <[email protected]>
Date:   Wed Mar 14 19:55:04 2012 +0100

    Rework how shr computes natural table cell widths
    
    (shr-tag-table-1): Rework how the natural widths are computed by
    rendering the table a third time.

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 529ad21..dad8fdf 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -5,6 +5,8 @@
 	(shr-render-td): Don't delete too much padding.
 	(shr-natural-width): Compute the natural width more correctly.
 	(shr-insert): Allow the natural width to be computed for tables again.
+	(shr-tag-table-1): Rework how the natural widths are computed by
+	rendering the table a third time.
 
 	* gnus-msg.el (gnus-bug): Don't delete the other windows.  We may be
 	using a `gnus-use-full-window' setup (bug#11013).
diff --git a/lisp/shr.el b/lisp/shr.el
index 1737a82..b4e3ec6 100644
--- a/lisp/shr.el
+++ b/lisp/shr.el
@@ -1048,7 +1048,10 @@ ones, in case fg and bg are nil."
 	 ;; be smaller (if there's little text) or bigger (if there's
 	 ;; unbreakable text).
 	 (sketch (shr-make-table cont suggested-widths))
-	 (sketch-widths (shr-table-widths sketch suggested-widths)))
+	 ;; Compute the "natural" width by setting each column to 500
+	 ;; characters and see how wide they really render.
+	 (natural (shr-make-table cont (make-vector (length columns) 500)))
+	 (sketch-widths (shr-table-widths sketch natural suggested-widths)))
     ;; This probably won't work very well.
     (when (> (+ (loop for width across sketch-widths
 		      summing (1+ width))
@@ -1186,27 +1189,22 @@ ones, in case fg and bg are nil."
 	    shr-table-corner))
   (insert "\n"))
 
-(defun shr-table-widths (table suggested-widths)
+(defun shr-table-widths (table natural-table suggested-widths)
   (let* ((length (length suggested-widths))
 	 (widths (make-vector length 0))
 	 (natural-widths (make-vector length 0)))
     (dolist (row table)
       (let ((i 0))
 	(dolist (column row)
-	  (aset widths i (max (aref widths i)
-			      (car column)))
-	  (aset natural-widths i (max (aref natural-widths i)
-				      (cadr column)))
+	  (aset widths i (max (aref widths i) column))
 	  (setq i (1+ i)))))
-    (let* ((total-suggested (apply '+ (append suggested-widths nil)))
-	   (total-actual (apply '+ (append widths nil)))
-	   (extra (- total-suggested
-		     total-actual
-		     ;; TD separators.
-		     (length widths)
-		     ;; Table separators + fence.
-		     3
-		     (* 2 shr-table-depth)))
+    (dolist (row natural-table)
+      (let ((i 0))
+	(dolist (column row)
+	  (aset natural-widths i (max (aref natural-widths i) column))
+	  (setq i (1+ i)))))
+    (let ((extra (- (apply '+ (append suggested-widths nil))
+		    (apply '+ (append widths nil))))
 	   (expanded-columns 0))
       ;; We have extra, unused space, so divide this space amongst the
       ;; columns.
@@ -1214,10 +1212,14 @@ ones, in case fg and bg are nil."
 	;; If the natural width is wider than the rendered width, we
 	;; want to allow the column to expand.
 	(dotimes (i length)
-	  (when (> (aref natural-widths i) 0)
-	    (aset widths i (+ (truncate (* (/ extra (* 1.0 total-actual))
-					   (aref widths i)))
-			      (aref widths i)))))))
+	  (when (> (aref natural-widths i) (aref widths i))
+	    (setq expanded-columns (1+ expanded-columns))))
+	(dotimes (i length)
+	  (when (> (aref natural-widths i) (aref widths i))
+	    (aset widths i (min
+			    (aref natural-widths i)
+			    (+ (/ extra expanded-columns)
+			       (aref widths i))))))))
     widths))
 
 (defun shr-make-table (cont widths &optional fill)
@@ -1310,8 +1312,7 @@ ones, in case fg and bg are nil."
 		  (split-string (buffer-string) "\n")
 		  (shr-collect-overlays)
 		  (car actual-colors))
-	  (list max
-		(shr-natural-width)))))))
+	  max)))))
 
 (defun shr-natural-width ()
   (goto-char (point-min))

-----------------------------------------------------------------------
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we listed those
revisions in full, above.

Summary of changes:
 lisp/ChangeLog |    2 ++
 lisp/shr.el    |   45 +++++++++++++++++++++++----------------------
 2 files changed, 25 insertions(+), 22 deletions(-)

This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "Gnus Project".

The branch, no-gnus has been updated


hooks/post-receive
-- 
Gnus Project