Merge changes made in Gnus trunk.

mm-decode.el (mm-shr): Bind shr-blocked-images to gnus-blocked-images.
shr.el (shr-tag-table): Put all the images after the table.
shr.el (shr-tag-table): Really inhibit images inside the table.
shr.el (shr-collect-overlays): Copy over overlays from the TD elements to the main document.
nnimap.el (nnimap-request-newgroups): Return success.
gnus-group.el (gnus-group-make-group): Doc fix.
nnir.el (nnir-retrieve-headers): Don't bug out on invalid data.
gnus-sum.el (gnus-article-sort-by-most-recent-date): New function, added for symmetry.
mm-decode.el (mm-shr): Allow displaying cid: images from shr.el.
shr.el (shr-insert-table): Bind free variable.
gnus-art.el (gnus-blocked-images): Move variable here.
mm-decode.el (mm-shr): Require shr.
shr.el (shr-tag-img): Shorten ALT texts and allow them to be line-broken.
shr.el (shr-tag-img): Ignore image fetching errors.
shr.el (shr-overlays-in-region): Compute overlay positions correctly.
gnus-html.el (gnus-html-schedule-image-fetching): Protect against invalid URLs.

9 files changed, 168 insertions, 46 deletions

diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog
index 241c8148dc1..1217f548a6a 100644
--- a/lisp/gnus/ChangeLog
+++ b/lisp/gnus/ChangeLog
@@ -1,3 +1,41 @@
+2010-10-05  Lars Magne Ingebrigtsen  <larsi@gnus.org>
+
+        * gnus-html.el (gnus-html-schedule-image-fetching): Protect against
+        invalid URLs.
+
+        * shr.el (shr-tag-img): Shorten ALT texts and allow them to be
+        line-broken.
+        (shr-tag-img): Ignore image fetching errors.
+        (shr-overlays-in-region): Compute overlay positions correctly.
+
+        * mm-decode.el (mm-shr): Require shr.
+
+        * gnus-art.el (gnus-blocked-images): Move variable here.
+
+        * shr.el (shr-insert-table): Bind free variable.
+
+        * mm-decode.el (mm-shr): Bind shr-content-function.
+
+        * shr.el (shr-content-function): New variable.
+
+        * gnus-sum.el (gnus-article-sort-by-most-recent-date): New function,
+        added for symmetry.
+
+        * nnir.el (nnir-retrieve-headers): Don't bug out on invalid data.
+
+        * gnus-group.el (gnus-group-make-group): Doc fix.
+
+        * nnimap.el (nnimap-request-newgroups): Return success.
+
+        * shr.el (shr-find-elements): New function.
+        (shr-tag-table): Put all the images after the table.
+        (shr-tag-table): Really inhibit images inside the table.
+        (shr-collect-overlays): Copy over overlays from the TD elements to the
+        main document.
+
+        * mm-decode.el (mm-shr): Bind shr-blocked-images to
+        gnus-blocked-images.
+
 2010-10-05  Julien Danjou  <julien@danjou.info>
 
         * gnus-html.el (gnus-html-wash-images): Rescale image from cid too.
@@ -41,6 +79,9 @@
 
 2010-10-04  Lars Magne Ingebrigtsen  <larsi@gnus.org>
 
+        * nnimap.el (nnimap-open-connection): Give an error if nnimap-stream is
+        unknown.
+
         * shr.el (shr-tag-blockquote): Ensure paragraph after quote, too.
         (shr-get-image-data): Ensure against the cache file missing.
 
diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el
index d96df61a1f8..d7dcf901713 100644
--- a/lisp/gnus/gnus-art.el
+++ b/lisp/gnus/gnus-art.el
@@ -1639,6 +1639,12 @@ This requires GNU Libidn, and by default only enabled if it is found."
   :group 'gnus-article
   :type 'boolean)
 
