X-Git-Url: https://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fgnus-gravatar.el;h=b6e760b1d0be749b7a38df11791346643baf010e;hb=d84b26f66f1975b52a15ca2caf5f10da5103e42e;hp=2b1143b3b7bbed77d29cb3a5453cf171760aee2b;hpb=86452d72c15ae02619430326892d30f50c2426c3;p=gnus diff --git a/lisp/gnus-gravatar.el b/lisp/gnus-gravatar.el index 2b1143b3b..b6e760b1d 100644 --- a/lisp/gnus-gravatar.el +++ b/lisp/gnus-gravatar.el @@ -1,6 +1,6 @@ ;;; gnus-gravatar.el --- Gnus Gravatar support -;; Copyright (C) 2010 Free Software Foundation, Inc. +;; Copyright (C) 2010-2012 Free Software Foundation, Inc. ;; Author: Julien Danjou ;; Keywords: news @@ -54,6 +54,7 @@ If nil, default to `gravatar-size'." (defun gnus-gravatar-transform-address (header category &optional force) (gnus-with-article-headers (let* ((mail-extr-disable-voodoo t) + (mail-extr-ignore-realname-equals-mailbox-name nil) (addresses (mail-extract-address-components (or (mail-fetch-field header) "") t)) (gravatar-size (or gnus-gravatar-size gravatar-size)) @@ -79,37 +80,43 @@ If nil, default to `gravatar-size'." "Insert GRAVATAR for ADDRESS in HEADER in current article buffer. Set image category to CATEGORY." (unless (eq gravatar 'error) - (gnus-with-article-headers - ;; The buffer can be gone at this time - (when (buffer-live-p (current-buffer)) - (gnus-article-goto-header header) - (mail-header-narrow-to-field) - (let ((real-name (car address)) - (mail-address (cadr address))) - (when (if real-name - (re-search-forward - (concat (gnus-replace-in-string - (regexp-quote real-name) "[\t ]+" "[\t\n ]+") - "\\|" - (regexp-quote mail-address)) - nil t) - (search-forward mail-address nil t)) - (goto-char (1- (match-beginning 0))) - ;; If we're on the " quoting the name, go backward - (when (looking-at "[\"<]") - (goto-char (1- (point)))) - ;; Do not do anything if there's already a gravatar. This can - ;; happens if the buffer has been regenerated in the mean time, for - ;; 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 ((point (point))) - (unless (featurep 'xemacs) - (setq gravatar (append gravatar gnus-gravatar-properties))) - (gnus-put-image gravatar nil category) - (put-text-property point (point) 'gnus-gravatar address) - (gnus-add-wash-type category) - (gnus-add-image category gravatar))))))))) + (gnus-with-article-buffer + (let ((mark (point-marker)) + (inhibit-point-motion-hooks t) + (case-fold-search t)) + (save-restriction + (article-narrow-to-head) + ;; The buffer can be gone at this time + (when (buffer-live-p (current-buffer)) + (gnus-article-goto-header header) + (mail-header-narrow-to-field) + (let ((real-name (car address)) + (mail-address (cadr address))) + (when (if real-name + (re-search-forward + (concat (gnus-replace-in-string + (regexp-quote real-name) "[\t ]+" "[\t\n ]+") + "\\|" + (regexp-quote mail-address)) + nil t) + (search-forward mail-address nil t)) + (goto-char (1- (match-beginning 0))) + ;; If we're on the " quoting the name, go backward + (when (looking-at "[\"<]") + (goto-char (1- (point)))) + ;; Do not do anything if there's already a gravatar. This can + ;; happens if the buffer has been regenerated in the mean time, for + ;; 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 ((point (point))) + (unless (featurep 'xemacs) + (setq gravatar (append gravatar gnus-gravatar-properties))) + (gnus-put-image gravatar (buffer-substring (point) (1+ point)) category) + (put-text-property point (point) 'gnus-gravatar address) + (gnus-add-wash-type category) + (gnus-add-image category gravatar))))))) + (goto-char (marker-position mark)))))) ;;;###autoload (defun gnus-treat-from-gravatar (&optional force)