# HG changeset patch # User Katsumi Yamaoka # Date 1286936351 0 # Node ID ea91aa0b9743bc7ac93c409c3757a65a41511976 # Parent 627742e646c407ebcb9c6d8581b4af21590357c4 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. diff -r 627742e646c4 -r ea91aa0b9743 lisp/gnus/ChangeLog --- 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 + + * 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 * gnus-gravatar.el (gnus-gravatar-too-ugly): Don't test if diff -r 627742e646c4 -r ea91aa0b9743 lisp/gnus/gnus-gravatar.el --- 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)