From f6d781c29456590dfb10e1710171e8d983eeb9e2 Mon Sep 17 00:00:00 2001
From: Lars Magne Ingebrigtsen <larsi@gnus.org>
Date: Tue, 10 Feb 2015 18:52:36 +1100
Subject: [PATCH] Fix up :align-to background colours

(shr-insert-table): Only copy the background, not underline and
the like.
(shr-face-background): New function.
---
 lisp/ChangeLog  |  3 +++
 lisp/net/shr.el | 21 ++++++++++++++++-----
 2 files changed, 19 insertions(+), 5 deletions(-)

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 5737113a737..eee6744b15e 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -38,6 +38,9 @@
 	(shr-table-widths): Off-by-one error in width computation.
 	(shr-expand-newlines): Remove dead code.
 	(shr-insert-table): Extend background colors to the end of the column.
+	(shr-insert-table): Only copy the background, not underline and
+	the like.
+	(shr-face-background): New function.
 
 2015-02-10  Fabián Ezequiel Gallina  <fgallina@gnu.org>
 
diff --git a/lisp/net/shr.el b/lisp/net/shr.el
index f40fd34cb8e..a65f7923f57 100644
--- a/lisp/net/shr.el
+++ b/lisp/net/shr.el
@@ -516,9 +516,9 @@ size, and full-buffer size."
 	(when bolp
 	  (shr-mark-fill start))
 	(when shr-use-fonts
-	  (add-face-text-property start (point)
-				  (or shr-current-font 'variable-pitch)
-				  t)))))))
+	  (put-text-property start (point)
+			     'face
+			     (or shr-current-font 'variable-pitch))))))))
 
 (defun shr-fill-lines (start end)
   (if (<= shr-internal-width 0)
@@ -1644,8 +1644,9 @@ The preference is a float determined from `shr-prefer-media-type'."
 		   (propertize " "
 			       'display `(space :align-to (,pixel-align))
 			       'face (and (> (length line) 0)
-					  (get-text-property
-					   (1- (length line)) 'face line))
+					  (shr-face-background
+					   (get-text-property
+					    (1- (length line)) 'face line)))
 			       'shr-table-indent shr-table-id)
 		   shr-table-vertical-line)
 		  (shr-colorize-region
@@ -1668,6 +1669,16 @@ The preference is a float determined from `shr-prefer-media-type'."
     (unless (= start (point))
       (put-text-property start (1+ start) 'shr-table-id shr-table-id))))
 
+(defun shr-face-background (face)
+  (and (consp face)
+       (let ((background nil))
+	 (dolist (elem face)
+	   (when (and (consp elem)
+		      (eq (car elem) :background))
+	     (setq background (cadr elem))))
+	 (and background
+	      (list :background background)))))
+
 (defun shr-expand-alignments (start end)
   (while (< (setq start (next-single-property-change
 			 start 'shr-table-id nil end))
-- 
2.11.4.GIT