Implement table rendering.
authorLars Magne Ingebrigtsen <larsi@quimbies.gnus.org>
Mon, 4 Oct 2010 15:36:37 +0000 (17:36 +0200)
committerLars Magne Ingebrigtsen <larsi@quimbies.gnus.org>
Mon, 4 Oct 2010 15:36:37 +0000 (17:36 +0200)
lisp/ChangeLog
lisp/shr.el

index fb28663..6a967af 100644 (file)
@@ -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.
index c2c2c2e..1724ba2 100644 (file)
@@ -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