changeset 110810:07053df95af6

Merge changes made in Gnus trunk. shr.el (shr-render-td): Use a cache for the table rendering function to avoid getting an exponential rendering behaviour in nested tables. shr.el (shr-insert): Rework the line-breaking algorithm. shr.el (shr-insert): Don't leave trailing spaces. shr.el (shr-insert-table): Also insert empty TDs. shr.el (shr-tag-blockquote): Ensure paragraphs after </ul>. gnus-start.el (gnus-get-unread-articles): Require gnus-agent before bidning gnus-agent variables. mm-decode.el (mm-save-part): If given a non-directory result, expand the file name before using to avoid setting mm-default-directory to nil. gnus.el (gnus-carpal): The carpal mode has been removed, but define the variable for backwards compatability. nnimap.el (nnimap-update-info): Remove double setting of high. nnimap.el (nnimap-update-info): Don't ignore groups that have no UIDNEXT. shr.el (require): Require cl when compiling. shr.el (shr-tag-hr): New function.

--- a/lisp/gnus/ChangeLog	Thu Oct 07 20:22:07 2010 +0200
+++ b/lisp/gnus/ChangeLog	Thu Oct 07 22:26:11 2010 +0000
@@ -1,3 +1,29 @@
[phone]  Lars Magne Ingebrigtsen  <[e-mail]>
+
+	* shr.el (require): Require cl when compiling.
+	(shr-tag-hr): New function.
+
+	* nnimap.el (nnimap-update-info): Remove double setting of high.
+	(nnimap-update-info): Don't ignore groups that have no UIDNEXT.  This
+	makes nnimap work properly on Courier again.
+
+	* gnus.el (gnus-carpal): The carpal mode has been removed, but define
+	the variable for backwards compatability.
+
+	* mm-decode.el (mm-save-part): If given a non-directory result, expand
+	the file name before using to avoid setting mm-default-directory to
+	nil.
+
+	* gnus-start.el (gnus-get-unread-articles): Require gnus-agent before
+	bidning gnus-agent variables.
+
+	* shr.el (shr-render-td): Use a cache for the table rendering function
+	to avoid getting an exponential rendering behaviour in nested tables.
+	(shr-insert): Rework the line-breaking algorithm.
+	(shr-insert): Don't leave trailing spaces.
+	(shr-insert-table): Also insert empty TDs.
+	(shr-tag-blockquote): Ensure paragraphs after </ul>.
+
 2010-10-07  Stefan Monnier  <[e-mail]>
 
 	* gnus-sum.el (gnus-number): Rename from `number'.

--- a/lisp/gnus/gnus-group.el	Thu Oct 07 20:22:07 2010 +0200
+++ b/lisp/gnus/gnus-group.el	Thu Oct 07 22:26:11 2010 +0000
@@ -4321,7 +4321,8 @@
   (interactive
    (list (let ((how (gnus-completing-read
 		     "Which back end"
-		     (mapcar 'car (append gnus-valid-select-methods gnus-server-alist))
+		     (mapcar 'car (append gnus-valid-select-methods
+					  gnus-server-alist))
 		     t (cons "nntp" 0) 'gnus-method-history)))
 	   ;; We either got a back end name or a virtual server name.
 	   ;; If the first, we also need an address.

--- a/lisp/gnus/gnus-start.el	Thu Oct 07 20:22:07 2010 +0200
+++ b/lisp/gnus/gnus-start.el	Thu Oct 07 22:26:11 2010 +0000
@@ -1674,6 +1674,7 @@
 ;; and compute how many unread articles there are in each group.
 (defun gnus-get-unread-articles (&optional level)
   (setq gnus-server-method-cache nil)
+  (require 'gnus-agent)
   (let* ((newsrc (cdr gnus-newsrc-alist))
 	 (alevel (or level gnus-activate-level (1+ gnus-level-subscribed)))
 	 (foreign-level

--- a/lisp/gnus/gnus-sum.el	Thu Oct 07 20:22:07 2010 +0200
+++ b/lisp/gnus/gnus-sum.el	Thu Oct 07 22:26:11 2010 +0000
@@ -8686,8 +8686,8 @@
 	       (apply '+ (mapcar 'gnus-summary-limit-children
 				 (cdr thread)))
 	     0))
-           (number (mail-header-number (car thread)))
-	  score)
+	   (number (mail-header-number (car thread)))
+	   score)
       (if (and
 	   (not (memq number gnus-newsgroup-marked))
 	   (or
@@ -8732,8 +8732,8 @@
 	      t)
 	    ;; Do the `display' group parameter.
 	    (and gnus-newsgroup-display
-                 (let ((gnus-number number))
-                   (not (funcall gnus-newsgroup-display))))))
+		 (let ((gnus-number number))
+		   (not (funcall gnus-newsgroup-display))))))
 	  ;; Nope, invisible article.
 	  0
 	;; Ok, this article is to be visible, so we add it to the limit

