Only strip whitespace from too-wide lines in shr

[gnus] / lisp / shr.el

diff --git a/lisp/shr.el b/lisp/shr.el
index 588b0e2..7af8e31 100644 (file)
--- a/lisp/shr.el
+++ b/lisp/shr.el
@@ -1,6 +1,6 @@
 ;;; shr.el --- Simple HTML Renderer
 
-;; Copyright (C) 2010-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2012 Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;; Keywords: html
@@ -53,17 +53,17 @@ fit these criteria."
   :group 'shr
   :type 'regexp)
 
-(defcustom shr-table-horizontal-line ? 
+(defcustom shr-table-horizontal-line ?\s
   "Character used to draw horizontal table lines."
   :group 'shr
   :type 'character)
 
-(defcustom shr-table-vertical-line ? 
+(defcustom shr-table-vertical-line ?\s
   "Character used to draw vertical table lines."
   :group 'shr
   :type 'character)
 
-(defcustom shr-table-corner ? 
+(defcustom shr-table-corner ?\s
   "Character used to draw table corners."
   :group 'shr
   :type 'character)
@@ -128,22 +128,42 @@ cid: URL as the argument.")
 ;; Public functions and commands.
 
 (defun shr-visit-file (file)
+  "Parse FILE as an HTML document, and render it in a new buffer."
   (interactive "fHTML file name: ")
   (pop-to-buffer "*html*")
   (erase-buffer)
   (shr-insert-document
    (with-temp-buffer
      (insert-file-contents file)
-     (libxml-parse-html-region (point-min) (point-max)))))
+     (libxml-parse-html-region (point-min) (point-max))))
+  (goto-char (point-min)))
 
 ;;;###autoload
 (defun shr-insert-document (dom)
+  "Render the parsed document DOM into the current buffer.
+DOM should be a parse tree as generated by
+`libxml-parse-html-region' or similar."
   (setq shr-content-cache nil)
-  (let ((shr-state nil)
+  (let ((start (point))
+       (shr-state nil)
        (shr-start nil)
        (shr-base nil)
        (shr-width (or shr-width (window-width))))
-    (shr-descend (shr-transform-dom dom))))
+    (shr-descend (shr-transform-dom dom))
+    (shr-remove-trailing-whitespace start (point))))
+
+(defun shr-remove-trailing-whitespace (start end)
+  (let ((width (window-width)))
+    (save-restriction
+      (narrow-to-region start end)
+      (goto-char start)
+      (while (not (eobp))
+       (end-of-line)
+       (when (> (current-column) width)
+         (dolist (overlay (overlays-at (point)))
+           (when (overlay-get overlay 'before-string)
+             (overlay-put overlay 'before-string nil))))
+       (forward-line 1)))))
 
 (defun shr-copy-url ()
   "Copy the URL under point to the kill ring.
@@ -479,7 +499,7 @@ the URL of the image to the kill buffer instead."
      ((not url)
       (message "No link under point"))
      ((string-match "^mailto:" url)
-      (browse-url-mailto url))
+      (browse-url-mail url))
      (t
       (browse-url url)))))
 
@@ -534,38 +554,38 @@ the URL of the image to the kill buffer instead."
     (insert alt)))
 
 (defun shr-rescale-image (data)
-  (if (or (not (fboundp 'imagemagick-types))
-         (not (get-buffer-window (current-buffer))))
-      (create-image data nil t
-                   :ascent 100)
-    (let* ((image (create-image data nil t :ascent 100))
-          (size (image-size image t))
-          (width (car size))
-          (height (cdr size))
-          (edges (window-inside-pixel-edges
-                  (get-buffer-window (current-buffer))))
-          (window-width (truncate (* shr-max-image-proportion
-                                     (- (nth 2 edges) (nth 0 edges)))))
-          (window-height (truncate (* shr-max-image-proportion
-                                      (- (nth 3 edges) (nth 1 edges)))))
-          scaled-image)
-      (when (> height window-height)
-       (setq image (or (create-image data 'imagemagick t
-                                     :height window-height)
-                       image))
-       (setq size (image-size image t)))
-      (when (> (car size) window-width)
-       (setq image (or
-                    (create-image data 'imagemagick t
-                                  :width window-width
-                                  :ascent 100)
-                    image)))
-      image)))
+  (let ((image (create-image data nil t :ascent 100)))
+    (if (or (not (fboundp 'imagemagick-types))
+           (not (get-buffer-window (current-buffer))))
+       image
+      (let* ((size (image-size image t))
+            (width (car size))
+            (height (cdr size))
+            (edges (window-inside-pixel-edges
+                    (get-buffer-window (current-buffer))))
+            (window-width (truncate (* shr-max-image-proportion
+                                       (- (nth 2 edges) (nth 0 edges)))))
+            (window-height (truncate (* shr-max-image-proportion
+                                        (- (nth 3 edges) (nth 1 edges)))))
+            scaled-image)
+       (when (> height window-height)
+         (setq image (or (create-image data 'imagemagick t
+                                       :height window-height
+                                       :ascent 100)
+                         image))
+         (setq size (image-size image t)))
+       (when (> (car size) window-width)
+         (setq image (or
+                      (create-image data 'imagemagick t
+                                    :width window-width
+                                    :ascent 100)
+                      image)))
+       image))))
 
 ;; url-cache-extract autoloads url-cache.
 (declare-function url-cache-create-filename "url-cache" (url))
 (autoload 'mm-disable-multibyte "mm-util")
-(autoload 'browse-url-mailto "browse-url")
+(autoload 'browse-url-mail "browse-url")
 
 (defun shr-get-image-data (url)
   "Get image data for URL.