[Emacs-diffs] /srv/bzr/emacs/trunk r101939: Merge changes made in Gnus trunk.

[Katsumi Yamaoka]

------------------------------------------------------------
revno: 101939
author: Gnus developers
committer: Katsumi Yamaoka <address@hidden>
branch nick: trunk
timestamp: Tue 2010-10-12 22:18:24 +0000
message:
  Merge changes made in Gnus trunk.
  
  gnus-gravatar.el (gnus-art): Required.
  shr.el (shr-tag-img): Add align attribute support for <img>.
  gnus-gravatar.el (gnus-gravatar-insert): Check if buffer is alive.
  shr.el (shr-tag-img): Encode URL properly when retrieving.
  shr.el (shr-get-image-data): Encode URL properly when fetching from cache.
  shr.el (shr-tag-img): Use aligned-to spaces to align correctly images.
  nnimap.el (nnimap-request-rename-group): Unselect by selecting a mailbox that 
doesn't exist.
  rfc2231.el (rfc2231-parse-string): Ignore repeated parts.
  gnus-gravatar.el (gnus-gravatar-too-ugly): Don't test if 
gnus-article-x-face-too-ugly is bound.
modified:
  lisp/gnus/ChangeLog
  lisp/gnus/ecomplete.el
  lisp/gnus/gnus-gravatar.el
  lisp/gnus/nnimap.el
  lisp/gnus/rfc2231.el
  lisp/gnus/shr.el

=== modified file 'lisp/gnus/ChangeLog'
--- a/lisp/gnus/ChangeLog       2010-10-12 14:17:15 +0000
+++ b/lisp/gnus/ChangeLog       2010-10-12 22:18:24 +0000
@@ -1,4 +1,29 @@
-2010-10-12  Lars Magne Ingebrigtsen  <address@hidden>
+2010-10-12  Katsumi Yamaoka  <address@hidden>
+
+       * gnus-gravatar.el (gnus-gravatar-too-ugly): Don't test if
+       gnus-article-x-face-too-ugly is bound.
+
+2010-10-12  Lars Magne Ingebrigtsen  <address@hidden>
+
+       * rfc2231.el (rfc2231-parse-string): Ignore repeated parts.
+
+       * nnimap.el (nnimap-request-rename-group): Unselect by selecting a
+       mailbox that doesn't exist.
+
+2010-10-12  Julien Danjou  <address@hidden>
+
+       * shr.el (shr-tag-img): Encode URL properly when retrieving.
+       (shr-get-image-data): Encode URL properly when fetching from cache.
+       (shr-tag-img): Use aligned-to spaces to align correctly images.
+
+       * gnus-gravatar.el (gnus-gravatar-insert): Check if buffer is alive
+       before inserting the Gravatar.
+
+       * shr.el (shr-tag-img): Add align attribute support for <img>.
+
+2010-10-12  Lars Magne Ingebrigtsen  <address@hidden>
+
+       * gnus-gravatar.el (gnus-art): Required.
 
        * gnus-sum.el (gnus-summary-mark-as-unread-forward)
        (gnus-summary-mark-as-unread-backward, gnus-summary-mark-as-unread):

