From: Lars Magne Ingebrigtsen Date: Mon, 26 Sep 2011 21:59:47 +0000 (+0000) Subject: Merge changes made in Gnus trunk. X-Git-Tag: emacs-pretest-24.0.91~269^2~2 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=2146e25680a961dbeca560622945b50e56800a4a;p=emacs.git Merge changes made in Gnus trunk. nnimap.el (nnimap-wait-for-response): Message less (bug#9540). nnheader.el (nnheader-message-maybe): New function. shr.el (shr-tag-table): Render totally broken tables better. mml.el (mml-generate-mime-1): Don't alter the contents if we're computing the boundary. pop3.el (pop3-number-of-responses): Removed. (pop3-wait-for-messages): Rewrite to take linear time instead of exponential time. --- diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog index 2cd76486bd7..c5aebafe35b 100644 --- a/lisp/gnus/ChangeLog +++ b/lisp/gnus/ChangeLog @@ -1,3 +1,20 @@ +2011-09-26 Lars Magne Ingebrigtsen + + * nnimap.el (nnimap-wait-for-response): Message less (bug#9540). + + * nnheader.el (nnheader-message-maybe): New function. + + * shr.el (shr-tag-table): Render totally broken tables better. + + * mml.el (mml-generate-mime-1): Don't alter the contents if we're + computing the boundary. + +2011-09-26 Lars Magne Ingebrigtsen + + * pop3.el (pop3-number-of-responses): Remove. + (pop3-wait-for-messages): Rewrite to take linear time instead of + exponential time. + 2011-09-24 Lars Magne Ingebrigtsen * gnus-sum.el (gnus-summary-show-article): Bind `shr-ignore-cache' to diff --git a/lisp/gnus/mml.el b/lisp/gnus/mml.el index d9861394fa0..0d2ae2a845a 100644 --- a/lisp/gnus/mml.el +++ b/lisp/gnus/mml.el @@ -540,7 +540,8 @@ If MML is non-nil, return the buffer up till the correspondent mml tag." (mml-to-mime) ;; Update handle so mml-compute-boundary can ;; detect collisions with the nested parts. - (setcdr (assoc 'contents cont) (buffer-string))) + (unless mml-inhibit-compute-boundary + (setcdr (assoc 'contents cont) (buffer-string)))) (let ((mm-7bit-chars (concat mm-7bit-chars "\x1b"))) ;; ignore 0x1b, it is part of iso-2022-jp (setq encoding (mm-body-7-or-8)))) diff --git a/lisp/gnus/nnheader.el b/lisp/gnus/nnheader.el index 6f871ccb9e8..a8e8e7d08ef 100644 --- a/lisp/gnus/nnheader.el +++ b/lisp/gnus/nnheader.el @@ -1112,6 +1112,13 @@ See `find-file-noselect' for the arguments." '(buffer-string))))) (insert-buffer-substring ,buffer ,start ,end)))) +(defvar nnheader-last-message-time '(0 0)) +(defun nnheader-message-maybe (&rest args) + (let ((now (current-time))) + (when (> (float-time (time-subtract now nnheader-last-message-time)) 1) + (setq nnheader-last-message-time now) + (apply 'nnheader-message args)))) + (when (featurep 'xemacs) (require 'nnheaderxm)) diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el index f0d3e9f3182..49cceaacf92 100644 --- a/lisp/gnus/nnimap.el +++ b/lisp/gnus/nnimap.el @@ -1723,7 +1723,8 @@ textual parts.") (looking-at "\\*")))) (not (looking-at (format "%d .*\n" sequence))))) (when messagep - (nnheader-message 7 "nnimap read %dk" (/ (buffer-size) 1000))) + (nnheader-message-maybe + 7 "nnimap read %dk" (/ (buffer-size) 1000))) (nnheader-accept-process-output process) (goto-char (point-max))) openp) diff --git a/lisp/gnus/pop3.el b/lisp/gnus/pop3.el index 8fd5382a181..ee3e6582e80 100644 --- a/lisp/gnus/pop3.el +++ b/lisp/gnus/pop3.el @@ -167,17 +167,30 @@ Use streaming commands." (defun pop3-send-streaming-command (process command count total-size) (erase-buffer) - (let ((i 1)) + (let ((i 1) + (start-point (point-min)) + (waited-for 0)) (while (>= count i) (process-send-string process (format "%s %d\r\n" command i)) ;; Only do 100 messages at a time to avoid pipe stalls. (when (zerop (% i pop3-stream-length)) - (pop3-wait-for-messages process i total-size)) - (incf i))) - (pop3-wait-for-messages process count total-size)) - -(defun pop3-wait-for-messages (process count total-size) - (while (< (pop3-number-of-responses total-size) count) + (setq start-point + (pop3-wait-for-messages process pop3-stream-length + total-size start-point)) + (incf waited-for pop3-stream-length)) + (incf i)) + (pop3-wait-for-messages process (- count waited-for) + total-size start-point))) + +(defun pop3-wait-for-messages (process count total-size start-point) + (while (> count 0) + (goto-char start-point) + (while (or (and (re-search-forward "^\\+OK" nil t) + (or (not total-size) + (re-search-forward "^\\.\r?\n" nil t))) + (re-search-forward "^-ERR " nil t)) + (decf count) + (setq start-point (point))) (unless (memq (process-status process) '(open run)) (error "pop3 process died")) (when total-size @@ -185,7 +198,8 @@ Use streaming commands." (truncate (/ (buffer-size) 1000)) (truncate (* (/ (* (buffer-size) 1.0) total-size) 100)))) - (pop3-accept-process-output process))) + (pop3-accept-process-output process)) + start-point) (defun pop3-write-to-file (file) (let ((pop-buffer (current-buffer)) @@ -219,17 +233,6 @@ Use streaming commands." (delete-char 1)) (write-region (point-min) (point-max) file nil 'nomesg))))) -(defun pop3-number-of-responses (endp) - (let ((responses 0)) - (save-excursion - (goto-char (point-min)) - (while (or (and (re-search-forward "^\\+OK" nil t) - (or (not endp) - (re-search-forward "^\\.\r?\n" nil t))) - (re-search-forward "^-ERR " nil t)) - (incf responses))) - responses)) - (defun pop3-logon (process) (let ((pop3-password pop3-password)) ;; for debugging only diff --git a/lisp/gnus/shr.el b/lisp/gnus/shr.el index fc2f5777fb7..f49bbd69da3 100644 --- a/lisp/gnus/shr.el +++ b/lisp/gnus/shr.el @@ -1055,44 +1055,53 @@ ones, in case fg and bg are nil." (nheader (if header (shr-max-columns header))) (nbody (if body (shr-max-columns body))) (nfooter (if footer (shr-max-columns footer)))) - (shr-tag-table-1 - (nconc - (if caption `((tr (td ,@caption)))) - (if header - (if footer - ;; hader + body + footer + (if (and (not caption) + (not header) + (not (cdr (assq 'tbody cont))) + (not (cdr (assq 'tr cont))) + (not footer)) + ;; The table is totally invalid and just contains random junk. + ;; Try to output it anyway. + (shr-generic cont) + ;; It's a real table, so render it. + (shr-tag-table-1 + (nconc + (if caption `((tr (td ,@caption)))) + (if header + (if footer + ;; hader + body + footer + (if (= nheader nbody) + (if (= nbody nfooter) + `((tr (td (table (tbody ,@header ,@body ,@footer))))) + (nconc `((tr (td (table (tbody ,@header ,@body))))) + (if (= nfooter 1) + footer + `((tr (td (table (tbody ,@footer)))))))) + (nconc `((tr (td (table (tbody ,@header))))) + (if (= nbody nfooter) + `((tr (td (table (tbody ,@body ,@footer))))) + (nconc `((tr (td (table (tbody ,@body))))) + (if (= nfooter 1) + footer + `((tr (td (table (tbody ,@footer)))))))))) + ;; header + body (if (= nheader nbody) - (if (= nbody nfooter) - `((tr (td (table (tbody ,@header ,@body ,@footer))))) - (nconc `((tr (td (table (tbody ,@header ,@body))))) - (if (= nfooter 1) - footer - `((tr (td (table (tbody ,@footer)))))))) - (nconc `((tr (td (table (tbody ,@header))))) - (if (= nbody nfooter) - `((tr (td (table (tbody ,@body ,@footer))))) - (nconc `((tr (td (table (tbody ,@body))))) - (if (= nfooter 1) - footer - `((tr (td (table (tbody ,@footer)))))))))) - ;; header + body - (if (= nheader nbody) - `((tr (td (table (tbody ,@header ,@body))))) - (if (= nheader 1) - `(,@header (tr (td (table (tbody ,@body))))) - `((tr (td (table (tbody ,@header)))) - (tr (td (table (tbody ,@body)))))))) - (if footer - ;; body + footer - (if (= nbody nfooter) - `((tr (td (table (tbody ,@body ,@footer))))) - (nconc `((tr (td (table (tbody ,@body))))) - (if (= nfooter 1) - footer - `((tr (td (table (tbody ,@footer)))))))) - (if caption - `((tr (td (table (tbody ,@body))))) - body))))) + `((tr (td (table (tbody ,@header ,@body))))) + (if (= nheader 1) + `(,@header (tr (td (table (tbody ,@body))))) + `((tr (td (table (tbody ,@header)))) + (tr (td (table (tbody ,@body)))))))) + (if footer + ;; body + footer + (if (= nbody nfooter) + `((tr (td (table (tbody ,@body ,@footer))))) + (nconc `((tr (td (table (tbody ,@body))))) + (if (= nfooter 1) + footer + `((tr (td (table (tbody ,@footer)))))))) + (if caption + `((tr (td (table (tbody ,@body))))) + body)))))) (when bgcolor (shr-colorize-region start (point) (cdr (assq 'color shr-stylesheet)) bgcolor))))