Gnus -- minor build / warning fixes [OK For Upstream]

[gnus] / lisp / gnus-gravatar.el

diff --git a/lisp/gnus-gravatar.el b/lisp/gnus-gravatar.el
index 27f65c0..deb6e4b 100644 (file)
--- a/lisp/gnus-gravatar.el
+++ b/lisp/gnus-gravatar.el
@@ -1,6 +1,6 @@
 ;;; gnus-gravatar.el --- Gnus Gravatar support
 
-;; Copyright (C) 2010 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2016 Free Software Foundation, Inc.
 
 ;; Author: Julien Danjou <julien@danjou.info>
 ;; Keywords: news
@@ -35,13 +35,13 @@
 (defcustom gnus-gravatar-size nil
   "How big should gravatars be displayed.
 If nil, default to `gravatar-size'."
-  :type 'integer
+  :type '(choice (const nil) integer)
   :version "24.1"
   :group 'gnus-gravatar)
 
 (defcustom gnus-gravatar-properties '(:ascent center :relief 1)
   "List of image properties applied to Gravatar images."
-  :type 'list
+  :type 'sexp
   :version "24.1"
   :group 'gnus-gravatar)
 
@@ -54,9 +54,10 @@ If nil, default to `gravatar-size'."
 (defun gnus-gravatar-transform-address (header category &optional force)
   (gnus-with-article-headers
     (let* ((mail-extr-disable-voodoo t)
+           (mail-extr-ignore-realname-equals-mailbox-name nil)
           (addresses (mail-extract-address-components
                       (or (mail-fetch-field header) "") t))
-          (gravatar-size gnus-gravatar-size)
+          (gravatar-size (or gnus-gravatar-size gravatar-size))
           name)
       (dolist (address addresses)
        (when (and (setq name (car address))
@@ -65,7 +66,7 @@ If nil, default to `gravatar-size'."
        (when (or force
                  (not (and gnus-gravatar-too-ugly
                            (or (string-match gnus-gravatar-too-ugly
-                                             (cadr address))
+                                             (or (cadr address) ""))
                                (and name
                                     (string-match gnus-gravatar-too-ugly
                                                   name))))))
@@ -79,37 +80,43 @@ If nil, default to `gravatar-size'."
   "Insert GRAVATAR for ADDRESS in HEADER in current article buffer.
 Set image category to CATEGORY."
   (unless (eq gravatar 'error)
-    (gnus-with-article-headers
-      ;; 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 (car address))
-              (mail-address (cadr address)))
-          (when (if real-name
-                   (re-search-forward
-                    (concat (gnus-replace-in-string
-                             (regexp-quote real-name) "[\t ]+" "[\t\n ]+")
-                            "\\|"
-                            (regexp-quote mail-address))
-                    nil t)
-                 (search-forward mail-address nil t))
-           (goto-char (1- (match-beginning 0)))
-            ;; 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 ((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)))))))))
+    (gnus-with-article-buffer
+      (let ((mark (point-marker))
+           (inhibit-point-motion-hooks t)
+           (case-fold-search t))
+       (save-restriction
+         (article-narrow-to-head)
+         ;; 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 (car address))
+                 (mail-address (cadr address)))
+             (when (if real-name
+                       (re-search-forward
+                        (concat (gnus-replace-in-string
+                                 (regexp-quote real-name) "[\t ]+" "[\t\n ]+")
+                                "\\|"
+                                (regexp-quote mail-address))
+                        nil t)
+                     (search-forward mail-address nil t))
+               (goto-char (1- (match-beginning 0)))
+               ;; 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 ((point (point)))
+                   (unless (featurep 'xemacs)
+                     (setq gravatar (append gravatar gnus-gravatar-properties)))
+                   (gnus-put-image gravatar (buffer-substring (point) (1+ point)) category)
+                   (put-text-property point (point) 'gnus-gravatar address)
+                   (gnus-add-wash-type category)
+                   (gnus-add-image category gravatar)))))))
+       (goto-char (marker-position mark))))))
 
 ;;;###autoload
 (defun gnus-treat-from-gravatar (&optional force)