--- a/lisp/gnus/gnus-util.el	Thu Oct 07 20:22:07 2010 +0200
+++ b/lisp/gnus/gnus-util.el	Thu Oct 07 22:26:11 2010 +0000
@@ -1647,7 +1647,8 @@
 (defun gnus-ido-completing-read (prompt collection &optional require-match
                                         initial-input history def)
   "Call `ido-completing-read-function'."
-  (ido-completing-read prompt collection nil require-match initial-input history def))
+  (ido-completing-read prompt collection nil require-match
+		       initial-input history def))
 
 
 (autoload 'iswitchb-read-buffer "iswitchb")

--- a/lisp/gnus/gnus.el	Thu Oct 07 20:22:07 2010 +0200
+++ b/lisp/gnus/gnus.el	Thu Oct 07 22:26:11 2010 +0000
@@ -2585,6 +2585,11 @@
 (defvar gnus-server-method-cache nil)
 (defvar gnus-extended-servers nil)
 
+;; The carpal mode has been removed, but define the variable for
+;; backwards compatability.
+(defvar gnus-carpal nil)
+(make-obsolete-variable 'gnus-carpal nil "Emacs 24.1")
+
 (defvar gnus-agent-fetching nil
   "Whether Gnus agent is in fetching mode.")
 

--- a/lisp/gnus/mm-decode.el	Thu Oct 07 20:22:07 2010 +0200
+++ b/lisp/gnus/mm-decode.el	Thu Oct 07 22:26:11 2010 +0000
@@ -1258,8 +1258,10 @@
 				      (or filename "")))
                           (or mm-default-directory default-directory)
 			  (or filename "")))
