From: "Basil L. Contovounesios" <contovob@tcd.ie>
To: emacs-devel@gnu.org
Cc: Julien Danjou <julien@danjou.info>, Lars Ingebrigtsen <larsi@gnus.org>
Subject: [PATCH] Improve Gravatar support
Date: Mon, 22 Jul 2019 14:23:53 +0100 [thread overview]
Message-ID: <87muh6w6c6.fsf@tcd.ie> (raw)
[-- 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
next reply other threads:[~2019-07-22 13:23 UTC|newest]
Thread overview: 11+ messages / expand[flat|nested] mbox.gz Atom feed top
2019-07-22 13:23 Basil L. Contovounesios [this message]
2019-07-22 13:31 ` [PATCH] Improve Gravatar support 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
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=87muh6w6c6.fsf@tcd.ie \
--to=contovob@tcd.ie \
--cc=emacs-devel@gnu.org \
--cc=julien@danjou.info \
--cc=larsi@gnus.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this external index
https://git.savannah.gnu.org/cgit/emacs.git
https://git.savannah.gnu.org/cgit/emacs/org-mode.git
This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.