gnus-gravatar.el (gnus-gravatar-transform-address): Adjust avatars' position when...

gnus-gravatar.el (gnus-treat-from-gravatar, gnus-treat-mail-gravatar): Force displaying avatars when called interactively.

diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog
index 53da34ae6ceaeb2331b637735ee7f9c73047c5ec..14f7092b6b98986e362e61324e152492bf6710a1 100644 (file)
--- a/lisp/gnus/ChangeLog
+++ b/lisp/gnus/ChangeLog
@@ -1,3 +1,10 @@
+2010-10-13  Katsumi Yamaoka  <yamaoka@jpl.org>
+
+       * gnus-gravatar.el (gnus-gravatar-transform-address): Adjust avatars'
+       position when (X-)Faces exist.
+       (gnus-treat-from-gravatar, gnus-treat-mail-gravatar): Force displaying
+       avatars when called interactively.
+
 2010-10-12  Katsumi Yamaoka  <yamaoka@jpl.org>
 
        * gnus-gravatar.el (gnus-gravatar-too-ugly): Don't test if

diff --git a/lisp/gnus/gnus-gravatar.el b/lisp/gnus/gnus-gravatar.el
index bcc097b7d0f60351a4191ec9970aaea6596c08e9..2444c9e781849e918b7a804ef479b0affb794e0b 100644 (file)
--- a/lisp/gnus/gnus-gravatar.el
+++ b/lisp/gnus/gnus-gravatar.el
@@ -49,7 +49,7 @@
   :version "24.1"
   :group 'gnus-gravatar)
 
-(defun gnus-gravatar-transform-address (header category)
+(defun gnus-gravatar-transform-address (header category &optional force)
   (gnus-with-article-headers
     (let ((addresses
            (mail-header-parse-addresses
@@ -59,20 +59,25 @@
              (ignore-errors
                (mail-encode-encoded-word-string
                 (or (mail-fetch-field header) "")))
-             (mail-fetch-field header)))))
-      (let ((gravatar-size gnus-gravatar-size))
-        (dolist (address addresses)
-         (unless (and gnus-gravatar-too-ugly
-                      (or (string-match gnus-gravatar-too-ugly
-                                        (car address))
-                          (and (cdr address)
-                               (string-match gnus-gravatar-too-ugly
-                                             (cdr address)))))
-           (ignore-errors
-              (gravatar-retrieve
-               (car address)
-               'gnus-gravatar-insert
-               (list header address category)))))))))
+             (mail-fetch-field header))))
+         (gravatar-size gnus-gravatar-size)
+         name)
+      (dolist (address addresses)
+       (when (and (setq name (cdr address))
+                  (string-match "\\`\\*+ " name)) ;; (X-)Faces exist.
+         (setcdr address (setq name (substring name (match-end 0)))))
+       (when (or force
+                 (not (and gnus-gravatar-too-ugly
+                           (or (string-match gnus-gravatar-too-ugly
+                                             (car address))
+                               (and name
+                                    (string-match gnus-gravatar-too-ugly
+                                                  name))))))
+         (ignore-errors
+           (gravatar-retrieve
+            (car address)
+            'gnus-gravatar-insert
+            (list header address category))))))))
 
 (defun gnus-gravatar-insert (gravatar header address category)
   "Insert GRAVATAR for ADDRESS in HEADER in current article buffer.
@@ -109,31 +114,25 @@ Set image category to CATEGORY."
                 (gnus-add-image category gravatar)))))))))
 
 ;;;###autoload
-(defun gnus-treat-from-gravatar ()
+(defun gnus-treat-from-gravatar (&optional force)
   "Display gravatar in the From header.
 If gravatar is already displayed, remove it."
-  (interactive)
+  (interactive (list t)) ;; When type `W D g'
   (gnus-with-article-buffer
     (if (memq 'from-gravatar gnus-article-wash-types)
-        (gnus-delete-images 'from-gravatar)
-      (let ((gnus-gravatar-too-ugly
-            (unless buffer-read-only ;; When type `W D g'
-              gnus-gravatar-too-ugly)))
-       (gnus-gravatar-transform-address "from" 'from-gravatar)))))
+       (gnus-delete-images 'from-gravatar)
+      (gnus-gravatar-transform-address "from" 'from-gravatar force))))
 
 ;;;###autoload
-(defun gnus-treat-mail-gravatar ()
+(defun gnus-treat-mail-gravatar (&optional force)
   "Display gravatars in the Cc and To headers.
 If gravatars are already displayed, remove them."
-  (interactive)
+  (interactive (list t)) ;; When type `W D h'
     (gnus-with-article-buffer
       (if (memq 'mail-gravatar gnus-article-wash-types)
           (gnus-delete-images 'mail-gravatar)
-       (let ((gnus-gravatar-too-ugly
-              (unless buffer-read-only ;; When type `W D h'
-                gnus-gravatar-too-ugly)))
-         (gnus-gravatar-transform-address "cc" 'mail-gravatar)
-         (gnus-gravatar-transform-address "to" 'mail-gravatar)))))
+       (gnus-gravatar-transform-address "cc" 'mail-gravatar force)
+       (gnus-gravatar-transform-address "to" 'mail-gravatar force))))
 
 (provide 'gnus-gravatar)