Proof of concept implemantation of boxy backgrounds.

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index ce65cdd..cd5e4f6 100644 (file)
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,8 @@
+2011-01-24  Lars Ingebrigtsen  <larsi@gnus.org>
+
+       * shr.el (shr-expand-newlines): Proof of concept implemantation of boxy
+       backgrounds.
+
 2011-01-24  Teodor Zlatanov  <tzz@lifelogs.com>
 
        * mml-smime.el (mml-smime-use): Make it a defcustom and default to 'epg

diff --git a/lisp/shr.el b/lisp/shr.el
index 174b1ff..be87ec6 100644 (file)
--- a/lisp/shr.el
+++ b/lisp/shr.el
@@ -642,7 +642,26 @@ ones, in case fg and bg are nil."
        (shr-put-color-1 (point) (min (line-end-position) end) type color))
       (if (< (line-end-position) end)
          (forward-line 1)
-       (goto-char end)))))
+       (goto-char end)))
+    (when (eq type :background)
+      (shr-expand-newlines start end color))))
+
+(defun shr-expand-newlines (start end color)
+  (save-restriction
+    (narrow-to-region start end)
+    (let ((width (shr-natural-width))
+         column)
+      (goto-char (point-min))
+      (while (not (eobp))
+       (end-of-line)
+       (when (and (< (setq current-column (current-column)) width)
+                  (not (get-text-property (point) 'display)))
+         (put-text-property
+          (point) (1+ (point)) 'display
+          (concat (propertize (make-string (- width current-column) ? )
+                              'face (list :background color))
+                  "\n")))
+       (forward-line 1)))))
 
 (defun shr-put-color-1 (start end type color)
   (let* ((old-props (get-text-property start 'face))