From 21cd810daa768ec2f4ac6c26ed84782fed62c0a0 Mon Sep 17 00:00:00 2001 From: Katsumi Yamaoka Date: Wed, 1 Dec 2010 01:10:49 +0000 Subject: [PATCH] gnus-gravatar.el (gnus-gravatar-insert): Delete unnecessary binding to t of inhibit-read-only since it is inside gnus-with-article-headers. gnus-gravatar.el (gnus-gravatar-transform-address): Use mail-extract-address-components that supports non-ASCII names rather than mail-header-parse-addresses. --- lisp/ChangeLog | 8 ++++++++ lisp/gnus-gravatar.el | 33 ++++++++++++++------------------- 2 files changed, 22 insertions(+), 19 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index c11d21d4c..763fc5eac 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,11 @@ +2010-12-01 Katsumi Yamaoka + + * gnus-gravatar.el (gnus-gravatar-insert): Delete unnecessary binding + to t of inhibit-read-only since it is inside gnus-with-article-headers. + Suggested by Štěpán Němec . + (gnus-gravatar-transform-address): Use mail-extract-address-components + that supports non-ASCII names rather than mail-header-parse-addresses. + 2010-11-30 Lars Magne Ingebrigtsen * proto-stream.el (open-protocol-stream): All starttls connections are diff --git a/lisp/gnus-gravatar.el b/lisp/gnus-gravatar.el index 031c24480..046df12c3 100644 --- a/lisp/gnus-gravatar.el +++ b/lisp/gnus-gravatar.el @@ -26,6 +26,7 @@ (require 'gravatar) (require 'gnus-art) +(require 'mail-extr) ;; Because of binding `mail-extr-disable-voodoo'. (defgroup gnus-gravatar nil "Gnus Gravatar." @@ -52,30 +53,25 @@ If nil, default to `gravatar-size'." (defun gnus-gravatar-transform-address (header category &optional force) (gnus-with-article-headers - (let ((addresses - (mail-header-parse-addresses - ;; mail-header-parse-addresses does not work (reliably) on - ;; decoded headers. - (or - (ignore-errors - (mail-encode-encoded-word-string - (or (mail-fetch-field header) ""))) - (mail-fetch-field header)))) - (gravatar-size (or gnus-gravatar-size gravatar-size)) - name) + (let* ((mail-extr-disable-voodoo t) + (addresses (mail-extract-address-components + (or (mail-fetch-field header) "") t)) + (gravatar-size gnus-gravatar-size) + name) (dolist (address addresses) - (when (setq name (cdr address)) - (setcdr address (setq name (mail-decode-encoded-word-string name)))) + (when (and (setq name (car address)) + (string-match "\\` +" name)) + (setcar 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)) + (cadr address)) (and name (string-match gnus-gravatar-too-ugly name)))))) (ignore-errors (gravatar-retrieve - (car address) + (cadr address) 'gnus-gravatar-insert (list header address category)))))))) @@ -88,8 +84,8 @@ Set image category to CATEGORY." (when (buffer-live-p (current-buffer)) (gnus-article-goto-header header) (mail-header-narrow-to-field) - (let ((real-name (cdr address)) - (mail-address (car address))) + (let ((real-name (car address)) + (mail-address (cadr address))) (when (if real-name (re-search-forward (concat (regexp-quote real-name) "\\|" (regexp-quote mail-address)) @@ -104,8 +100,7 @@ Set image category to CATEGORY." ;; 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 ((inhibit-read-only t) - (point (point))) + (let ((point (point))) (unless (featurep 'xemacs) (setq gravatar (append gravatar gnus-gravatar-properties))) (gnus-put-image gravatar nil category) -- 2.25.1