[Emacs-diffs] master f6d781c: Fix up :align-to background colours

[Lars Ingebrigtsen]

branch: master
commit f6d781c29456590dfb10e1710171e8d983eeb9e2
Author: Lars Magne Ingebrigtsen <address@hidden>
Commit: Lars Magne Ingebrigtsen <address@hidden>

    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 5737113..eee6744 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  <address@hidden>
 
diff --git a/lisp/net/shr.el b/lisp/net/shr.el
index f40fd34..a65f792 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))