Merge remote branch 'origin/no-gnus'

[gnus] / lisp / shr.el

diff --git a/lisp/shr.el b/lisp/shr.el
index 7815845..5021eab 100644 (file)
--- a/lisp/shr.el
+++ b/lisp/shr.el
@@ -161,7 +161,7 @@ DOM should be a parse tree as generated by
       (goto-char start)
       (while (not (eobp))
        (end-of-line)
-       (when (> (current-column) width)
+       (when (> (shr-previous-newline-padding-width (current-column)) width)
          (dolist (overlay (overlays-at (point)))
            (when (overlay-get overlay 'before-string)
              (overlay-put overlay 'before-string nil))))
@@ -375,8 +375,8 @@ size, and full-buffer size."
          (when (eq (preceding-char) ? )
            (delete-char -1))
          (insert "\n")
+         (put-text-property (1- (point)) (point) 'shr-break t)
          (unless found
-           (put-text-property (1- (point)) (point) 'shr-break t)
            ;; No space is needed at the beginning of a line.
            (when (eq (following-char) ? )
              (delete-char 1)))
@@ -559,26 +559,27 @@ size, and full-buffer size."
                                      directory)))))
 
 (defun shr-image-fetched (status buffer start end &optional flags)
-  (when (and (buffer-name buffer)
-            (not (plist-get status :error)))
-    (url-store-in-cache (current-buffer))
-    (when (or (search-forward "\n\n" nil t)
-             (search-forward "\r\n\r\n" nil t))
-      (let ((data (buffer-substring (point) (point-max))))
-        (with-current-buffer buffer
-         (save-excursion
-           (let ((alt (buffer-substring start end))
-                 (properties (text-properties-at start))
-                 (inhibit-read-only t))
-             (delete-region start end)
-             (goto-char start)
-             (funcall shr-put-image-function data alt flags)
-             (while properties
-               (let ((type (pop properties))
-                     (value (pop properties)))
-                 (unless (memq type '(display image-size))
-                   (put-text-property start (point) type value))))))))))
-  (kill-buffer (current-buffer)))
+  (let ((image-buffer (current-buffer)))
+    (when (and (buffer-name buffer)
+              (not (plist-get status :error)))
+      (url-store-in-cache image-buffer)
+      (when (or (search-forward "\n\n" nil t)
+               (search-forward "\r\n\r\n" nil t))
+       (let ((data (buffer-substring (point) (point-max))))
+         (with-current-buffer buffer
+           (save-excursion
+             (let ((alt (buffer-substring start end))
+                   (properties (text-properties-at start))
+                   (inhibit-read-only t))
+               (delete-region start end)
+               (goto-char start)
+               (funcall shr-put-image-function data alt flags)
+               (while properties
+                 (let ((type (pop properties))
+                       (value (pop properties)))
+                   (unless (memq type '(display image-size))
+                     (put-text-property start (point) type value))))))))))
+    (kill-buffer image-buffer)))
 
 (defun shr-put-image (data alt &optional flags)
   "Put image DATA with a string ALT.  Return image."
@@ -1256,21 +1257,26 @@ ones, in case fg and bg are nil."
          (aset natural-widths i (max (aref natural-widths i)
                                      (cadr column)))
          (setq i (1+ i)))))
-    (let ((extra (- (apply '+ (append suggested-widths nil))
-                   (apply '+ (append widths nil))))
-         (expanded-columns 0))
+    (let* ((total-suggested (apply '+ (append suggested-widths nil)))
+          (total-actual (apply '+ (append widths nil)))
+          (extra (- total-suggested
+                    total-actual
+                    ;; TD separators.
+                    (length widths)
+                    ;; Table separators + fence.
+                    3
+                    (* 2 shr-table-depth)))
+          (expanded-columns 0))
+      ;; We have extra, unused space, so divide this space amongst the
+      ;; columns.
       (when (> extra 0)
+       ;; If the natural width is wider than the rendered width, we
+       ;; want to allow the column to expand.
        (dotimes (i length)
-         ;; If the natural width is wider than the rendered width, we
-         ;; want to allow the column to expand.
-         (when (> (aref natural-widths i) (aref widths i))
-           (setq expanded-columns (1+ expanded-columns))))
-       (dotimes (i length)
-         (when (> (aref natural-widths i) (aref widths i))
-           (aset widths i (min
-                           (1+ (aref natural-widths i))
-                           (+ (/ extra expanded-columns)
-                              (aref widths i))))))))
+         (when (> (aref natural-widths i) 0)
+           (aset widths i (+ (truncate (* (/ extra (* 1.0 total-actual))
+                                          (aref widths i)))
+                             (aref widths i)))))))
     widths))
 
 (defun shr-make-table (cont widths &optional fill)
@@ -1323,10 +1329,13 @@ ones, in case fg and bg are nil."
          (let ((shr-width width)
                (shr-indentation 0))
            (shr-descend (cons 'td cont)))
+         ;; Delete padding at the bottom of the TDs.
          (delete-region
           (point)
-          (+ (point)
-             (skip-chars-backward " \t\n")))
+          (progn
+            (skip-chars-backward " \t\n")
+            (end-of-line)
+            (point)))
          (push (list (cons width cont) (buffer-string)
                      (shr-overlays-in-region (point-min) (point-max)))
                shr-content-cache)))
@@ -1370,7 +1379,8 @@ ones, in case fg and bg are nil."
     (while (not (eobp))
       (end-of-line)
       (setq current (+ current (current-column)))
-      (unless (get-text-property (point) 'shr-break)
+      (if (get-text-property (point) 'shr-break)
+         (incf current)
        (setq max (max max current)
              current 0))
       (forward-line 1))
@@ -1422,10 +1432,10 @@ ones, in case fg and bg are nil."
            (when (memq (car column) '(td th))
              (let ((width (cdr (assq :width (cdr column)))))
                (when (and width
-                          (string-match "\\([0-9]+\\)%" width))
-                 (aset columns i
-                       (/ (string-to-number (match-string 1 width))
-                          100.0))))
+                          (string-match "\\([0-9]+\\)%" width)
+                          (not (zerop (setq width (string-to-number
+                                                   (match-string 1 width))))))
+                 (aset columns i (/ width 100.0))))
              (setq i (1+ i)))))))
     columns))