From a4f95d500cf687e91bbca626180a37de8f285f72 Mon Sep 17 00:00:00 2001
From: Lars Magne Ingebrigtsen <larsi@quimbies.gnus.org>
Date: Mon, 4 Oct 2010 17:36:37 +0200
Subject: [PATCH] Implement table rendering.

---
 lisp/ChangeLog |   2 +
 lisp/shr.el    | 127 ++++++++++++++++++++++++++++++++++++++++++++++++-
 2 files changed, 128 insertions(+), 1 deletion(-)

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index fb2866363..6a967af31 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -7,6 +7,8 @@
 	(shr-tag-li): Get <li> indentation even righter.
 	(shr-tag-blockquote): Ensure paragraph start.
 
+	* shr.el: Implement table rendering.
+
 2010-10-04  Julien Danjou  <julien@danjou.info>
 
 	* gnus-html.el (gnus-html-put-image): Fix resize image code.
diff --git a/lisp/shr.el b/lisp/shr.el
index c2c2c2ed2..1724ba2bd 100644
--- a/lisp/shr.el
+++ b/lisp/shr.el
@@ -254,7 +254,7 @@ fit these criteria."
 	(setq first nil)
 	(when (and (bolp)
 		   (> shr-indentation 0))
-	  (insert (make-string shr-indentation ? )))
+	  (shr-indent))
 	;; The shr-start is a special variable that is used to pass
 	;; upwards the first point in the buffer where the text really
 	;; starts.
@@ -267,6 +267,9 @@ fit these criteria."
 	(insert " ")
 	(setq shr-state 'space))))))
 
+(defun shr-indent ()
+  (insert (make-string shr-indentation ? )))
+
 (defun shr-get-image-data (url)
   "Get image data for URL.
 Return a string with image data."
@@ -328,6 +331,128 @@ Return a string with image data."
   (apply #'shr-fontize-cont cont types)
   (shr-ensure-paragraph))
 
+(defun shr-tag-table (cont)
+  (shr-ensure-paragraph)
+  (setq cont (or (cdr (assq 'tbody cont))
+		 cont))
+  (let* ((columns (shr-column-specs cont))
+	 (suggested-widths (shr-pro-rate-columns columns))
+	 (sketch (shr-make-table cont suggested-widths))
+	 (sketch-widths (shr-table-widths sketch (length suggested-widths))))
+    (shr-insert-table (shr-make-table cont sketch-widths t) sketch-widths)))
+
+(defun shr-insert-table (table widths)
+  (shr-insert-table-ruler widths)
+  (dolist (row table)
+    (let ((start (point))
+	  (height (let ((max 0))
+		    (dolist (column row)
+		      (setq max (max max (cadr column))))
+		    max)))
+      (dotimes (i height)
+	(shr-indent)
+	(insert "|\n"))
+      (dolist (column row)
+	(goto-char start)
+	(end-of-line)
+	(dolist (line (split-string (nth 2 column) "\n"))
+	  (insert line "|")
+	  (forward-line 1))))
+    (shr-insert-table-ruler widths)))
+
+(defun shr-insert-table-ruler (widths)
+  (shr-indent)
+  (insert "+")
+  (dotimes (i (length widths))
+    (insert (make-string (aref widths i) ?-) ?+))
+  (insert "\n"))
+
+(defun shr-table-widths (table length)
+  (let ((widths (make-vector length 0)))
+    (dolist (row table)
+      (let ((i 0))
+	(dolist (column row)
+	  (aset widths i (max (aref widths i)
+			      (car column)))
+	  (incf i))))
+    widths))
+
+(defun shr-make-table (cons widths &optional fill)
+  (let ((trs nil))
+    (dolist (row cont)
+      (when (eq (car row) 'tr)
+	(let ((i 0)
+	      (tds nil))
+	  (dolist (column (cdr row))
+	    (when (memq (car column) '(td th))
+	      (push (shr-render-td (cdr column) (aref widths i) fill)
+		    tds)
+	      (setq i (1+ i))))
+	  (push (nreverse tds) trs))))
+    (nreverse trs)))
+
+(defun shr-render-td (cont width fill)
+  (with-temp-buffer
+    (let ((shr-width width))
+      (shr-generic cont))
+    (goto-char (point-min))
+    (let ((max 0))
+      (while (not (eobp))
+	(end-of-line)
+	(setq max (max max (current-column)))
+	(forward-line 1))
+      (when fill
+	(goto-char (point-min))
+	(while (not (eobp))
+	  (end-of-line)
+	  (insert (make-string (- width (current-column)) ? ))
+	  (forward-line 1)))
+      (list max (count-lines (point-min) (point-max)) (buffer-string)))))
+
+(defun shr-pro-rate-columns (columns)
+  (let ((total-percentage 0)
+	(widths (make-vector (length columns) 0)))
+    (dotimes (i (length columns))
+      (incf total-percentage (aref columns i)))
+    (setq total-percentage (/ 1.0 total-percentage))
+    (dotimes (i (length columns))
+      (aset widths i (max (truncate (* (aref columns i)
+				       total-percentage
+				       shr-width))
+			  10)))
+    widths))
+
+;; Return a summary of the number and shape of the TDs in the table.
+(defun shr-column-specs (cont)
+  (let ((columns (make-vector (shr-max-columns cont) 1)))
+    (dolist (row cont)
+      (when (eq (car row) 'tr)
+	(let ((i 0))
+	  (dolist (column (cdr row))
+	    (when (memq (car column) '(td th))
+	      (let ((width (cdr (assq :width (cdr column)))))
+		(when (and width
+			   (string-match "\\([0-9]+\\)%" width))
+		  (aset columns i
+			(/ (string-to-number (match-string 1 width))
+			   100.0)))))
+	    (setq i (1+ i))))))
+    columns))
+
+(defun shr-count (cont elem)
+  (let ((i 0))
+    (dolist (sub cont)
+      (when (eq (car sub) elem)
+	(setq i (1+ i))))
+    i))
+
+(defun shr-max-columns (cont)
+  (let ((max 0))
+    (dolist (row cont)
+      (when (eq (car row) 'tr)
+	(setq max (max max (shr-count (cdr row) 'td)))))
+    max))
+
 (provide 'shr)
 
 ;;; shr.el ends here
-- 
2.25.1