Make libravatar lookups asynchronous

* lisp/gnus/gnus-gravatar.el (gnus-gravatar-insert): Fix check for
repeated gravatars, which is now easier to trigger now that things
are more asynchronous.

* lisp/image/gravatar.el (gravatar--service-libravatar): Fetch the
data asynchronously (bug#40676).
(gravatar-service-alist): Adjust all providers so they are
asynchronous.
(gravatar-build-url): Adjust caller to be asynchronous.
(gravatar-retrieve): Ditto.
(gravatar-retrieve-synchronously): Ditto.

diff --git a/lisp/gnus/gnus-gravatar.el b/lisp/gnus/gnus-gravatar.el
index e2bd4ed860cde9b36e16cbd23d2d4d68aec799d3..9c24de44cd63e752d10e2bc2276f6e3eda060a52 100644 (file)
--- a/lisp/gnus/gnus-gravatar.el
+++ b/lisp/gnus/gnus-gravatar.el
@@ -109,14 +109,16 @@ callback for `gravatar-retrieve'."
               ;; If we're on the " quoting the name, go backward.
               (when (looking-at-p "[\"<]")
                 (goto-char (1- (point))))
-              ;; Do not do anything if there's already a gravatar.  This can
-              ;; happen 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 (get-text-property (point) 'gnus-gravatar)
+              ;; Do not do anything if there's already a gravatar.
+              ;; This can happen 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 (get-text-property (1- (point)) 'gnus-gravatar)
                 (let ((pos (point)))
                   (setq gravatar (append gravatar gnus-gravatar-properties))
-                  (gnus-put-image gravatar (buffer-substring pos (1+ pos)) category)
+                  (gnus-put-image gravatar (buffer-substring pos (1+ pos))
+                                 category)
                   (put-text-property pos (point) 'gnus-gravatar address)
                   (gnus-add-wash-type category)
                   (gnus-add-image category gravatar)))))

diff --git a/lisp/image/gravatar.el b/lisp/image/gravatar.el
index 5b5c27dbe17cafd960e6141d160b4d5973b5cbc1..ff612d2e9f33fc86d029960d8d3c0a20f85e20ee 100644 (file)
--- a/lisp/image/gravatar.el
+++ b/lisp/image/gravatar.el
@@ -120,8 +120,10 @@ a gravatar for a given email address."
   :group 'gravatar)
 
 (defconst gravatar-service-alist
-  `((gravatar . ,(lambda (_addr) "https://www.gravatar.com/avatar"))
-    (unicornify . ,(lambda (_addr) "https://unicornify.pictures/avatar/"))
+  `((gravatar . ,(lambda (_addr callback)
+                   (funcall callback "https://www.gravatar.com/avatar")))
+    (unicornify . ,(lambda (_addr callback)
+                     (funcall callback "https://unicornify.pictures/avatar/")))
     (libravatar . ,#'gravatar--service-libravatar))
   "Alist of supported gravatar services.")
 
@@ -141,23 +143,31 @@ to track whether you're reading a specific mail."
   :link '(url-link "https://gravatar.com/")
   :group 'gravatar)
 
-(defun gravatar--service-libravatar (addr)
+(defun gravatar--service-libravatar (addr callback)
   "Find domain that hosts avatars for email address ADDR."
   ;; implements https://wiki.libravatar.org/api/
   (save-match-data
     (if (not (string-match ".+@\\(.+\\)" addr))
-        "https://seccdn.libravatar.org/avatar"
-      (let ((domain (match-string 1 addr)))
-        (catch 'found
-          (dolist (record '(("_avatars-sec" . "https")
-                            ("_avatars" . "http")))
-            (let* ((query (concat (car record) "._tcp." domain))
-                   (result (dns-query query 'SRV)))
-              (when result
-                (throw 'found (format "%s://%s/avatar"
-                                      (cdr record)
-                                      result)))))
-          "https://seccdn.libravatar.org/avatar")))))
+        (funcall callback "https://seccdn.libravatar.org/avatar")
+      (let ((domain (match-string 1 addr))
+            (records '(("_avatars-sec" . "https")
+                       ("_avatars" . "http")))
+            func)
+        (setq func
+              (lambda (result)
+                (cond
+                 (result
+                  (funcall callback (format "%s://%s/avatar"
+                                            (cdar records) result)))
+                 ((> (length records) 1)
+                  (pop records)
+                  (dns-query-asynchronous
+                   (concat (caar records) "._tcp." domain)
+                   func 'SRV))
+                 (t
+                  (funcall callback "https://seccdn.libravatar.org/avatar")))))
+        (dns-query-asynchronous
+         (concat (caar records) "._tcp." domain) func 'SRV)))))
 
 (defun gravatar-hash (mail-address)
   "Return the Gravatar hash for MAIL-ADDRESS."
@@ -175,14 +185,17 @@ to track whether you're reading a specific mail."
      ,@(and gravatar-size
             `((s ,gravatar-size))))))
 
-(defun gravatar-build-url (mail-address)
-  "Return the URL of a gravatar for MAIL-ADDRESS."
+(defun gravatar-build-url (mail-address callback)
+  "Find the URL of a gravatar for MAIL-ADDRESS and call CALLBACK with it."
   ;; https://gravatar.com/site/implement/images/
-  (format "%s/%s?%s"
-          (funcall (alist-get gravatar-service gravatar-service-alist)
-                   mail-address)
-          (gravatar-hash mail-address)
-          (gravatar--query-string)))
+  (funcall (alist-get gravatar-service gravatar-service-alist)
+           mail-address
+           (lambda (url)
+             (funcall callback
+                      (format "%s/%s?%s"
+                              url
+                              (gravatar-hash mail-address)
+                              (gravatar--query-string))))))
 
 (defun gravatar-get-data ()
   "Return body of current URL buffer, or nil on failure."
@@ -198,18 +211,23 @@ to track whether you're reading a specific mail."
 When finished, call CALLBACK as (apply CALLBACK GRAVATAR CBARGS),
 where GRAVATAR is either an image descriptor, or the symbol
 `error' if the retrieval failed."
-  (let ((url (gravatar-build-url mail-address)))
-    (if (url-cache-expired url gravatar-cache-ttl)
-        (url-retrieve url #'gravatar-retrieved (list callback cbargs) t)
-      (with-current-buffer (url-fetch-from-cache url)
-        (gravatar-retrieved () callback cbargs)))))
+  (gravatar-build-url
+   mail-address
+   (lambda (url)
+     (if (url-cache-expired url gravatar-cache-ttl)
+         (url-retrieve url #'gravatar-retrieved (list callback cbargs) t)
+       (with-current-buffer (url-fetch-from-cache url)
+         (gravatar-retrieved () callback cbargs))))))
 
 ;;;###autoload
 (defun gravatar-retrieve-synchronously (mail-address)
   "Synchronously retrieve a gravatar for MAIL-ADDRESS.
 Value is either an image descriptor, or the symbol `error' if the
 retrieval failed."
-  (let ((url (gravatar-build-url mail-address)))
+  (let ((url nil))
+    (gravatar-build-url mail-address (lambda (u) (setq url u)))
+    (while (not url)
+      (sleep-for 0.01))
     (with-current-buffer (if (url-cache-expired url gravatar-cache-ttl)
                              (url-retrieve-synchronously url t)
                            (url-fetch-from-cache url))