Make gravatar.el more configurable

For discussion, see the following thread:
https://lists.gnu.org/archive/html/emacs-devel/2019-07/msg00528.html

* etc/NEWS: Announce changes in gravatar.el user options.

* lisp/image/gravatar.el (gravatar-cache-ttl): Change :type to
number of seconds without changing the default value and while still
accepting other timestamp formats.
(gravatar-rating): Restrict :type to ratings recognized by Gravatar.
(gravatar-size): Allow nil as a value, in which case Gravatar's
default size is used.
(gravatar-default-image, gravatar-force-default): New user options
controlling the Gravatar query parameters 'default' and
'forcedefault', respectively.
(gravatar-base-url): Use HTTPS.
(gravatar--query-string): New helper function to facilitate testing.
(gravatar-build-url): Use it.

* test/lisp/image/gravatar-tests.el (gravatar-size)
(gravatar-default-image, gravatar-force-default)
(gravatar-build-url): New tests.

3 files changed, 123 insertions, 13 deletions

diff --git a/etc/NEWS b/etc/NEWS
index 9be10b4e797..e84c0d3ec53 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -1788,6 +1788,22 @@ particular when the end of the buffer is visible in the window.
 Use 'mouse-wheel-mode' instead.  Note that 'mouse-wheel-mode' is
 already enabled by default on most graphical displays.
 
+** Gravatar
+
++++
+*** 'gravatar-cache-ttl' is now a number of seconds.
+The previously used timestamp format of a list of integers is still
+supported, but is deprecated.  The default value has not changed.
+
++++
+*** 'gravatar-size' can now be nil.
+This results in the use of Gravatar's default size of 80 pixels.
+
++++
+*** The default fallback gravatar is now configurable.
+This is possible using the new user options 'gravatar-default-image'
+and 'gravatar-force-default'.
+
 
 * New Modes and Packages in Emacs 27.1
 
diff --git a/lisp/image/gravatar.el b/lisp/image/gravatar.el
index 52fd875d68c..e235fdd76f3 100644
--- a/lisp/image/gravatar.el
+++ b/lisp/image/gravatar.el
@@ -39,12 +39,13 @@
   :type 'boolean
   :group 'gravatar)
 
