Fix up :align-to background colours

(shr-insert-table): Only copy the background, not underline and
the like.
(shr-face-background): New function.

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 5737113a73716028b9ee5dc40e67c1e0a9ddb412..eee6744b15ea892a773cbca45ef235ac5a2f2268 100644 (file)
--- 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 f40fd34cb8e18dea6c72ac8efbfcf985622a2699..a65f7923f57ba8382c7ecf5ace6386c611cd5601 100644 (file)
--- 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))