=== modified file 'lisp/gnus/ecomplete.el'
--- a/lisp/gnus/ecomplete.el    2010-09-02 01:42:32 +0000
+++ b/lisp/gnus/ecomplete.el    2010-10-12 22:18:24 +0000
@@ -147,7 +147,7 @@
     (save-restriction
       (narrow-to-region (point) (point-at-eol))
       (while (not (eobp))
-       ;; Put the 'region face on any charactes on this line that
+       ;; Put the 'region face on any characters on this line that
        ;; aren't already highlighted.
        (unless (get-text-property (point) 'face)
          (put-text-property (point) (1+ (point)) 'face 'highlight))

=== modified file 'lisp/gnus/gnus-gravatar.el'
--- a/lisp/gnus/gnus-gravatar.el        2010-10-09 08:44:12 +0000
+++ b/lisp/gnus/gnus-gravatar.el        2010-10-12 22:18:24 +0000
@@ -25,6 +25,7 @@
 ;;; Code:
 
 (require 'gravatar)
+(require 'gnus-art)
 
 (defgroup gnus-gravatar nil
   "Gnus Gravatar."
@@ -42,8 +43,7 @@
   :version "24.1"
   :group 'gnus-gravatar)
 
-(defcustom gnus-gravatar-too-ugly (if (boundp 'gnus-article-x-face-too-ugly)
-                                     gnus-article-x-face-too-ugly)
+(defcustom gnus-gravatar-too-ugly gnus-article-x-face-too-ugly
   "Regexp matching posters whose avatar shouldn't be shown automatically."
   :type '(choice regexp (const nil))
   :version "24.1"
@@ -79,32 +79,34 @@
 Set image category to CATEGORY."
   (unless (eq gravatar 'error)
     (gnus-with-article-headers
-      (gnus-article-goto-header header)
-      (mail-header-narrow-to-field)
-      (let ((real-name (cdr address))
-            (mail-address (car address)))
-        (when (if real-name             ; have a realname, go for it!
-                  (and (search-forward real-name nil t)
-                       (search-backward real-name nil t))
-                (and (search-forward mail-address nil t)
-                     (search-backward mail-address nil t)))
-          (goto-char (1- (point)))
-          ;; If we're on the " quoting the name, go backward
-          (when (looking-at "[\"<]")
-            (goto-char (1- (point))))
-          ;; Do not do anything if there's already a gravatar. This can
-          ;; happens if the buffer has been regenerated in the mean time, for
-          ;; example we were fetching someaddress, and then we change to
-          ;; another mail with the same someaddress.
-          (unless (memq 'gnus-gravatar (text-properties-at (point)))
-            (let ((inhibit-read-only t)
-                  (point (point)))
-             (unless (featurep 'xemacs)
-               (setq gravatar (append gravatar gnus-gravatar-properties)))
-              (gnus-put-image gravatar nil category)
-              (put-text-property point (point) 'gnus-gravatar address)
-              (gnus-add-wash-type category)
-              (gnus-add-image category gravatar))))))))
+      ;; The buffer can be gone at this time
+      (when (buffer-live-p (current-buffer))
+        (gnus-article-goto-header header)
+        (mail-header-narrow-to-field)
+        (let ((real-name (cdr address))
+              (mail-address (car address)))
+          (when (if real-name             ; have a realname, go for it!
+                    (and (search-forward real-name nil t)
+                         (search-backward real-name nil t))
+                  (and (search-forward mail-address nil t)
+                       (search-backward mail-address nil t)))
+            (goto-char (1- (point)))
+            ;; If we're on the " quoting the name, go backward
+            (when (looking-at "[\"<]")
+              (goto-char (1- (point))))
+            ;; Do not do anything if there's already a gravatar. This can
+            ;; happens if the buffer has been regenerated in the mean time, for
+            ;; example we were fetching someaddress, and then we change to
+            ;; another mail with the same someaddress.
+            (unless (memq 'gnus-gravatar (text-properties-at (point)))
+              (let ((inhibit-read-only t)
+                    (point (point)))
+                (unless (featurep 'xemacs)
+                  (setq gravatar (append gravatar gnus-gravatar-properties)))
+                (gnus-put-image gravatar nil category)
+                (put-text-property point (point) 'gnus-gravatar address)
+                (gnus-add-wash-type category)
+                (gnus-add-image category gravatar)))))))))
 
 ;;;###autoload
 (defun gnus-treat-from-gravatar ()

=== modified file 'lisp/gnus/nnimap.el'
--- a/lisp/gnus/nnimap.el       2010-10-11 23:29:33 +0000
+++ b/lisp/gnus/nnimap.el       2010-10-12 22:18:24 +0000
@@ -673,8 +673,11 @@
 (deffoo nnimap-request-rename-group (group new-name &optional server)
   (when (nnimap-possibly-change-group nil server)
     (with-current-buffer (nnimap-buffer)
-      ;; Make sure we don't have this group open read/write.
-      (nnimap-command "EXAMINE %S" (utf7-encode group 7))
+      ;; Make sure we don't have this group open read/write by asking
+      ;; to examine a mailbox that doesn't exist.  This seems to be
+      ;; the only way that allows us to reliably go back to unselected
+      ;; state on Courier.
+      (nnimap-command "EXAMINE DOES.NOT.EXIST")
       (setf (nnimap-group nnimap-object) nil)
       (car (nnimap-command "RENAME %S %S"
                           (utf7-encode group t) (utf7-encode new-name t))))))

=== modified file 'lisp/gnus/rfc2231.el'
--- a/lisp/gnus/rfc2231.el      2010-09-02 00:55:51 +0000
+++ b/lisp/gnus/rfc2231.el      2010-10-12 22:18:24 +0000
@@ -185,11 +185,19 @@
                in (sort parameters (lambda (e1 e2)
                                      (< (or (caddr e1) 0)
                                         (or (caddr e2) 0))))
-               do (if (or (not (setq elem (assq attribute cparams)))
-                          (and (numberp part)
-                               (zerop part)))
-                      (push (list attribute value encoded) cparams)
-                    (setcar (cdr elem) (concat (cadr elem) value))))
+               do (cond
+                   ;; First part.
+                   ((or (not (setq elem (assq attribute cparams)))
+                        (and (numberp part)
+                             (zerop part)))
+                    (push (list attribute value encoded) cparams))
+                   ;; Repetition of a part; do nothing.
+                   ((and elem
+                         (null number))
+                    )
+                   ;; Concatenate continuation parts.
+                   (t
+                    (setcar (cdr elem) (concat (cadr elem) value)))))
          ;; Finally decode encoded values.
          (cons type (mapcar
                      (lambda (elem)

=== modified file 'lisp/gnus/shr.el'
--- a/lisp/gnus/shr.el  2010-10-11 22:27:28 +0000
+++ b/lisp/gnus/shr.el  2010-10-12 22:18:24 +0000
@@ -344,7 +344,7 @@
   (with-temp-buffer
     (mm-disable-multibyte)
     (when (ignore-errors
-           (url-cache-extract (url-cache-create-filename url))
+           (url-cache-extract (url-cache-create-filename (shr-encode-url url)))
            t)
       (when (or (search-forward "\n\n" nil t)
                (search-forward "\r\n\r\n" nil t))
@@ -389,19 +389,40 @@
     (put-text-property (or shr-start start) (point) 'keymap shr-map)
     (put-text-property (or shr-start start) (point) 'shr-url url)))
 
+(defun shr-encode-url (url)
+  "Encode URL."
+  (browse-url-url-encode-chars url "[)$ ]"))
+
 (defun shr-tag-img (cont)
   (when (and (> (current-column) 0)
             (not (eq shr-state 'image)))
     (insert "\n"))
-  (let ((start (point-marker)))
-    (let ((alt (cdr (assq :alt cont)))
-         (url (cdr (assq :src cont))))
+  (let ((alt (cdr (assq :alt cont)))
+        (url (cdr (assq :src cont)))
+        (width (cdr (assq :width cont))))
+    ;; Only respect align if width specified.
+    (when width
+      ;; Check that width is not larger than max width, otherwise ignore
+      ;; align
+      (let ((max-width (* fill-column (frame-char-width)))
+            (width (string-to-number width)))
+        (when (< width max-width)
+          (let ((align (cdr (assq :align cont))))
+            (cond ((string= align "right")
+                   (insert (propertize
+                            " " 'display
+                            `(space . (:align-to ,(list (- max-width 
width)))))))
+                  ((string= align "center")
+                   (insert (propertize
+                            " " 'display
+                            `(space . (:balign-to ,(list (- (/ max-width 2) 
width))))))))))))
+    (let ((start (point-marker)))
       (when (zerop (length alt))
-       (setq alt "[img]"))
+        (setq alt "[img]"))
       (cond
        ((and (not shr-inhibit-images)
-            (string-match "\\`cid:" url))
-       (let ((url (substring url (match-end 0)))
+             (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))))
@@ -415,12 +436,12 @@
          (if (> (length alt) 8)
              (shr-insert (substring alt 0 8))
            (shr-insert alt))))
-       ((url-is-cached (browse-url-url-encode-chars url "[&)$ ]"))
+       ((url-is-cached (shr-encode-url url))
        (shr-put-image (shr-get-image-data url) (point) alt))
        (t
        (insert alt)
        (ignore-errors
-         (url-retrieve url 'shr-image-fetched
+         (url-retrieve (shr-encode-url url) 'shr-image-fetched
                        (list (current-buffer) start (point-marker))
                        t))))
       (insert " ")