[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
master 421eeff: Add support for multiple Gravatar services
From: |
Robert Pluim |
Subject: |
master 421eeff: Add support for multiple Gravatar services |
Date: |
Tue, 24 Mar 2020 13:00:26 -0400 (EDT) |
branch: master
commit 421eeff243af683bf0b7c6d9181650a1c6900f9b
Author: Philip K <address@hidden>
Commit: Robert Pluim <address@hidden>
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.
---
etc/NEWS | 6 ++++++
lisp/image/gravatar.el | 43 +++++++++++++++++++++++++++++++++++++++----
2 files changed, 45 insertions(+), 4 deletions(-)
diff --git a/etc/NEWS b/etc/NEWS
index ba3e691..2150f49 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -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
diff --git a/lisp/image/gravatar.el b/lisp/image/gravatar.el
index b8542bc..e13f0075 100644
--- a/lisp/image/gravatar.el
+++ b/lisp/image/gravatar.el
@@ -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)))
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- master 421eeff: Add support for multiple Gravatar services,
Robert Pluim <=