[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
master a0b18d3 4/4: Make libravatar lookups asynchronous
From: |
Lars Ingebrigtsen |
Subject: |
master a0b18d3 4/4: Make libravatar lookups asynchronous |
Date: |
Wed, 29 Jul 2020 23:32:26 -0400 (EDT) |
branch: master
commit a0b18d3cc22331a7c30520d654a85330a9557e6e
Author: Lars Ingebrigtsen <larsi@gnus.org>
Commit: Lars Ingebrigtsen <larsi@gnus.org>
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.
---
lisp/gnus/gnus-gravatar.el | 14 +++++----
lisp/image/gravatar.el | 74 ++++++++++++++++++++++++++++------------------
2 files changed, 54 insertions(+), 34 deletions(-)
diff --git a/lisp/gnus/gnus-gravatar.el b/lisp/gnus/gnus-gravatar.el
index e2bd4ed..9c24de4 100644
--- 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 5b5c27d..ff612d2 100644
--- 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))