X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/2da9c605f8b27d3d23c303e8d02dbe1623efee01..31e7d6e0902a895e13833204907dfb86268b5acf:/lisp/gnus/shr.el

diff --git a/lisp/gnus/shr.el b/lisp/gnus/shr.el
index 67effc07ee..e7a6c5d208 100644
--- a/lisp/gnus/shr.el
+++ b/lisp/gnus/shr.el
@@ -1,6 +1,6 @@
 ;;; shr.el --- Simple HTML Renderer
 
-;; Copyright (C) 2010-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2012 Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;; Keywords: html
@@ -35,6 +35,7 @@
 
 (defgroup shr nil
   "Simple HTML Renderer"
+  :version "24.1"
   :group 'mail)
 
 (defcustom shr-max-image-proportion 0.9
@@ -53,17 +54,17 @@ fit these criteria."
   :group 'shr
   :type 'regexp)
 
-(defcustom shr-table-horizontal-line ? 
+(defcustom shr-table-horizontal-line ?\s
   "Character used to draw horizontal table lines."
   :group 'shr
   :type 'character)
 
-(defcustom shr-table-vertical-line ? 
+(defcustom shr-table-vertical-line ?\s
   "Character used to draw vertical table lines."
   :group 'shr
   :type 'character)
 
-(defcustom shr-table-corner ? 
+(defcustom shr-table-corner ?\s
   "Character used to draw table corners."
   :group 'shr
   :type 'character)
@@ -112,11 +113,13 @@ cid: URL as the argument.")
 (defvar shr-table-depth 0)
 (defvar shr-stylesheet nil)
 (defvar shr-base nil)
+(defvar shr-ignore-cache nil)
 
 (defvar shr-map
   (let ((map (make-sparse-keymap)))
     (define-key map "a" 'shr-show-alt-text)
     (define-key map "i" 'shr-browse-image)
+    (define-key map "z" 'shr-zoom-image)
     (define-key map "I" 'shr-insert-image)
     (define-key map "u" 'shr-copy-url)
     (define-key map "v" 'shr-browse-url)
@@ -126,23 +129,49 @@ cid: URL as the argument.")
 
 ;; Public functions and commands.
 
-(defun shr-visit-file (file)
-  (interactive "fHTML file name: ")
+(defun shr-render-buffer (buffer)
+  "Display the HTML rendering of the current buffer."
+  (interactive (list (current-buffer)))
   (pop-to-buffer "*html*")
   (erase-buffer)
   (shr-insert-document
-   (with-temp-buffer
-     (insert-file-contents file)
-     (libxml-parse-html-region (point-min) (point-max)))))
+   (with-current-buffer buffer
+     (libxml-parse-html-region (point-min) (point-max))))
+  (goto-char (point-min)))
+
+(defun shr-visit-file (file)
+  "Parse FILE as an HTML document, and render it in a new buffer."
+  (interactive "fHTML file name: ")
+  (with-temp-buffer
+    (insert-file-contents file)
+    (shr-render-buffer (current-buffer))))
 
 ;;;###autoload
 (defun shr-insert-document (dom)
+  "Render the parsed document DOM into the current buffer.
+DOM should be a parse tree as generated by
+`libxml-parse-html-region' or similar."
   (setq shr-content-cache nil)
-  (let ((shr-state nil)
+  (let ((start (point))
+	(shr-state nil)
 	(shr-start nil)
 	(shr-base nil)
 	(shr-width (or shr-width (window-width))))
-    (shr-descend (shr-transform-dom dom))))
+    (shr-descend (shr-transform-dom dom))
+    (shr-remove-trailing-whitespace start (point))))
+
+(defun shr-remove-trailing-whitespace (start end)
+  (let ((width (window-width)))
+    (save-restriction
+      (narrow-to-region start end)
+      (goto-char start)
+      (while (not (eobp))
+	(end-of-line)
+	(when (> (shr-previous-newline-padding-width (current-column)) width)
+	  (dolist (overlay (overlays-at (point)))
+	    (when (overlay-get overlay 'before-string)
+	      (overlay-put overlay 'before-string nil))))
+	(forward-line 1)))))
 
 (defun shr-copy-url ()
   "Copy the URL under point to the kill ring.
@@ -167,7 +196,8 @@ redirects somewhere else."
 	     (when (re-search-forward ".utm_.*" nil t)
 	       (replace-match "" t t))
 	     (message "Copied %s" (buffer-string))
-	     (copy-region-as-kill (point-min) (point-max)))))))
+	     (copy-region-as-kill (point-min) (point-max)))))
+       nil t))
      ;; Copy the URL to the kill ring.
      (t
       (with-temp-buffer
@@ -210,6 +240,40 @@ the URL of the image to the kill buffer instead."
       (message "Inserting %s..." url)
       (url-retrieve url 'shr-image-fetched
 		    (list (current-buffer) (1- (point)) (point-marker))
+		    t t))))
+
+(defun shr-zoom-image ()
+  "Toggle the image size.
+The size will be rotated between the default size, the original
+size, and full-buffer size."
+  (interactive)
+  (let ((url (get-text-property (point) 'image-url))
+	(size (get-text-property (point) 'image-size))
+	(buffer-read-only nil))
+    (if (not url)
+	(message "No image under point")
+      ;; Delete the old picture.
+      (while (get-text-property (point) 'image-url)
+	(forward-char -1))
+      (forward-char 1)
+      (let ((start (point)))
+	(while (get-text-property (point) 'image-url)
+	  (forward-char 1))
+	(forward-char -1)
+	(put-text-property start (point) 'display nil)
+	(when (> (- (point) start) 2)
+	  (delete-region start (1- (point)))))
+      (message "Inserting %s..." url)
+      (url-retrieve url 'shr-image-fetched
+		    (list (current-buffer) (1- (point)) (point-marker)
+			  (list (cons 'size
+				      (cond ((or (eq size 'default)
+						 (null size))
+					     'original)
+					    ((eq size 'original)
+					     'full)
+					    ((eq size 'full)
+					     'default)))))
 		    t))))
 
 ;;; Utility functions.
@@ -275,6 +339,7 @@ the URL of the image to the kill buffer instead."
 
 (defun shr-insert (text)
   (when (and (eq shr-state 'image)
+	     (not (bolp))
 	     (not (string-match "\\`[ \t\n]+\\'" text)))
     (insert "\n")
     (setq shr-state nil))
@@ -282,11 +347,11 @@ the URL of the image to the kill buffer instead."
    ((eq shr-folding-mode 'none)
     (insert text))
    (t
-    (when (and (string-match "\\`[ \t\n]" text)
+    (when (and (string-match "\\`[ \t\n ]" text)
 	       (not (bolp))
 	       (not (eq (char-after (1- (point))) ? )))
       (insert " "))
-    (dolist (elem (split-string text))
+    (dolist (elem (split-string text "[ \f\t\n\r\v ]+" t))
       (when (and (bolp)
 		 (> shr-indentation 0))
 	(shr-indent))
@@ -309,6 +374,7 @@ the URL of the image to the kill buffer instead."
       (unless shr-start
 	(setq shr-start (point)))
       (insert elem)
+      (setq shr-state nil)
       (let (found)
 	(while (and (> (current-column) shr-width)
 		    (progn
@@ -318,7 +384,6 @@ the URL of the image to the kill buffer instead."
 	    (delete-char -1))
 	  (insert "\n")
 	  (unless found
-	    (put-text-property (1- (point)) (point) 'shr-break t)
 	    ;; No space is needed at the beginning of a line.
 	    (when (eq (following-char) ? )
 	      (delete-char 1)))
@@ -326,7 +391,7 @@ the URL of the image to the kill buffer instead."
 	    (shr-indent))
 	  (end-of-line))
 	(insert " ")))
-    (unless (string-match "[ \t\n]\\'" text)
+    (unless (string-match "[ \t\n ]\\'" text)
       (delete-char -1)))))
 
 (defun shr-find-fill-point ()
@@ -385,32 +450,29 @@ the URL of the image to the kill buffer instead."
 			 (shr-char-kinsoku-eol-p (following-char)))))
 	   (goto-char bp)))
 	((shr-char-kinsoku-eol-p (preceding-char))
-	 (if (shr-char-kinsoku-eol-p (following-char))
-	     ;; There are consecutive kinsoku-eol characters.
-	     (setq failed t)
-	   (let ((count 4))
-	     (while
-		 (progn
-		   (backward-char 1)
-		   (and (> (setq count (1- count)) 0)
-			(not (memq (preceding-char) (list ?\C-@ ?\n ? )))
-			(or (shr-char-kinsoku-eol-p (preceding-char))
-			    (shr-char-kinsoku-bol-p (following-char)))))))
-	   (if (setq failed (= (current-column) shr-indentation))
-	       ;; There's no breakable point that doesn't violate kinsoku,
-	       ;; so we go to the second best position.
-	       (if (looking-at "\\(\\c<+\\)\\c<")
-		   (goto-char (match-end 1))
-		 (forward-char 1)))))
-	(t
-	 (if (shr-char-kinsoku-bol-p (preceding-char))
-	     ;; There are consecutive kinsoku-bol characters.
-	     (setq failed t)
-	   (let ((count 4))
-	     (while (and (>= (setq count (1- count)) 0)
+	 ;; Find backward the point where kinsoku-eol characters begin.
+	 (let ((count 4))
+	   (while
+	       (progn
+		 (backward-char 1)
+		 (and (> (setq count (1- count)) 0)
+		      (not (memq (preceding-char) (list ?\C-@ ?\n ? )))
+		      (or (shr-char-kinsoku-eol-p (preceding-char))
+			  (shr-char-kinsoku-bol-p (following-char)))))))
+	 (if (setq failed (= (current-column) shr-indentation))
+	     ;; There's no breakable point that doesn't violate kinsoku,
+	     ;; so we go to the second best position.
+	     (if (looking-at "\\(\\c<+\\)\\c<")
+		 (goto-char (match-end 1))
+	       (forward-char 1))))
+	((shr-char-kinsoku-bol-p (following-char))
+	 ;; Find forward the point where kinsoku-bol characters end.
+	 (let ((count 4))
+	   (while (progn
+		    (forward-char 1)
+		    (and (>= (setq count (1- count)) 0)
 			 (shr-char-kinsoku-bol-p (following-char))
-			 (shr-char-breakable-p (following-char)))
-	       (forward-char 1))))))
+			 (shr-char-breakable-p (following-char))))))))
        (when (eq (following-char) ? )
 	 (forward-char 1))))
     (not failed)))
@@ -422,6 +484,9 @@ the URL of the image to the kill buffer instead."
 	(string-match "\\`[a-z]*:" url)
 	(not shr-base))
     url)
+   ((and (string-match "\\`//" url)
+	 (string-match "\\`[a-z]*:" shr-base))
+    (concat (match-string 0 shr-base) url))
    ((and (not (string-match "/\\'" shr-base))
 	 (not (string-match "\\`/" url)))
     (concat shr-base "/" url))
@@ -442,7 +507,7 @@ the URL of the image to the kill buffer instead."
       (if (save-excursion
 	    (beginning-of-line)
 	    (looking-at " *$"))
-	  (insert "\n")
+	  (delete-region (match-beginning 0) (match-end 0))
 	(insert "\n\n")))))
 
 (defun shr-indent ()
@@ -478,7 +543,7 @@ the URL of the image to the kill buffer instead."
      ((not url)
       (message "No link under point"))
      ((string-match "^mailto:" url)
-      (browse-url-mailto url))
+      (browse-url-mail url))
      (t
       (browse-url url)))))
 
