Commit 7417851c authored by Katsumi Yamaoka's avatar Katsumi Yamaoka
Browse files

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.
parent ab67634f
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
......
......@@ -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)
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment