[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
bug#39965: [PATCH] Add support for multiple gravatar-like services
From: |
Philip Kaludercic |
Subject: |
bug#39965: [PATCH] Add support for multiple gravatar-like services |
Date: |
Mon, 09 Mar 2020 16:10:48 +0100 |
User-agent: |
Gnus/5.13 (Gnus v5.13) Emacs/28.0.50 (gnu/linux) |
Robert Pluim <rpluim@gmail.com> writes:
> (please keep 39965@debbugs.gnu.org in the CC list)
Sorry for that!
>>>>>> On Mon, 09 Mar 2020 15:48:59 +0100, Philip Kaludercic
>>>>>> <philip.kaludercic@fau.de> said:
>
> >>
> >> If you make this an alist then your cond below becomes just
> >> 'alist-get', and you have the URLS in just one place.
>
> Philip> That's right, I had already "fixed" that in the next version of
> the
> Philip> patch, but primarily because libravatar requires a bit more to
> work
> Philip> correctly than just alist-get.
>
> OK
>
> Philip> Sadly I cannot send the patch right now, because git-send-email
> doesn't
> Philip> work from where I am writing.
>
> git format-patch HEAD~ + attaching the result will work as
> well, assuming your MUA doesnʼt mangle patches :-)
In that case I'm attaching the patch to this mail, I hope Gnus handels
it corretly.
>From 5c967bc9e2c3bc72e3803d84b23b8b121328c49c Mon Sep 17 00:00:00 2001
From: Philip K <philip@warpmail.net>
Date: Fri, 6 Mar 2020 12:40:28 +0100
Subject: [PATCH] Add support for multiple gravatar-like services
Specifically, the non-proprietary services libravatar (now default)
and unicornify have been added. The behaviour is customised via the
new variable `gravatar-service'.
---
etc/NEWS | 7 ++++++
lisp/image/gravatar.el | 37 +++++++++++++++++++++++++++----
test/lisp/image/gravatar-tests.el | 1 +
3 files changed, 41 insertions(+), 4 deletions(-)
diff --git a/etc/NEWS b/etc/NEWS
index 7f70d149d6..24edf2de6a 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -171,6 +171,13 @@ key binding
/ v package-menu-filter-by-version
/ / package-menu-filter-clear
+** gravatar.el
+
+---
+*** New variable `gravatar-service' changes avatar service.
+Now supports Libravatar (as default) and Unicornify, next to the
+already implemented Gravatar.
+
* New Modes and Packages in Emacs 28.1
diff --git a/lisp/image/gravatar.el b/lisp/image/gravatar.el
index b8542bc3c3..4ac545730a 100644
--- a/lisp/image/gravatar.el
+++ b/lisp/image/gravatar.el
@@ -118,9 +118,37 @@ gravatar-force-default
: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/
+ (require 'dns)
+ (let* ((domain (save-match-data
+ (unless (string-match ".+@\\(.+\\)" addr)
+ (error "%s is not an email address" addr))
+ (match-string 1 addr)))
+ (result (dns-query (concat "_avatars._tcp." domain) 'SRV)))
+ (if result
+ (concat "http://" result "/address")
+ "https://seccdn.libravatar.org/avatar")))
(defun gravatar-hash (mail-address)
"Return the Gravatar hash for MAIL-ADDRESS."
@@ -142,7 +170,8 @@ gravatar-build-url
"Return the URL of a gravatar for MAIL-ADDRESS."
;; https://gravatar.com/site/implement/images/
(format "%s/%s?%s"
- gravatar-base-url
+ (funcall (cdr (assq gravatar-service gravatar-service-alist))
+ mail-address)
(gravatar-hash mail-address)
(gravatar--query-string)))
diff --git a/test/lisp/image/gravatar-tests.el
b/test/lisp/image/gravatar-tests.el
index e66b5c6803..31a28293fa 100644
--- a/test/lisp/image/gravatar-tests.el
+++ b/test/lisp/image/gravatar-tests.el
@@ -65,6 +65,7 @@ gravatar-build-url
"Test `gravatar-build-url'."
(let ((gravatar-default-image nil)
(gravatar-force-default nil)
+ (gravatar-service 'gravatar)
(gravatar-size nil))
(should (equal (gravatar-build-url "foo") "\
https://www.gravatar.com/avatar/acbd18db4cc2f85cedef654fccc4a4d8?r=g"))))
--
2.20.1
bug#39965: [PATCH] Add support for multiple gravatar-like services, Philip K ., 2020/03/10