X-Git-Url: http://cgit.sxemacs.org/?p=gnus;a=blobdiff_plain;f=lisp%2Fshr.el;h=ba1ca1b380b7ebb6da22654a593efb88127085c9;hp=954e97426d64cfd413e58b95f3d37a8c418195c7;hb=0083071bc8c341265712e48a4cd128d280fbec94;hpb=cc6f03bae1277e4cc0c6d59ef4aa8441d9bffc29 diff --git a/lisp/shr.el b/lisp/shr.el index 954e97426..ba1ca1b38 100644 --- a/lisp/shr.el +++ b/lisp/shr.el @@ -333,6 +333,7 @@ size, and full-buffer size." (defun shr-insert (text) (when (and (eq shr-state 'image) + (not (bolp)) (not (string-match "\\`[ \t\n]+\\'" text))) (insert "\n") (setq shr-state nil)) @@ -340,11 +341,11 @@ size, and full-buffer size." ((eq shr-folding-mode 'none) (insert text)) (t - (when (and (string-match "\\`[ \t\n]" text) + (when (and (string-match "\\`[ \t\n ]" text) (not (bolp)) (not (eq (char-after (1- (point))) ? ))) (insert " ")) - (dolist (elem (split-string text)) + (dolist (elem (split-string text "[ \f\t\n\r\v ]+" t)) (when (and (bolp) (> shr-indentation 0)) (shr-indent)) @@ -367,6 +368,7 @@ size, and full-buffer size." (unless shr-start (setq shr-start (point))) (insert elem) + (setq shr-state nil) (let (found) (while (and (> (current-column) shr-width) (progn @@ -376,7 +378,6 @@ size, and full-buffer size." (delete-char -1)) (insert "\n") (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))) @@ -384,7 +385,7 @@ size, and full-buffer size." (shr-indent)) (end-of-line)) (insert " "))) - (unless (string-match "[ \t\n]\\'" text) + (unless (string-match "[ \t\n ]\\'" text) (delete-char -1))))) (defun shr-find-fill-point () @@ -770,7 +771,7 @@ ones, in case fg and bg are nil." (forward-line 1) (setq end (point)) (narrow-to-region start end) - (let ((width (shr-natural-width)) + (let ((width (shr-buffer-width)) column) (goto-char (point-min)) (while (not (eobp)) @@ -1043,7 +1044,7 @@ ones, in case fg and bg are nil." (shr-generic cont))) (defun shr-tag-br (cont) - (unless (bobp) + (unless (bolp) (insert "\n") (shr-indent)) (shr-generic cont)) @@ -1107,7 +1108,10 @@ ones, in case fg and bg are nil." ;; be smaller (if there's little text) or bigger (if there's ;; unbreakable text). (sketch (shr-make-table cont suggested-widths)) - (sketch-widths (shr-table-widths sketch suggested-widths))) + ;; Compute the "natural" width by setting each column to 500 + ;; characters and see how wide they really render. + (natural (shr-make-table cont (make-vector (length columns) 500))) + (sketch-widths (shr-table-widths sketch natural suggested-widths))) ;; This probably won't work very well. (when (> (+ (loop for width across sketch-widths summing (1+ width)) @@ -1245,31 +1249,35 @@ ones, in case fg and bg are nil." shr-table-corner)) (insert "\n")) -(defun shr-table-widths (table suggested-widths) +(defun shr-table-widths (table natural-table suggested-widths) (let* ((length (length suggested-widths)) (widths (make-vector length 0)) (natural-widths (make-vector length 0))) (dolist (row table) (let ((i 0)) (dolist (column row) - (aset widths i (max (aref widths i) - (car column))) - (aset natural-widths i (max (aref natural-widths i) - (cadr column))) + (aset widths i (max (aref widths i) column)) + (setq i (1+ i))))) + (dolist (row natural-table) + (let ((i 0)) + (dolist (column row) + (aset natural-widths i (max (aref natural-widths i) column)) (setq i (1+ i))))) (let ((extra (- (apply '+ (append suggested-widths nil)) (apply '+ (append widths nil)))) (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)) + (aref natural-widths i) (+ (/ extra expanded-columns) (aref widths i)))))))) widths)) @@ -1324,10 +1332,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))) @@ -1361,19 +1372,14 @@ ones, in case fg and bg are nil." (split-string (buffer-string) "\n") (shr-collect-overlays) (car actual-colors)) - (list max - (shr-natural-width))))))) + max))))) -(defun shr-natural-width () +(defun shr-buffer-width () (goto-char (point-min)) - (let ((current 0) - (max 0)) + (let ((max 0)) (while (not (eobp)) (end-of-line) - (setq current (+ current (current-column))) - (unless (get-text-property (point) 'shr-break) - (setq max (max max current) - current 0)) + (setq max (max max (current-column))) (forward-line 1)) max)) @@ -1423,10 +1429,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))