Add hooks for gcc handling

[gnus] / lisp / gnus-gravatar.el

diff --git a/lisp/gnus-gravatar.el b/lisp/gnus-gravatar.el
index 031c244..b6e760b 100644 (file)
--- a/lisp/gnus-gravatar.el
+++ b/lisp/gnus-gravatar.el
@@ -1,6 +1,6 @@
 ;;; gnus-gravatar.el --- Gnus Gravatar support
 
 ;;; gnus-gravatar.el --- Gnus Gravatar support
 

-;; Copyright (C) 2010 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2012 Free Software Foundation, Inc.

 
 ;; Author: Julien Danjou <julien@danjou.info>
 ;; Keywords: news
 
 ;; Author: Julien Danjou <julien@danjou.info>
 ;; Keywords: news


@@ -26,6 +26,7 @@
 
 (require 'gravatar)
 (require 'gnus-art)
 
 (require 'gravatar)
 (require 'gnus-art)

+(require 'mail-extr) ;; Because of binding `mail-extr-disable-voodoo'.

 
 (defgroup gnus-gravatar nil
   "Gnus Gravatar."
 
 (defgroup gnus-gravatar nil
   "Gnus Gravatar."


@@ -52,30 +53,26 @@ If nil, default to `gravatar-size'."
 
 (defun gnus-gravatar-transform-address (header category &optional force)
   (gnus-with-article-headers
 
 (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)
+           (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))
+          name)

       (dolist (address addresses)
       (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
        (when (or force
                  (not (and gnus-gravatar-too-ugly
                            (or (string-match gnus-gravatar-too-ugly

-                                             (car address))
+                                             (or (cadr address) ""))

                                (and name
                                     (string-match gnus-gravatar-too-ugly
                                                   name))))))
          (ignore-errors
            (gravatar-retrieve
                                (and name
                                     (string-match gnus-gravatar-too-ugly
                                                   name))))))
          (ignore-errors
            (gravatar-retrieve

-            (car address)
+            (cadr address)

             'gnus-gravatar-insert
             (list header address category))))))))
 
             'gnus-gravatar-insert
             (list header address category))))))))
 


@@ -83,35 +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)
   "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 (cdr address))
-              (mail-address (car address)))
-          (when (if real-name
-                   (re-search-forward (concat (regexp-quote real-name) "\\|"
-                                              (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 ((inhibit-read-only t)
-                    (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)
 
 ;;;###autoload
 (defun gnus-treat-from-gravatar (&optional force)