-;; FIXME a time value is not the nicest format for a custom variable.
-(defcustom gravatar-cache-ttl (days-to-time 30)
-  "Time to live for gravatar cache entries.
+(defcustom gravatar-cache-ttl 2592000
+  "Time to live in seconds for gravatar cache entries.
 If a requested gravatar has been cached for longer than this, it
-is retrieved anew."
-  :type '(repeat integer)
+is retrieved anew.  The default value is 30 days."
+  :type 'integer
+  ;; Restricted :type to number of seconds.
+  :version "27.1"
   :group 'gravatar)
 
 (defcustom gravatar-rating "g"
@@ -64,17 +65,61 @@ of increasing explicitness, the following:
 Each level covers itself as well as all less explicit levels.
 For example, setting this variable to \"pg\" will allow gravatars
 rated either \"g\" or \"pg\"."
-  :type 'string
+  :type '(choice (const :tag "General Audience" "g")
+                 (const :tag "Parental Guidance" "pg")
+                 (const :tag "Restricted" "r")
+                 (const :tag "Explicit" "x"))
+  ;; Restricted :type to ratings recognized by Gravatar.
+  :version "27.1"
   :group 'gravatar)
 
 (defcustom gravatar-size 32
   "Gravatar size in pixels to request.
-Valid sizes range from 1 to 2048 inclusive."
-  :type 'integer
+Valid sizes range from 1 to 2048 inclusive.  If nil, use the
+Gravatar default (usually 80)."
+  :type '(choice (const :tag "Gravatar default" nil)
+                 (integer :tag "Pixels"))
+  :version "27.1"
+  :group 'gravatar)
+
+(defcustom gravatar-default-image "404"
+  "Default gravatar to use when none match the request.
+This happens when no gravatar satisfying `gravatar-rating' exists
+for a given email address.  The following options are supported:
+
+nil         - Default placeholder.
+\"404\"       - No placeholder.
+\"mp\"        - Mystery Person: generic avatar outline.
+\"identicon\" - Geometric pattern based on email address.
+\"monsterid\" - Generated \"monster\" with different colors, faces, etc.
+\"wavatar\"   - Generated faces with different features and backgrounds.
+\"retro\"     - Generated 8-bit arcade-style pixelated faces.
+\"robohash\"  - Generated robot with different colors, faces, etc.
+\"blank\"     - Transparent PNG image.
+URL         - Custom image URL."
+  :type '(choice (const :tag "Default" nil)
+                 (const :tag "None" "404")
+                 (const :tag "Mystery person" "mp")
+                 (const :tag "Geometric patterns" "identicon")
+                 (const :tag "Monsters" "monsterid")
+                 (const :tag "Faces" "wavatar")
+                 (const :tag "Retro" "retro")
+                 (const :tag "Robots" "robohash")
+                 (const :tag "Blank" "blank")
+                 (string :tag "Custom URL"))
+  :version "27.1"
+  :group 'gravatar)
+
+(defcustom gravatar-force-default nil
+  "Whether to force use of `gravatar-default-image'.
+Non-nil means use `gravatar-default-image' even when there exists
+a gravatar for a given email address."
+  :type 'boolean
+  :version "27.1"
   :group 'gravatar)
 
 (defconst gravatar-base-url
-  "http://www.gravatar.com/avatar"
+  "https://www.gravatar.com/avatar"
   "Base URL for getting gravatars.")
 
 (defun gravatar-hash (mail-address)
@@ -82,13 +127,24 @@ Valid sizes range from 1 to 2048 inclusive."
   ;; https://gravatar.com/site/implement/hash/
   (md5 (downcase (string-trim mail-address))))
 
+(defun gravatar--query-string ()
+  "Return URI-encoded query string for Gravatar."
+  (url-build-query-string
+   `((r ,gravatar-rating)
+     ,@(and gravatar-default-image
+            `((d ,gravatar-default-image)))
+     ,@(and gravatar-force-default
+            '((f y)))
+     ,@(and gravatar-size
+            `((s ,gravatar-size))))))
+
 (defun gravatar-build-url (mail-address)
-  "Return a URL to retrieve MAIL-ADDRESS gravatar."
-  (format "%s/%s?d=404&r=%s&s=%d"
+  "Return the URL of a gravatar for MAIL-ADDRESS."
+  ;; https://gravatar.com/site/implement/images/
+  (format "%s/%s?%s"
           gravatar-base-url
           (gravatar-hash mail-address)
-          gravatar-rating
-          gravatar-size))
+          (gravatar--query-string)))
 
 (defun gravatar-get-data ()
   "Return body of current URL buffer, or nil on failure."
diff --git a/test/lisp/image/gravatar-tests.el b/test/lisp/image/gravatar-tests.el
index e6239da0084..bd61663f0e8 100644
--- a/test/lisp/image/gravatar-tests.el
+++ b/test/lisp/image/gravatar-tests.el
@@ -31,4 +31,42 @@
     (should (equal (gravatar-hash " foo") hash))
     (should (equal (gravatar-hash " foo ") hash))))
 
+(ert-deftest gravatar-size ()
+  "Test query strings for `gravatar-size'."
+  (let ((gravatar-default-image nil)
+        (gravatar-force-default nil))
+    (let ((gravatar-size 2048))
+      (should (equal (gravatar--query-string) "r=g&s=2048")))
+    (let ((gravatar-size nil))
+      (should (equal (gravatar--query-string) "r=g")))))
+
+(ert-deftest gravatar-default-image ()
+  "Test query strings for `gravatar-default-image'."
+  (let ((gravatar-force-default nil)
+        (gravatar-size nil))
+    (let ((gravatar-default-image nil))
+      (should (equal (gravatar--query-string) "r=g")))
+    (let ((gravatar-default-image "404"))
+      (should (equal (gravatar--query-string) "r=g&d=404")))
+    (let ((gravatar-default-image "https://foo/bar.png"))
+      (should (equal (gravatar--query-string)
+                     "r=g&d=https%3A%2F%2Ffoo%2Fbar.png")))))
+
+(ert-deftest gravatar-force-default ()
+  "Test query strings for `gravatar-force-default'."
+  (let ((gravatar-default-image nil)
+        (gravatar-size nil))
+    (let ((gravatar-force-default nil))
+      (should (equal (gravatar--query-string) "r=g")))
+    (let ((gravatar-force-default t))
+      (should (equal (gravatar--query-string) "r=g&f=y")))))
+
+(ert-deftest gravatar-build-url ()
+  "Test `gravatar-build-url'."
+  (let ((gravatar-default-image nil)
+        (gravatar-force-default nil)
+        (gravatar-size nil))
+    (should (equal (gravatar-build-url "foo") "\
+https://www.gravatar.com/avatar/acbd18db4cc2f85cedef654fccc4a4d8?r=g"))))
+
 ;;; gravatar-tests.el ends here