+(defcustom gnus-blocked-images "."
+  "Images that have URLs matching this regexp will be blocked."
+  :version "24.1"
+  :group 'gnus-art
+  :type 'regexp)
+
 ;;; Internal variables
 
 (defvar gnus-english-month-names
diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el
index d9e36ae6eae..a700b5ee8cf 100644
--- a/lisp/gnus/gnus-group.el
+++ b/lisp/gnus/gnus-group.el
@@ -2651,7 +2651,10 @@ The user will be prompted for GROUP."
   "Add a new newsgroup.
 The user will be prompted for a NAME, for a select METHOD, and an
 ADDRESS.  NAME should be a human-readable string (i.e., not be encoded
-even if it contains non-ASCII characters) unless ENCODED is non-nil."
+even if it contains non-ASCII characters) unless ENCODED is non-nil.
+
+If the backend supports it, the group will also be created on the
+server."
   (interactive
    (list
     (gnus-read-group "Group name: ")
diff --git a/lisp/gnus/gnus-html.el b/lisp/gnus/gnus-html.el
index d30b574b55e..a21c4784d80 100644
--- a/lisp/gnus/gnus-html.el
+++ b/lisp/gnus/gnus-html.el
@@ -57,12 +57,6 @@
   :group 'gnus-art
   :type 'integer)
 
-(defcustom gnus-blocked-images "."
-  "Images that have URLs matching this regexp will be blocked."
-  :version "24.1"
-  :group 'gnus-art
-  :type 'regexp)
-
 (defcustom gnus-max-image-proportion 0.9
   "How big pictures displayed are in relation to the window they're in.
 A value of 0.7 means that they are allowed to take up 70% of the
@@ -371,7 +365,8 @@ Use ALT-TEXT for the image string."
                        (help-function-arglist 'url-retrieve)))
              4)
       (setq args (nconc args (list t))))
-    (apply #'url-retrieve args)))
+    (ignore-errors
+      (apply #'url-retrieve args))))
 
 (defun gnus-html-image-fetched (status buffer image)
   "Callback function called when image has been fetched."
diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el
index a0e38d4f4f5..484837f7ff9 100644
--- a/lisp/gnus/gnus-sum.el
+++ b/lisp/gnus/gnus-sum.el
@@ -4985,6 +4985,10 @@ Unscored articles will be counted as having a score of zero."
    (t
     (gnus-thread-total-score-1 (list thread)))))
 
+(defun gnus-article-sort-by-most-recent-number (h1 h2)
+  "Sort articles by number."
+  (gnus-article-sort-by-number h1 h2))
+
 (defun gnus-thread-sort-by-most-recent-number (h1 h2)
   "Sort threads such that the thread with the most recently arrived article comes first."
   (> (gnus-thread-highest-number h1) (gnus-thread-highest-number h2)))
@@ -4995,6 +4999,10 @@ Unscored articles will be counted as having a score of zero."
                         (mail-header-number header))
                       (message-flatten-list thread))))
 
+(defun gnus-article-sort-by-most-recent-date (h1 h2)
+  "Sort articles by number."
+  (gnus-article-sort-by-date h1 h2))
+
 (defun gnus-thread-sort-by-most-recent-date (h1 h2)
   "Sort threads such that the thread with the most recently dated article comes first."
   (> (gnus-thread-latest-date h1) (gnus-thread-latest-date h2)))
diff --git a/lisp/gnus/mm-decode.el b/lisp/gnus/mm-decode.el
index edbd252c3c8..70b735a70f9 100644
--- a/lisp/gnus/mm-decode.el
+++ b/lisp/gnus/mm-decode.el
@@ -1684,7 +1684,16 @@ If RECURSIVE, search recursively."
 (declare-function shr-insert-document "shr" (dom))
 
 (defun mm-shr (handle)
+  ;; Require since we bind its variables.
+  (require 'shr)
   (let ((article-buffer (current-buffer))
+        (shr-blocked-images (with-current-buffer gnus-summary-buffer
+                              gnus-blocked-images))
+        (shr-content-function (lambda (id)
+                                (let ((handle (mm-get-content-id id)))
+                                  (when handle
+                                    (mm-with-part handle
+                                      (buffer-string))))))
         charset)
     (unless handle
       (setq handle (mm-dissect-buffer t)))
diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el
index c3c25cbf194..d56e2f4b76e 100644
--- a/lisp/gnus/nnimap.el
+++ b/lisp/gnus/nnimap.el
@@ -926,7 +926,8 @@ textual parts.")
                      (nnimap-get-groups)))
       (unless (assoc group nnimap-current-infos)
         ;; Insert dummy numbers here -- they don't matter.
-        (insert (format "%S 0 1 y\n" group))))))
+        (insert (format "%S 0 1 y\n" group))))
+    t))
 
 (deffoo nnimap-retrieve-group-data-early (server infos)
   (when (nnimap-possibly-change-group nil server)
diff --git a/lisp/gnus/nnir.el b/lisp/gnus/nnir.el
index baba9e0098a..7a5380c52bb 100644
--- a/lisp/gnus/nnir.el
+++ b/lisp/gnus/nnir.el
@@ -792,40 +792,30 @@ and show thread that contains this article."
           (if nnir-get-article-nov-override-function
               (setq novitem (funcall nnir-get-article-nov-override-function
                                      artitem))
-          ;; else, set novitem through nnheader-parse-nov/nnheader-parse-head
+            ;; else, set novitem through nnheader-parse-nov/nnheader-parse-head
             (case (setq foo (gnus-retrieve-headers (list artno)
                                                    artfullgroup nil))
               (nov
                (goto-char (point-min))
-               (setq novitem (nnheader-parse-nov))
-               (unless novitem
-                 (pop-to-buffer nntp-server-buffer)
-                 (error
-                  "nnheader-parse-nov returned nil for article %s in group %s"
-                  artno artfullgroup)))
+               (setq novitem (nnheader-parse-nov)))
               (headers
                (goto-char (point-min))
-               (setq novitem (nnheader-parse-head))
-               (unless novitem
-                 (pop-to-buffer nntp-server-buffer)
-                 (error
-                  "nnheader-parse-head returned nil for article %s in group %s"
-                  artno artfullgroup)))
+               (setq novitem (nnheader-parse-head)))
               (t (error "Unknown header type %s while requesting article %s of group %s"
                         foo artno artfullgroup)))))
         ;; replace article number in original group with article number
         ;; in nnir group