-    (when (file-directory-p file)
-      (setq file (expand-file-name filename file)))
+    (if (file-directory-p file)
+	(setq file (expand-file-name filename file))
+      (setq file (expand-file-name
+		  file (or mm-default-directory default-directory))))
     (setq mm-default-directory (file-name-directory file))
     (and (or (not (file-exists-p file))
 	     (yes-or-no-p (format "File %s already exists; overwrite? "

--- a/lisp/gnus/nnimap.el	Thu Oct 07 20:22:07 2010 +0200
+++ b/lisp/gnus/nnimap.el	Thu Oct 07 22:26:11 2010 +0000
@@ -1016,8 +1016,10 @@
 
 (defun nnimap-update-info (info marks)
   (when (and marks
-	     ;; Ignore groups with no UIDNEXT values.
-	     (nth 4 marks))
+	     ;; Ignore groups with no UIDNEXT/marks.  This happens for
+	     ;; completely empty groups.
+	     (or (car marks)
+		 (nth 4 marks)))
     (destructuring-bind (existing flags high low uidnext start-article
 				  permanent-flags) marks
       (let ((group (gnus-info-group info))
@@ -1044,9 +1046,6 @@
 	   group
 	   (cons (car (gnus-active group))
 		 (or high (1- uidnext)))))
-	(when (and (not high)
-		   uidnext)
-	  (setq high (1- uidnext)))
 	;; Then update the list of read articles.
 	(let* ((unread
 		(gnus-compress-sequence

--- a/lisp/gnus/shr.el	Thu Oct 07 20:22:07 2010 +0200
+++ b/lisp/gnus/shr.el	Thu Oct 07 22:26:11 2010 +0000
@@ -30,6 +30,7 @@
 
 ;;; Code:
 
+(eval-when-compile (require 'cl))
 (require 'browse-url)
 
 (defgroup shr nil
@@ -68,6 +69,7 @@
 (defvar shr-indentation 0)
 (defvar shr-inhibit-images nil)
 (defvar shr-list-mode nil)
+(defvar shr-content-cache nil)
 
 (defvar shr-map
   (let ((map (make-sparse-keymap)))
@@ -83,6 +85,7 @@
 
 ;;;###autoload
 (defun shr-insert-document (dom)
+  (setq shr-content-cache nil)
   (let ((shr-state nil)
 	(shr-start nil))
     (shr-descend (shr-transform-dom dom))))
@@ -135,6 +138,17 @@
       (message "Browsing %s..." url)
       (browse-url url))))
 
+(defun shr-insert-image ()
+  "Insert the image under point into the buffer."
+  (interactive)
+  (let ((url (get-text-property (point) 'shr-image)))
+    (if (not url)
+	(message "No image under point")
+      (message "Inserting %s..." url)
+      (url-retrieve url 'shr-image-fetched
+		    (list (current-buffer) (1- (point)) (point-marker))
+		    t))))
+
 ;;; Utility functions.
 
 (defun shr-transform-dom (dom)
@@ -175,20 +189,8 @@
 	  column)
       (when (and (string-match "\\`[ \t\n]" text)
 		 (not (bolp)))
-	(insert " ")
-	(setq shr-state 'space))
+	(insert " "))
       (dolist (elem (split-string text))
-	(setq column (current-column))
-	(when (> column 0)
-	  (cond
-	   ((and (or (not first)
-		     (eq shr-state 'space))
-		 (> (+ column (length elem) 1) shr-width))
-	    (insert "\n")
-	    (put-text-property (1- (point)) (point) 'shr-break t))
-	   ((not first)
-	    (insert " "))))
-	(setq first nil)
 	(when (and (bolp)
 		   (> shr-indentation 0))
 	  (shr-indent))
@@ -197,12 +199,19 @@
 	;; starts.
 	(unless shr-start
 	  (setq shr-start (point)))
-	(insert elem))
-      (setq shr-state nil)
-      (when (and (string-match "[ \t\n]\\'" text)
-		 (not (bolp)))
-	(insert " ")
-	(setq shr-state 'space))))))
+	(insert elem)
+	(when (> (current-column) shr-width)
+	  (if (not (search-backward " " (line-beginning-position) t))
+	      (insert "\n")
+	    (delete-char 1)
+	    (insert "\n")
+	    (put-text-property (1- (point)) (point) 'shr-break t)
+	    (when (> shr-indentation 0)
+	      (shr-indent))
+	    (end-of-line)))
+	(insert " "))
+      (unless (string-match "[ \t\n]\\'" text)
+	(delete-char -1))))))
 
 (defun shr-ensure-newline ()
   (unless (zerop (current-column))
@@ -396,11 +405,14 @@
 (defun shr-tag-ul (cont)
   (shr-ensure-paragraph)
   (let ((shr-list-mode 'ul))
-    (shr-generic cont)))
+    (shr-generic cont))
+  (shr-ensure-paragraph))
 
 (defun shr-tag-ol (cont)
+  (shr-ensure-paragraph)
   (let ((shr-list-mode 1))
-    (shr-generic cont)))
+    (shr-generic cont))
+  (shr-ensure-paragraph))
 
 (defun shr-tag-li (cont)
   (shr-ensure-newline)
@@ -437,6 +449,10 @@
 (defun shr-tag-h6 (cont)
   (shr-heading cont))
 
+(defun shr-tag-hr (cont)
+  (shr-ensure-newline)
+  (insert (make-string shr-width ?-) "\n"))
+
 ;;; Table rendering algorithm.
 
 ;; Table rendering is the only complicated thing here.  We do this by
@@ -496,16 +512,15 @@
 	      overlay overlay-line)
 	  (dolist (line lines)
 	    (setq overlay-line (pop overlay-lines))
-	    (when (> (length line) 0)
-	      (end-of-line)
-	      (insert line "|")
-	      (dolist (overlay overlay-line)
-		(let ((o (make-overlay (- (point) (nth 0 overlay) 1)
-				       (- (point) (nth 1 overlay) 1)))
-		      (properties (nth 2 overlay)))
-		  (while properties
-		    (overlay-put o (pop properties) (pop properties)))))
-	      (forward-line 1)))
+	    (end-of-line)
+	    (insert line "|")
+	    (dolist (overlay overlay-line)
+	      (let ((o (make-overlay (- (point) (nth 0 overlay) 1)
+				     (- (point) (nth 1 overlay) 1)))
+		    (properties (nth 2 overlay)))
+		(while properties
+		  (overlay-put o (pop properties) (pop properties)))))
+	    (forward-line 1))
 	  ;; Add blank lines at padding at the bottom of the TD,
 	  ;; possibly.
 	  (dotimes (i (- height (length lines)))
@@ -570,13 +585,18 @@
 
 (defun shr-render-td (cont width fill)
   (with-temp-buffer
-    (let ((shr-width width)
-	  (shr-indentation 0))
-      (shr-generic cont))
-    (delete-region
-     (point)
-     (+ (point)
-	(skip-chars-backward " \t\n")))
+    (let ((cache (cdr (assoc (cons width cont) shr-content-cache))))
+      (if cache
+	  (insert cache)
+	(let ((shr-width width)
+	      (shr-indentation 0))
+	  (shr-generic cont))
+	(delete-region
+	 (point)
+	 (+ (point)
+	    (skip-chars-backward " \t\n")))
+	(push (cons (cons width cont) (buffer-string))
+	      shr-content-cache)))
     (goto-char (point-min))
     (let ((max 0))
       (while (not (eobp))