Commit 421eeff2 authored by Philip K's avatar Philip K Committed by Robert Pluim

Add support for multiple Gravatar services

Now supports Libravatar and Unicornify, next to Gravatar (Bug#39965).

* lisp/image/gravatar.el (gravatar-base-url): Remove constant.
(gravatar-service-alist): List supported services.
(gravatar-service): Add user option to specify service, defaults to
Libravatar.
(gravatar--service-libravatar): New function, libravatar image host
resolver implementation.
(gravatar-build-url): Use alist gravatar-service-alist instead of
gravatar-base-url.
* etc/NEWS: Mention new gravatar service option.
parent 82f8bee7
Pipeline #5078 failed with stage
in 69 minutes and 23 seconds
......@@ -186,6 +186,12 @@ key binding
/ v package-menu-filter-by-version
/ / package-menu-filter-clear
** Gravatar
===
*** New user option 'gravatar-service' for host to query for gravatars.
Defaults to Libravatar, with Unicornify and Gravatar as options.
* New Modes and Packages in Emacs 28.1
......
......@@ -26,6 +26,7 @@
(require 'url)
(require 'url-cache)
(require 'dns)
(eval-when-compile
(require 'subr-x))
......@@ -118,9 +119,42 @@ a gravatar for a given email address."
:version "27.1"
:group 'gravatar)
(defconst gravatar-base-url
"https://www.gravatar.com/avatar"
"Base URL for getting gravatars.")
(defconst gravatar-service-alist
`((gravatar . ,(lambda (_addr) "https://www.gravatar.com/avatar"))
(unicornify . ,(lambda (_addr) "https://unicornify.pictures/avatar/"))
(libravatar . ,#'gravatar--service-libravatar))
"Alist of supported gravatar services.")
(defcustom gravatar-service 'libravatar
"Symbol denoting gravatar-like service to use.
Note that certain services might ignore other options, such as
`gravatar-default-image' or certain values as with
`gravatar-rating'."
:type `(choice ,@(mapcar (lambda (s) `(const ,(car s)))
gravatar-service-alist))
:version "28.1"
:link '(url-link "https://www.libravatar.org/")
:link '(url-link "https://unicornify.pictures/")
:link '(url-link "https://gravatar.com/")
:group 'gravatar)
(defun gravatar--service-libravatar (addr)
"Find domain that hosts avatars for email address ADDR."
;; implements https://wiki.libravatar.org/api/
(save-match-data
(unless (string-match ".+@\\(.+\\)" addr)
(error "%s is not an email address" addr))
(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"))))
(defun gravatar-hash (mail-address)
"Return the Gravatar hash for MAIL-ADDRESS."
......@@ -142,7 +176,8 @@ a gravatar for a given email address."
"Return the URL of a gravatar for MAIL-ADDRESS."
;; https://gravatar.com/site/implement/images/
(format "%s/%s?%s"
gravatar-base-url
(funcall (alist-get gravatar-service gravatar-service-alist)
mail-address)
(gravatar-hash mail-address)
(gravatar--query-string)))
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment