[Emacs-diffs] /srv/bzr/emacs/trunk r102974: shr.el (shr-expand-newlines): Make nested boxes work.

[Katsumi Yamaoka]

------------------------------------------------------------
revno: 102974
author: Lars Ingebrigtsen <address@hidden>
committer: Katsumi Yamaoka <address@hidden>
branch nick: trunk
timestamp: Tue 2011-01-25 08:42:32 +0000
message:
  shr.el (shr-expand-newlines): Make nested boxes work.
modified:
  lisp/gnus/ChangeLog
  lisp/gnus/shr.el

=== modified file 'lisp/gnus/ChangeLog'
--- a/lisp/gnus/ChangeLog       2011-01-25 04:08:28 +0000
+++ b/lisp/gnus/ChangeLog       2011-01-25 08:42:32 +0000
@@ -1,3 +1,7 @@
+2011-01-25  Lars Ingebrigtsen  <address@hidden>
+
+       * shr.el (shr-expand-newlines): Make nested boxes work.
+
 2011-01-24  Lars Ingebrigtsen  <address@hidden>
 
        * shr.el (shr-expand-newlines): Proof of concept implemantation of boxy

=== modified file 'lisp/gnus/shr.el'
--- a/lisp/gnus/shr.el  2011-01-25 04:08:28 +0000
+++ b/lisp/gnus/shr.el  2011-01-25 08:42:32 +0000
@@ -648,6 +648,15 @@
 
 (defun shr-expand-newlines (start end color)
   (save-restriction
+    ;; Skip past all white space at the start and ends.
+    (goto-char start)
+    (skip-chars-forward " \t\n")
+    (beginning-of-line)
+    (setq start (point))
+    (goto-char end)
+    (skip-chars-backward " \t\n")
+    (forward-line 1)
+    (setq end (point))
     (narrow-to-region start end)
     (let ((width (shr-natural-width))
          column)
@@ -655,13 +664,36 @@
       (while (not (eobp))
        (end-of-line)
        (when (and (< (setq current-column (current-column)) width)
-                  (not (overlays-at (point))))
+                  (< (setq current-column (shr-previous-newline-padding-width
+                                           current-column))
+                     width))
          (let ((overlay (make-overlay (point) (1+ (point)))))
            (overlay-put overlay 'before-string
-                        (propertize (make-string (- width current-column) ? )
-                                    'face (list :background color)))))
+                        (concat
+                         (mapconcat
+                          (lambda (overlay)
+                            (let ((string (getf (overlay-properties overlay) 
'before-string)))
+                              (if (not string)
+                                  ""
+                                (overlay-put overlay 'before-string "")
+                                string)))
+                          (overlays-at (point))
+                          "")
+                         (propertize (make-string (- width current-column) ? )
+                                     'face (list :background color))))))
        (forward-line 1)))))
 
+(defun shr-previous-newline-padding-width (width)
+  (let ((overlays (overlays-at (point)))
+       (previous-width 0))
+    (if (null overlays)
+       width
+      (dolist (overlay overlays)
+       (setq previous-width
+             (+ previous-width
+                (length (getf (overlay-properties overlay) 'before-string)))))
+      (+ width previous-width))))
+
 (defun shr-put-color-1 (start end type color)
   (let* ((old-props (get-text-property start 'face))
         (do-put (not (memq type old-props)))