unofficial mirror of emacs-devel@gnu.org 
 help / color / mirror / code / Atom feed
* [PATCH] Improve Gravatar support
@ 2019-07-22 13:23 Basil L. Contovounesios
  2019-07-22 13:31 ` Lars Ingebrigtsen
  2019-07-22 13:39 ` Andy Moreton
  0 siblings, 2 replies; 11+ messages in thread
From: Basil L. Contovounesios @ 2019-07-22 13:23 UTC (permalink / raw)
  To: emacs-devel; +Cc: Julien Danjou, Lars Ingebrigtsen

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #1: 0001-Improve-Gravatar-support.patch --]
[-- Type: text/x-diff, Size: 24781 bytes --]

From e3843695775f2f52cf9c6ca435949df67d83ed11 Mon Sep 17 00:00:00 2001
From: "Basil L. Contovounesios" <contovob@tcd.ie>
Date: Sat, 20 Jul 2019 19:14:16 +0100
Subject: [PATCH] Improve Gravatar support

* doc/misc/gnus.texi (X-Face): Fix cross-reference.
(Gravatars): Clarify user option descriptions.

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

* lisp/gnus/gnus-gravatar.el: Use lexical-binding.
(gnus-gravatar-size, gnus-gravatar-too-ugly): Clarify docstring and
custom :type.
(gnus-gravatar-insert): Check liveness of article buffer sooner.
(gnus-treat-from-gravatar, gnus-treat-mail-gravatar): Use
interactive spec "p" instead of emulating it.

* lisp/image/gravatar.el: Use lexical-binding.
(gravatar-cache-ttl): Change :type to number of seconds without
changing the default value and while still accepting other time
value formats.
(gravatar-rating): Restrict :type to ratings recognized by Gravatar
and document them.
(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-hash): Trim leading and trailing whitespace in given
address, as per the Gravatar docs.
(gravatar--query-string): New helper function to facilitate testing.
(gravatar-build-url): Use it.
(gravatar-cache-expired): Remove.  Change all callers to use
url-cache-expired instead.
(gravatar-get-data): Simplify.
(gravatar-data->image): Remove.
(gravatar-retrieve, gravatar-retrieve-synchronously): Document
return value.  Reuse url-fetch-from-cache and gravatar-retrieved to
reduce duplication.
(gravatar-retrieved): Do not cache buffer on error or if
url-current-object is nil.  The latter condition affords reusing
this function in cached URL buffers.

* test/lisp/image/gravatar-tests.el: New file.
---
 doc/misc/gnus.texi                |  26 ++--
 etc/NEWS                          |  13 ++
 lisp/gnus/gnus-gravatar.el        | 104 +++++++--------
 lisp/image/gravatar.el            | 207 ++++++++++++++++++------------
 test/lisp/image/gravatar-tests.el |  72 +++++++++++
 5 files changed, 279 insertions(+), 143 deletions(-)
 create mode 100644 test/lisp/image/gravatar-tests.el

diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi
index f688e84e7e..07c81c49c4 100644
--- a/doc/misc/gnus.texi
+++ b/doc/misc/gnus.texi
@@ -23505,11 +23505,11 @@ X-Face
         (png . (:relief -2))))
 @end lisp
 
-@pxref{Image Descriptors, ,Image Descriptors, elisp, The Emacs Lisp
-Reference Manual} for the valid properties for various image types.
-Currently, @code{pbm} is used for X-Face images and @code{png} is used
-for Face images in Emacs.  Only the @code{:face} property is effective
-on the @code{xface} image type in XEmacs if it is built with the
+For the valid properties of various image types, @pxref{Image
+Descriptors,,, elisp, The Emacs Lisp Reference Manual}.  Currently,
+@code{pbm} is used for X-Face images and @code{png} is used for Face
+images in Emacs.  Only the @code{:face} property is effective on the
+@code{xface} image type in XEmacs if it is built with the
 @samp{libcompface} library.
 @end table
 
@@ -23780,21 +23780,25 @@ Gravatars
 @item gnus-gravatar-size
 @vindex gnus-gravatar-size
 The size in pixels of gravatars.  Gravatars are always square, so one