@@ -489,7 +554,8 @@ the URL of the image to the kill buffer instead."
     (if (not url)
 	(message "No link under point")
       (url-retrieve (shr-encode-url url)
-		    'shr-store-contents (list url directory)))))
+		    'shr-store-contents (list url directory)
+		    nil t))))
 
 (defun shr-store-contents (status url directory)
   (unless (plist-get status :error)
@@ -499,74 +565,97 @@ the URL of the image to the kill buffer instead."
 		    (expand-file-name (file-name-nondirectory url)
 				      directory)))))
 
-(defun shr-image-fetched (status buffer start end)
-  (when (and (buffer-name buffer)
-	     (not (plist-get status :error)))
-    (url-store-in-cache (current-buffer))
-    (when (or (search-forward "\n\n" nil t)
-	      (search-forward "\r\n\r\n" nil t))
-      (let ((data (buffer-substring (point) (point-max))))
-        (with-current-buffer buffer
-	  (save-excursion
-	    (let ((alt (buffer-substring start end))
-		  (inhibit-read-only t))
-	      (delete-region start end)
-	      (goto-char start)
-	      (funcall shr-put-image-function data alt)))))))
-  (kill-buffer (current-buffer)))
-
-(defun shr-put-image (data alt)
+(defun shr-image-fetched (status buffer start end &optional flags)
+  (let ((image-buffer (current-buffer)))
+    (when (and (buffer-name buffer)
+	       (not (plist-get status :error)))
+      (url-store-in-cache image-buffer)
+      (when (or (search-forward "\n\n" nil t)
+		(search-forward "\r\n\r\n" nil t))
+	(let ((data (buffer-substring (point) (point-max))))
+	  (with-current-buffer buffer
+	    (save-excursion
+	      (let ((alt (buffer-substring start end))
+		    (properties (text-properties-at start))
+		    (inhibit-read-only t))
+		(delete-region start end)
+		(goto-char start)
+		(funcall shr-put-image-function data alt flags)
+		(while properties
+		  (let ((type (pop properties))
+			(value (pop properties)))
+		    (unless (memq type '(display image-size))
+		      (put-text-property start (point) type value))))))))))
+    (kill-buffer image-buffer)))
+
+(defun shr-put-image (data alt &optional flags)
   "Put image DATA with a string ALT.  Return image."
   (if (display-graphic-p)
-      (let ((image (ignore-errors
-                     (shr-rescale-image data))))
+      (let* ((size (cdr (assq 'size flags)))
+	     (start (point))
+	     (image (cond
+		     ((eq size 'original)
+		      (create-image data nil t :ascent 100))
+		     ((eq size 'full)
+		      (ignore-errors
+			(shr-rescale-image data t)))
+		     (t
+		      (ignore-errors
+			(shr-rescale-image data))))))
         (when image
 	  ;; When inserting big-ish pictures, put them at the
 	  ;; beginning of the line.
 	  (when (and (> (current-column) 0)
 		     (> (car (image-size image t)) 400))
 	    (insert "\n"))
-	  (insert-image image (or alt "*")))
+	  (if (eq size 'original)
+	      (let ((overlays (overlays-at (point))))
+		(insert-sliced-image image (or alt "*") nil 20 1)
+		(dolist (overlay overlays)
+		  (overlay-put overlay 'face 'default)))
+	    (insert-image image (or alt "*")))
+	  (put-text-property start (point) 'image-size size)
+	  (when (image-animated-p image)
+	    (image-animate image nil 60)))
 	image)
     (insert alt)))
 
-(defun shr-rescale-image (data)
-  (if (or (not (fboundp 'imagemagick-types))
-	  (not (get-buffer-window (current-buffer))))
-      (create-image data nil t
-		    :ascent 100)
-    (let* ((image (create-image data nil t :ascent 100))
-	   (size (image-size image t))
-	   (width (car size))
-	   (height (cdr size))
-	   (edges (window-inside-pixel-edges
-		   (get-buffer-window (current-buffer))))
-	   (window-width (truncate (* shr-max-image-proportion
-				      (- (nth 2 edges) (nth 0 edges)))))
-	   (window-height (truncate (* shr-max-image-proportion
-				       (- (nth 3 edges) (nth 1 edges)))))
-	   scaled-image)
-      (when (> height window-height)
-	(setq image (or (create-image data 'imagemagick t
-				      :height window-height)
-			image))
-	(setq size (image-size image t)))
-      (when (> (car size) window-width)
-	(setq image (or
-		     (create-image data 'imagemagick t
-				   :width window-width
-				   :ascent 100)
-		     image)))
-      (when (and (fboundp 'create-animated-image)
-		 (eq (image-type data nil t) 'gif))
-	(setq image (create-animated-image data 'gif t
-					   :ascent 100)))
-      image)))
+(defun shr-rescale-image (data &optional force)
+  "Rescale DATA, if too big, to fit the current buffer.
+If FORCE, rescale the image anyway."
+  (let ((image (create-image data nil t :ascent 100)))
+    (if (or (not (fboundp 'imagemagick-types))
+	    (not (get-buffer-window (current-buffer))))
+	image
+      (let* ((size (image-size image t))
+	     (width (car size))
+	     (height (cdr size))
+	     (edges (window-inside-pixel-edges
+		     (get-buffer-window (current-buffer))))
+	     (window-width (truncate (* shr-max-image-proportion
+					(- (nth 2 edges) (nth 0 edges)))))
+	     (window-height (truncate (* shr-max-image-proportion
+					 (- (nth 3 edges) (nth 1 edges)))))
+	     scaled-image)
+	(when (or force
+		  (> height window-height))
+	  (setq image (or (create-image data 'imagemagick t
+					:height window-height
+					:ascent 100)
+			  image))
+	  (setq size (image-size image t)))
+	(when (> (car size) window-width)
+	  (setq image (or
+		       (create-image data 'imagemagick t
+				     :width window-width
+				     :ascent 100)
+		       image)))
+	image))))
 
 ;; url-cache-extract autoloads url-cache.
 (declare-function url-cache-create-filename "url-cache" (url))
 (autoload 'mm-disable-multibyte "mm-util")
-(autoload 'browse-url-mailto "browse-url")
+(autoload 'browse-url-mail "browse-url")
 
 (defun shr-get-image-data (url)
   "Get image data for URL.
@@ -584,7 +673,7 @@ Return a string with image data."
   "Return a function to display an image.
 CONTENT-FUNCTION is a function to retrieve an image for a cid url that
 is an argument.  The function to be returned takes three arguments URL,
-START, and END.  Note that START and END should be merkers."
+START, and END.  Note that START and END should be markers."
   `(lambda (url start end)
      (when url
        (if (string-match "\\`cid:" url)
@@ -598,7 +687,7 @@ START, and END.  Note that START and END should be merkers."
 		   (delete-region (point) end))))
 	 (url-retrieve url 'shr-image-fetched
 		       (list (current-buffer) start end)
-		       t)))))
+		       t t)))))
 
 (defun shr-heading (cont &rest types)
   (shr-ensure-paragraph)
@@ -688,7 +777,7 @@ ones, in case fg and bg are nil."
     (forward-line 1)
     (setq end (point))
     (narrow-to-region start end)
-    (let ((width (shr-natural-width))
+    (let ((width (shr-buffer-width))
 	  column)
       (goto-char (point-min))
       (while (not (eobp))
@@ -763,6 +852,9 @@ ones, in case fg and bg are nil."
 (defun shr-tag-script (cont)
   )
 
+(defun shr-tag-comment (cont)
+  )
+
 (defun shr-tag-sup (cont)
   (let ((start (point)))
     (shr-generic cont)
@@ -895,23 +987,27 @@ ones, in case fg and bg are nil."
 	    (if (> (string-width alt) 8)
 		(shr-insert (truncate-string-to-width alt 8))
 	      (shr-insert alt))))
-	 ((url-is-cached (shr-encode-url url))
+	 ((and (not shr-ignore-cache)
+	       (url-is-cached (shr-encode-url url)))
 	  (funcall shr-put-image-function (shr-get-image-data url) alt))
 	 (t
-	  (insert alt)
-	  (funcall
-	   (if (fboundp 'url-queue-retrieve)
-	       'url-queue-retrieve
-	     'url-retrieve)
+	  (insert alt " ")
+	  (when (and shr-ignore-cache
+		     (url-is-cached (shr-encode-url url)))
+	    (let ((file (url-cache-create-filename (shr-encode-url url))))
+	      (when (file-exists-p file)
+		(delete-file file))))
+	  (url-queue-retrieve
 	   (shr-encode-url url) 'shr-image-fetched
-	   (list (current-buffer) start (point-marker))
-	   t)))
-	(put-text-property start (point) 'keymap shr-map)
-	(put-text-property start (point) 'shr-alt alt)
-	(put-text-property start (point) 'image-url url)
-	(put-text-property start (point) 'image-displayer
-			   (shr-image-displayer shr-content-function))
-	(put-text-property start (point) 'help-echo alt)
+	   (list (current-buffer) start (set-marker (make-marker) (1- (point))))
+	   t t)))
+	(when (zerop shr-table-depth) ;; We are not in a table.
+	  (put-text-property start (point) 'keymap shr-map)
+	  (put-text-property start (point) 'shr-alt alt)
+	  (put-text-property start (point) 'image-url url)
+	  (put-text-property start (point) 'image-displayer
+			     (shr-image-displayer shr-content-function))
+	  (put-text-property start (point) 'help-echo alt))
 	(setq shr-state 'image)))))
 
 (defun shr-tag-pre (cont)
@@ -954,7 +1050,12 @@ ones, in case fg and bg are nil."
     (shr-generic cont)))
 
 (defun shr-tag-br (cont)
-  (unless (bobp)
+  (when (and (not (bobp))
+	     ;; Only add a newline if we break the current line, or
+	     ;; the previous line isn't a blank line.
+	     (or (not (bolp))
+		 (and (> (- (point) 2) (point-min))
+		      (not (= (char-after (- (point) 2)) ?\n)))))
     (insert "\n")
     (shr-indent))
   (shr-generic cont))
@@ -1018,7 +1119,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))
@@ -1047,44 +1151,53 @@ ones, in case fg and bg are nil."
 	 (nheader (if header (shr-max-columns header)))
 	 (nbody (if body (shr-max-columns body)))
 	 (nfooter (if footer (shr-max-columns footer))))
-    (shr-tag-table-1
-     (nconc
-      (if caption `((tr (td ,@caption))))
-      (if header
-	  (if footer
-	      ;; hader + body + footer
+    (if (and (not caption)
+	     (not header)
+	     (not (cdr (assq 'tbody cont)))
+	     (not (cdr (assq 'tr cont)))
+	     (not footer))
+	;; The table is totally invalid and just contains random junk.
+	;; Try to output it anyway.
+	(shr-generic cont)
+      ;; It's a real table, so render it.
+      (shr-tag-table-1
+       (nconc
+	(if caption `((tr (td ,@caption))))
+	(if header
+	    (if footer
+		;; hader + body + footer
+		(if (= nheader nbody)
+		    (if (= nbody nfooter)
+			`((tr (td (table (tbody ,@header ,@body ,@footer)))))
+		      (nconc `((tr (td (table (tbody ,@header ,@body)))))
+			     (if (= nfooter 1)
+				 footer
+			       `((tr (td (table (tbody ,@footer))))))))
+		  (nconc `((tr (td (table (tbody ,@header)))))
+			 (if (= nbody nfooter)
+			     `((tr (td (table (tbody ,@body ,@footer)))))
+			   (nconc `((tr (td (table (tbody ,@body)))))
+				  (if (= nfooter 1)
+				      footer
+				    `((tr (td (table (tbody ,@footer))))))))))
+	      ;; header + body
 	      (if (= nheader nbody)
-		  (if (= nbody nfooter)
-		      `((tr (td (table (tbody ,@header ,@body ,@footer)))))
-		    (nconc `((tr (td (table (tbody ,@header ,@body)))))
-			   (if (= nfooter 1)
-			       footer
-			     `((tr (td (table (tbody ,@footer))))))))
-		(nconc `((tr (td (table (tbody ,@header)))))
-		       (if (= nbody nfooter)
-			   `((tr (td (table (tbody ,@body ,@footer)))))
-			 (nconc `((tr (td (table (tbody ,@body)))))
-				(if (= nfooter 1)
-				    footer
-				  `((tr (td (table (tbody ,@footer))))))))))
-	    ;; header + body
-	    (if (= nheader nbody)
-		`((tr (td (table (tbody ,@header ,@body)))))
-	      (if (= nheader 1)
-		  `(,@header (tr (td (table (tbody ,@body)))))
-		`((tr (td (table (tbody ,@header))))
-		  (tr (td (table (tbody ,@body))))))))
-	(if footer
-	    ;; body + footer
-	    (if (= nbody nfooter)
-		`((tr (td (table (tbody ,@body ,@footer)))))
-	      (nconc `((tr (td (table (tbody ,@body)))))
-		     (if (= nfooter 1)
-			 footer
-		       `((tr (td (table (tbody ,@footer))))))))
-	  (if caption
-	      `((tr (td (table (tbody ,@body)))))
-	    body)))))
+		  `((tr (td (table (tbody ,@header ,@body)))))
+		(if (= nheader 1)
+		    `(,@header (tr (td (table (tbody ,@body)))))
+		  `((tr (td (table (tbody ,@header))))
+		    (tr (td (table (tbody ,@body))))))))
+	  (if footer
+	      ;; body + footer
+	      (if (= nbody nfooter)
+		  `((tr (td (table (tbody ,@body ,@footer)))))
+		(nconc `((tr (td (table (tbody ,@body)))))
+		       (if (= nfooter 1)
+			   footer
+			 `((tr (td (table (tbody ,@footer))))))))
+	    (if caption
+		`((tr (td (table (tbody ,@body)))))
+	      body))))))
     (when bgcolor
       (shr-colorize-region start (point) (cdr (assq 'color shr-stylesheet))
 			   bgcolor))))
@@ -1147,31 +1260,35 @@ 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)))))
+    (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.
       (when (> extra 0)
+	;; If the natural width is wider than the rendered width, we
+	;; want to allow the column to expand.
 	(dotimes (i length)
-	  ;; If the natural width is wider than the rendered width, we
-	  ;; want to allow the column to expand.
 	  (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
-			    (1+ (aref natural-widths i))
+			    (aref natural-widths i)
 			    (+ (/ extra expanded-columns)
 			       (aref widths i))))))))
     widths))
@@ -1226,10 +1343,13 @@ ones, in case fg and bg are nil."
 	  (let ((shr-width width)
 		(shr-indentation 0))
 	    (shr-descend (cons 'td cont)))
+	  ;; Delete padding at the bottom of the TDs.
 	  (delete-region
 	   (point)
-	   (+ (point)
-	      (skip-chars-backward " \t\n")))
+	   (progn
+	     (skip-chars-backward " \t\n")
+	     (end-of-line)
+	     (point)))
 	  (push (list (cons width cont) (buffer-string)
 		      (shr-overlays-in-region (point-min) (point-max)))
 		shr-content-cache)))
@@ -1263,19 +1383,14 @@ 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 ()
+(defun shr-buffer-width ()
   (goto-char (point-min))
-  (let ((current 0)
-	(max 0))
+  (let ((max 0))
     (while (not (eobp))
       (end-of-line)
-      (setq current (+ current (current-column)))
-      (unless (get-text-property (point) 'shr-break)
-	(setq max (max max current)
-	      current 0))
+      (setq max (max max (current-column)))
       (forward-line 1))
     max))
 
@@ -1325,10 +1440,10 @@ ones, in case fg and bg are nil."
 	    (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))))
+			   (string-match "\\([0-9]+\\)%" width)
+			   (not (zerop (setq width (string-to-number
+						    (match-string 1 width))))))
+		  (aset columns i (/ width 100.0))))
 	      (setq i (1+ i)))))))
     columns))
 
@@ -1349,4 +1464,8 @@ ones, in case fg and bg are nil."
 
 (provide 'shr)
 
+;; Local Variables:
+;; coding: iso-8859-1
+;; End:
+
 ;;; shr.el ends here