Mercurial > emacs

changeset 110958:ea91aa0b9743

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
gnus-gravatar.el (gnus-gravatar-transform-address): Adjust avatars' position when (X-)Faces exist. gnus-gravatar.el (gnus-treat-from-gravatar, gnus-treat-mail-gravatar): Force displaying avatars when called interactively.
author Katsumi Yamaoka <yamaoka@jpl.org>
date Wed, 13 Oct 2010 02:19:11 +0000
parents 627742e646c4
children 88da5c66a589
files lisp/gnus/ChangeLog lisp/gnus/gnus-gravatar.el
diffstat 2 files changed, 35 insertions(+), 29 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/gnus/ChangeLog	Tue Oct 12 22:18:24 2010 +0000
+++ b/lisp/gnus/ChangeLog	Wed Oct 13 02:19:11 2010 +0000
@@ -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
--- a/lisp/gnus/gnus-gravatar.el	Tue Oct 12 22:18:24 2010 +0000
+++ b/lisp/gnus/gnus-gravatar.el	Wed Oct 13 02:19:11 2010 +0000
@@ -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 @@
                 (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)