-number for the size is enough.
+number for the size is enough.  If @code{nil}, this defaults to the
+value of @code{gravatar-size}.
 
 @item gnus-gravatar-properties
 @vindex gnus-gravatar-properties
-List of image properties applied to Gravatar images.
+List of image properties applied to Gravatar images (@pxref{Image
+Descriptors,,, elisp, The Emacs Lisp Reference Manual}).
 
 @item gnus-gravatar-too-ugly
 @vindex gnus-gravatar-too-ugly
-Regexp that matches mail addresses or names of people of which avatars
-should not be displayed, or @code{nil}.  It default to the value of
-@code{gnus-article-x-face-too-ugly} (@pxref{X-Face}).
+Regexp that matches mail addresses or names of people whose avatars
+should not be displayed, or @code{nil} to display all avatars.  It
+defaults to the value of @code{gnus-article-x-face-too-ugly}
+(@pxref{X-Face}).
 
 @end table
 
-If you want to see them in the From field, set:
+If you want to see gravatars in the From field, set:
+
 @lisp
 (setq gnus-treat-from-gravatar 'head)
 @end lisp
diff --git a/etc/NEWS b/etc/NEWS
index 5378e56bca..9414b3b90d 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -1714,6 +1714,19 @@ 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'.
+
 \f
 * New Modes and Packages in Emacs 27.1
 
diff --git a/lisp/gnus/gnus-gravatar.el b/lisp/gnus/gnus-gravatar.el
index d271a52f90..8c9a0b27ba 100644
--- a/lisp/gnus/gnus-gravatar.el
+++ b/lisp/gnus/gnus-gravatar.el
@@ -1,9 +1,9 @@
-;;; gnus-gravatar.el --- Gnus Gravatar support
+;;; gnus-gravatar.el --- Gnus Gravatar support -*- lexical-binding: t -*-
 
 ;; Copyright (C) 2010-2019 Free Software Foundation, Inc.
 
 ;; Author: Julien Danjou <julien@danjou.info>
-;; Keywords: news
+;; Keywords: multimedia, news
 
 ;; This file is part of GNU Emacs.
 
@@ -29,13 +29,15 @@
 (require 'mail-extr) ;; Because of binding `mail-extr-disable-voodoo'.
 
 (defgroup gnus-gravatar nil
-  "Gnus Gravatar."
+  "Gravatars in Gnus."
+  :link '(custom-group-link gravatar)
   :group 'gnus-visual)
 
 (defcustom gnus-gravatar-size nil
-  "How big should gravatars be displayed.
+  "Size in pixels at which gravatars should be displayed.
 If nil, default to `gravatar-size'."
-  :type '(choice (const nil) integer)
+  :type '(choice (const nil)
+                 (integer :tag "Pixels"))
   :version "24.1"
   :group 'gnus-gravatar)
 
@@ -46,8 +48,9 @@ gnus-gravatar-properties
   :group 'gnus-gravatar)
 
 (defcustom gnus-gravatar-too-ugly gnus-article-x-face-too-ugly
-  "Regexp matching posters whose avatar shouldn't be shown automatically."
-  :type '(choice regexp (const nil))
+  "Regexp matching posters whose avatar shouldn't be shown automatically.
+Nil means show all avatars."
+  :type '(choice regexp (const :tag "Allow all" nil))
   :version "24.1"
   :group 'gnus-gravatar)
 
@@ -73,56 +76,57 @@ gnus-gravatar-transform-address
 	  (ignore-errors
 	    (gravatar-retrieve
 	     (cadr address)
-	     'gnus-gravatar-insert
+             #'gnus-gravatar-insert
 	     (list header address category))))))))
 
 (defun gnus-gravatar-insert (gravatar header address category)
   "Insert GRAVATAR for ADDRESS in HEADER in current article buffer.
-Set image category to CATEGORY."
+Set image category to CATEGORY.  This function is intended as a
+callback for `gravatar-retrieve'."
   (unless (eq gravatar 'error)
     (gnus-with-article-buffer
-      (let ((mark (point-marker))
-	    (inhibit-point-motion-hooks t)
-	    (case-fold-search t))
-	(save-restriction
-	  (article-narrow-to-head)
-	  ;; The buffer can be gone at this time
-	  (when (buffer-live-p (current-buffer))
+      ;; The buffer can be gone at this time.
+      (when (buffer-name)
+        (let ((real-name (car address))
+              (mail-address (cadr address))
+              (mark (point-marker))
+              (inhibit-point-motion-hooks t)
+              (case-fold-search t))
+          (save-restriction
+            (article-narrow-to-head)
 	    (gnus-article-goto-header header)
 	    (mail-header-narrow-to-field)
-	    (let ((real-name (car address))
-		  (mail-address (cadr address)))
-	      (when (if real-name
-			(re-search-forward
-			 (concat (replace-regexp-in-string
-				  "[\t ]+" "[\t\n ]+"
-				  (regexp-quote real-name))
-				 "\\|"
-				 (regexp-quote mail-address))
-			 nil t)
-		      (search-forward mail-address nil t))
-		(goto-char (1- (match-beginning 0)))
-		;; If we're on the " quoting the name, go backward
-		(when (looking-at "[\"<]")
-		  (goto-char (1- (point))))
-		;; Do not do anything if there's already a gravatar. This can
-		;; happens 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 (memq 'gnus-gravatar (text-properties-at (point)))
-		  (let ((point (point)))
-		    (setq gravatar (append gravatar gnus-gravatar-properties))
-		    (gnus-put-image gravatar (buffer-substring (point) (1+ point)) category)
-		    (put-text-property point (point) 'gnus-gravatar address)
-		    (gnus-add-wash-type category)
-		    (gnus-add-image category gravatar)))))))
-	(goto-char (marker-position mark))))))
+            (when (if real-name
+                      (re-search-forward
+                       (concat (replace-regexp-in-string
+                                "[\t ]+" "[\t\n ]+"
+                                (regexp-quote real-name))
+                               "\\|"
+                               (regexp-quote mail-address))
+                       nil t)
+                    (search-forward mail-address nil t))
+              (goto-char (1- (match-beginning 0)))
+              ;; 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)
+                (let ((pos (point)))
+                  (setq gravatar (append gravatar gnus-gravatar-properties))
+                  (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)))))
+          (goto-char mark))))))
 
 ;;;###autoload
 (defun gnus-treat-from-gravatar (&optional force)
   "Display gravatar in the From header.
 If gravatar is already displayed, remove it."
-  (interactive (list t)) ;; When type `W D g'
+  (interactive "p") ;; When type `W D g'
   (gnus-with-article-buffer
     (if (memq 'from-gravatar gnus-article-wash-types)
 	(gnus-delete-images 'from-gravatar)
@@ -132,12 +136,12 @@ gnus-treat-from-gravatar
 (defun gnus-treat-mail-gravatar (&optional force)
   "Display gravatars in the Cc and To headers.
 If gravatars are already displayed, remove them."
-  (interactive (list t)) ;; When type `W D h'
-    (gnus-with-article-buffer
-      (if (memq 'mail-gravatar gnus-article-wash-types)
-          (gnus-delete-images 'mail-gravatar)
-	(gnus-gravatar-transform-address "cc" 'mail-gravatar force)
-	(gnus-gravatar-transform-address "to" 'mail-gravatar force))))
+  (interactive "p") ;; When type `W D h'
+  (gnus-with-article-buffer
+    (if (memq 'mail-gravatar gnus-article-wash-types)
+        (gnus-delete-images 'mail-gravatar)
+      (gnus-gravatar-transform-address "cc" 'mail-gravatar force)
+      (gnus-gravatar-transform-address "to" 'mail-gravatar force))))
 
 (provide 'gnus-gravatar)
 
diff --git a/lisp/image/gravatar.el b/lisp/image/gravatar.el
index 91da840e3a..c385a2cce7 100644
--- a/lisp/image/gravatar.el
+++ b/lisp/image/gravatar.el
@@ -1,9 +1,9 @@
-;;; gravatar.el --- Get Gravatars
+;;; gravatar.el --- Get Gravatars -*- lexical-binding: t -*-
 
 ;; Copyright (C) 2010-2019 Free Software Foundation, Inc.
 
 ;; Author: Julien Danjou <julien@danjou.info>
-;; Keywords: news
+;; Keywords: comm, multimedia
 
 ;; This file is part of GNU Emacs.
 
@@ -26,10 +26,11 @@
 
 (require 'url)
 (require 'url-cache)
-(require 'image)
+(eval-when-compile
+  (require 'subr-x))
 
 (defgroup gravatar nil
-  "Gravatar."
+  "Gravatars."
   :version "24.1"
   :group 'comm)
 
@@ -38,113 +39,155 @@ gravatar-automatic-caching
   :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."
-  :type '(repeat integer)
+(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.  The default value is 30 days."
+  :type 'integer
+  ;; Restricted :type to number of seconds.
+  :version "27.1"
   :group 'gravatar)
 
-;; FIXME Doc is tautological.  What are the options?
 (defcustom gravatar-rating "g"
-  "Default rating for gravatar."
-  :type 'string
+  "Most explicit Gravatar rating level to allow.
+Some gravatars are rated according to how suitable they are for
+different audiences.  The supported rating levels are, in order
+of increasing explicitness, the following:
+
+\"g\"  - Suitable for any audience.
+\"pg\" - May contain rude gestures, provocatively dressed
+       individuals, mild profanity, or mild violence.
+\"r\"  - May contain harsh profanity, intense violence, nudity,
+       or hard drug use.
+\"x\"  - May contain hardcore sexual imagery or extremely
+       disturbing violence.
+
+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 '(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
-  "Default size in pixels for gravatars."
-  :type 'integer
+  "Gravatar size in pixels to request.
+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)
-  "Create a hash from MAIL-ADDRESS."
-  (md5 (downcase mail-address)))
+  "Return the Gravatar hash for MAIL-ADDRESS."
+  ;; 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))
-
-(defun gravatar-cache-expired (url)
-  "Check if URL is cached for more than `gravatar-cache-ttl'."
-  (cond (url-standalone-mode
-         (not (file-exists-p (url-cache-create-filename url))))
-        (t (let ((cache-time (url-is-cached url)))
-             (if cache-time
-                 (time-less-p (time-add cache-time gravatar-cache-ttl) nil)
-               t)))))
+          (gravatar--query-string)))
 
 (defun gravatar-get-data ()
-  "Get data from current buffer."
+  "Return body of current URL buffer, or nil on failure."
   (save-excursion
     (goto-char (point-min))
-    (when (re-search-forward "^HTTP/.+ 200 OK$" nil (line-end-position))
-      (when (search-forward "\n\n" nil t)
-        (buffer-substring (point) (point-max))))))
-
-(defun gravatar-data->image ()
-  "Get data of current buffer and return an image.
-If no image available, return 'error."
-  (let ((data (gravatar-get-data)))
-    (if data
-	(create-image data nil t)
-      'error)))
-
-(autoload 'help-function-arglist "help-fns")
+    (and (re-search-forward "^HTTP/.+ 200 OK$" nil (line-end-position))
+         (search-forward "\n\n" nil t)
+         (buffer-substring (point) (point-max)))))
 
 ;;;###autoload
-(defun gravatar-retrieve (mail-address cb &optional cbargs)
-  "Retrieve MAIL-ADDRESS gravatar and call CB on retrieval.
-You can provide a list of argument to pass to CB in CBARGS."
+(defun gravatar-retrieve (mail-address callback &optional cbargs)
+  "Asynchronously retrieve a gravatar for MAIL-ADDRESS.
+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 (gravatar-cache-expired url)
-	(let ((args (list url
-			  'gravatar-retrieved
-			  (list cb (when cbargs cbargs)))))
-	  (when (> (length (help-function-arglist 'url-retrieve))
-                   4)
-	    (setq args (nconc args (list t))))
-	  (apply #'url-retrieve args))
-      (apply cb
-               (with-temp-buffer
-                 (set-buffer-multibyte nil)
-                 (url-cache-extract (url-cache-create-filename url))
-                 (gravatar-data->image))
-               cbargs))))
+    (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)
-  "Retrieve MAIL-ADDRESS gravatar and returns it."
+  "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)))
-    (if (gravatar-cache-expired url)
-        (with-current-buffer (url-retrieve-synchronously url)
-	  (when gravatar-automatic-caching
-            (url-store-in-cache (current-buffer)))
-          (let ((data (gravatar-data->image)))
-            (kill-buffer (current-buffer))
-            data))
-      (with-temp-buffer
-        (set-buffer-multibyte nil)
-        (url-cache-extract (url-cache-create-filename url))
-        (gravatar-data->image)))))
-
+    (with-current-buffer (if (url-cache-expired url gravatar-cache-ttl)
+                             (url-retrieve-synchronously url t)
+                           (url-fetch-from-cache url))
+      (gravatar-retrieved () #'identity))))
 
 (defun gravatar-retrieved (status cb &optional cbargs)
-  "Callback function used by `gravatar-retrieve'."
-  ;; Store gravatar?
-  (when gravatar-automatic-caching
-    (url-store-in-cache (current-buffer)))
-  (if (plist-get status :error)
-      ;; Error happened.
-      (apply cb 'error cbargs)
-    (apply cb (gravatar-data->image) cbargs))
-  (kill-buffer (current-buffer)))
+  "Handle Gravatar response data in current buffer.
+Intended as a callback for `url-retrieve'."
+  (let ((data (unless (plist-get status :error)
+                (gravatar-get-data))))
+    ;; Only cache on success and if `url-current-object' is non-nil,
+    ;; which indicates current buffer is not already cached.
+    (and data gravatar-automatic-caching url-current-object
+         (url-store-in-cache))
+    (prog1 (apply cb (if data (create-image data nil t) 'error) cbargs)
+      (kill-buffer))))
 
 (provide 'gravatar)
 
diff --git a/test/lisp/image/gravatar-tests.el b/test/lisp/image/gravatar-tests.el
new file mode 100644
index 0000000000..bd61663f0e
--- /dev/null
+++ b/test/lisp/image/gravatar-tests.el
@@ -0,0 +1,72 @@
+;;; gravatar-tests.el --- tests for gravatar.el -*- lexical-binding: t -*-
+
+;; Copyright (C) 2019 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.
+
+;;; Code:
+
+(require 'ert)
+(require 'gravatar)
+
+(ert-deftest gravatar-hash ()
+  "Test `gravatar-hash'."
+  (should (equal (gravatar-hash "") "d41d8cd98f00b204e9800998ecf8427e"))
+  (let ((hash "acbd18db4cc2f85cedef654fccc4a4d8"))
+    (should (equal (gravatar-hash "foo") hash))
+    (should (equal (gravatar-hash "foo ") hash))
+    (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
-- 
2.20.1


[-- Attachment #2: Type: text/plain, Size: 147 bytes --]


The attached patch adds support for more Gravatar features, improves
existing docs, and reduces some code duplication.  WDYT?

Thanks,

-- 
Basil

^ permalink raw reply related	[flat|nested] 11+ messages in thread
end of thread, other threads:[~2019-08-02 13:45 UTC | newest]

Thread overview: 11+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2019-07-22 13:23 [PATCH] Improve Gravatar support Basil L. Contovounesios
2019-07-22 13:31 ` Lars Ingebrigtsen
2019-07-22 21:44   ` Basil L. Contovounesios
2019-07-23 11:29     ` Lars Ingebrigtsen
2019-07-22 13:39 ` Andy Moreton
2019-07-22 21:42   ` Basil L. Contovounesios
2019-07-23  2:31     ` Eli Zaretskii
2019-07-23  8:36       ` Basil L. Contovounesios
2019-07-23  8:36     ` Andy Moreton
2019-07-23  9:18       ` Basil L. Contovounesios
2019-08-02 13:45     ` Basil L. Contovounesios

Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/emacs.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).