-        (mail-header-set-number novitem art)
-        (mail-header-set-from novitem
-                              (mail-header-from novitem))
-        (mail-header-set-subject
-         novitem
-         (format "[%d: %s/%d] %s"
-                 artrsv artgroup artno
-                 (mail-header-subject novitem)))
-        ;;-(mail-header-set-extra novitem nil)
-        (push novitem novdata)
-        (setq artlist (cdr artlist)))
+        (when novitem
+          (mail-header-set-number novitem art)
+          (mail-header-set-from novitem
+                                (mail-header-from novitem))
+          (mail-header-set-subject
+           novitem
+           (format "[%d: %s/%d] %s"
+                   artrsv artgroup artno
+                   (mail-header-subject novitem)))
+          (push novitem novdata)
+          (setq artlist (cdr artlist))))
       (setq novdata (nreverse novdata))
       (set-buffer nntp-server-buffer) (erase-buffer)
       (mapc 'nnheader-insert-nov novdata)
diff --git a/lisp/gnus/shr.el b/lisp/gnus/shr.el
index f905bf5ac05..2d5d4d623fb 100644
--- a/lisp/gnus/shr.el
+++ b/lisp/gnus/shr.el
@@ -52,10 +52,16 @@ fit these criteria."
   :group 'shr
   :type 'regexp)
 
+(defvar shr-content-function nil
+  "If bound, this should be a function that will return the content.
+This is used for cid: URLs, and the function is called with the
+cid: URL as the argument.")
+
 (defvar shr-folding-mode nil)
 (defvar shr-state nil)
 (defvar shr-start nil)
 (defvar shr-indentation 0)
+(defvar shr-inhibit-images nil)
 
 (defvar shr-width 70)
 
@@ -204,16 +210,30 @@ redirects somewhere else."
       (when (zerop (length alt))
         (setq alt "[img]"))
       (cond
-       ((and shr-blocked-images
-             (string-match shr-blocked-images url))
-        (insert alt))
+       ((and (not shr-inhibit-images)
+             (string-match "\\`cid:" url))
+        (let ((url (substring url (match-end 0)))
+              image)
+          (if (or (not shr-content-function)
+                  (not (setq image (funcall shr-content-function url))))
+              (insert alt)
+            (shr-put-image image (point) alt))))
+       ((or shr-inhibit-images
+            (and shr-blocked-images
+                 (string-match shr-blocked-images url)))
+        (setq shr-start (point))
+        (let ((shr-state 'space))
+          (if (> (length alt) 8)
+              (shr-insert (substring alt 0 8))
+            (shr-insert alt))))
        ((url-is-cached (browse-url-url-encode-chars url "[&)$ ]"))
         (shr-put-image (shr-get-image-data url) (point) alt))
        (t
         (insert alt)
-        (url-retrieve url 'shr-image-fetched
-                      (list (current-buffer) start (point-marker))
-                      t)))
+        (ignore-errors
+          (url-retrieve url 'shr-image-fetched
+                        (list (current-buffer) start (point-marker))
+                        t))))
       (insert " ")
       (put-text-property start (point) 'keymap shr-map)
       (put-text-property start (point) 'shr-alt alt)
@@ -411,11 +431,23 @@ Return a string with image data."
   (shr-ensure-paragraph)
   (setq cont (or (cdr (assq 'tbody cont))
                  cont))
-  (let* ((columns (shr-column-specs cont))
+  (let* ((shr-inhibit-images t)
+         (columns (shr-column-specs cont))
          (suggested-widths (shr-pro-rate-columns columns))
          (sketch (shr-make-table cont suggested-widths))
          (sketch-widths (shr-table-widths sketch (length suggested-widths))))
-    (shr-insert-table (shr-make-table cont sketch-widths t) sketch-widths)))
+    (shr-insert-table (shr-make-table cont sketch-widths t) sketch-widths))
+  (dolist (elem (shr-find-elements cont 'img))
+    (shr-tag-img (cdr elem))))
+
+(defun shr-find-elements (cont type)
+  (let (result)
+    (dolist (elem cont)
+      (cond ((eq (car elem) type)
+             (push elem result))
+            ((consp (cdr elem))
+             (setq result (nconc (shr-find-elements (cdr elem) type) result)))))
+    (nreverse result)))
 
 (defun shr-insert-table (table widths)
   (shr-insert-table-ruler widths)
@@ -430,11 +462,20 @@ Return a string with image data."
         (insert "|\n"))
       (dolist (column row)
         (goto-char start)
-        (let ((lines (split-string (nth 2 column) "\n")))
+        (let ((lines (split-string (nth 2 column) "\n"))
+              (overlay-lines (nth 3 column))
+              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)))
           ;; Add blank lines at padding at the bottom of the TD,
           ;; possibly.
@@ -495,7 +536,34 @@ Return a string with image data."
           (when (> (- width (current-column)) 0)
             (insert (make-string (- width (current-column)) ? )))
           (forward-line 1)))
-      (list max (count-lines (point-min) (point-max)) (buffer-string)))))
+      (list max
+            (count-lines (point-min) (point-max))
+            (buffer-string)
+            (and fill
+                 (shr-collect-overlays))))))
+
+(defun shr-collect-overlays ()
+  (save-excursion
+    (goto-char (point-min))
+    (let ((overlays nil))
+      (while (not (eobp))
+        (push (shr-overlays-in-region (point) (line-end-position))
+              overlays)
+        (forward-line 1))
+      (nreverse overlays))))
+
+(defun shr-overlays-in-region (start end)
+  (let (result)
+    (dolist (overlay (overlays-in start end))
+      (push (list (if (> start (overlay-start overlay))
+                      (- end start)
+                    (- end (overlay-start overlay)))
+                  (if (< end (overlay-end overlay))
+                      0
+                    (- end (overlay-end overlay)))
+                  (overlay-properties overlay))
+            result))
+    (nreverse result)))
 
 (defun shr-pro-rate-columns (columns)
   (let ((total-percentage 0)
@@ -523,8 +591,8 @@ Return a string with image data."
                            (string-match "\\([0-9]+\\)%" width))
                   (aset columns i
                         (/ (string-to-number (match-string 1 width))
-                           100.0)))))
-            (setq i (1+ i))))))
+                           100.0))))
+              (setq i (1+ i)))))))
     columns))
 
 (defun shr-count (cont elem)
@@ -538,7 +606,8 @@ Return a string with image data."
   (let ((max 0))
     (dolist (row cont)
       (when (eq (car row) 'tr)
-        (setq max (max max (shr-count (cdr row) 'td)))))
+        (setq max (max max (+ (shr-count (cdr row) 'td)
+                              (shr-count (cdr row) 'th))))))
     max))
 
 (provide 'shr)