* eww.el (eww-tag-select): Don't render totally empty <select> forms.

[gnus] / lisp / gnus-gravatar.el

diff --git a/lisp/gnus-gravatar.el b/lisp/gnus-gravatar.el
index 2444c9e..33bcb6b 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-2013 Free Software Foundation, Inc.

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


@@ -26,20 +26,22 @@
 
 (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."
   :group 'gnus-visual)
 
 
 (defgroup gnus-gravatar nil
   "Gnus Gravatar."
   :group 'gnus-visual)
 

-(defcustom gnus-gravatar-size 32
-  "How big should gravatars be displayed."
-  :type 'integer
+(defcustom gnus-gravatar-size nil
+  "How big should gravatars be displayed.
+If nil, default to `gravatar-size'."
+  :type '(choice (const nil) integer)

   :version "24.1"
   :group 'gnus-gravatar)
 
 (defcustom gnus-gravatar-properties '(:ascent center :relief 1)
   "List of image properties applied to Gravatar images."
   :version "24.1"
   :group 'gnus-gravatar)
 
 (defcustom gnus-gravatar-properties '(:ascent center :relief 1)
   "List of image properties applied to Gravatar images."

-  :type 'list
+  :type 'sexp

   :version "24.1"
   :group 'gnus-gravatar)
 
   :version "24.1"
   :group 'gnus-gravatar)
 


@@ -51,31 +53,26 @@
 
 (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 gnus-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 (and (setq name (cdr address))
-                  (string-match "\\`\\*+ " name)) ;; (X-)Faces exist.
-         (setcdr address (setq name (substring name (match-end 0)))))
+       (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 @@
   "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             ; have a realname, go for it!
-                    (and (search-forward real-name nil t)
-                         (search-backward real-name nil t))
-                  (and (search-forward mail-address nil t)
-                       (search-backward mail-address nil t)))
-            (goto-char (1- (point)))
-            ;; 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)