diff options
| author | Basil L. Contovounesios | 2019-07-22 21:48:45 +0100 |
|---|---|---|
| committer | Basil L. Contovounesios | 2019-08-02 16:33:30 +0300 |
| commit | b4b1eda7fbf4c4f3fa6377bd18d1d1a22e6e4b42 (patch) | |
| tree | 3b827b0cd5491f2d853f9ea0d325f0457c344ad3 | |
| parent | cf569e520ee080b5a913d37d363a5ab5fc38d982 (diff) | |
| download | emacs-b4b1eda7fbf4c4f3fa6377bd18d1d1a22e6e4b42.tar.gz emacs-b4b1eda7fbf4c4f3fa6377bd18d1d1a22e6e4b42.zip | |
Fix some minor gravatar.el issues
For discussion, see the following thread:
https://lists.gnu.org/archive/html/emacs-devel/2019-07/msg00528.html
* lisp/image/gravatar.el (gravatar-hash): Trim leading and trailing
whitespace in given address, as per the Gravatar docs.
(gravatar-retrieve-synchronously): Silence call to
url-retrieve-synchronously for consistency with gravatar-retrieve.
(gravatar-retrieved): Only cache buffer on successful retrieval.
* test/lisp/image/gravatar-tests.el: New file.
| -rw-r--r-- | lisp/image/gravatar.el | 12 | ||||
| -rw-r--r-- | test/lisp/image/gravatar-tests.el | 34 |
2 files changed, 42 insertions, 4 deletions
diff --git a/lisp/image/gravatar.el b/lisp/image/gravatar.el index fb539bcdbdc..52fd875d68c 100644 --- a/lisp/image/gravatar.el +++ b/lisp/image/gravatar.el | |||
| @@ -26,6 +26,8 @@ | |||
| 26 | 26 | ||
| 27 | (require 'url) | 27 | (require 'url) |
| 28 | (require 'url-cache) | 28 | (require 'url-cache) |
| 29 | (eval-when-compile | ||
| 30 | (require 'subr-x)) | ||
| 29 | 31 | ||
| 30 | (defgroup gravatar nil | 32 | (defgroup gravatar nil |
| 31 | "Gravatars." | 33 | "Gravatars." |
| @@ -76,8 +78,9 @@ Valid sizes range from 1 to 2048 inclusive." | |||
| 76 | "Base URL for getting gravatars.") | 78 | "Base URL for getting gravatars.") |
| 77 | 79 | ||
| 78 | (defun gravatar-hash (mail-address) | 80 | (defun gravatar-hash (mail-address) |
| 79 | "Create a hash from MAIL-ADDRESS." | 81 | "Return the Gravatar hash for MAIL-ADDRESS." |
| 80 | (md5 (downcase mail-address))) | 82 | ;; https://gravatar.com/site/implement/hash/ |
| 83 | (md5 (downcase (string-trim mail-address)))) | ||
| 81 | 84 | ||
| 82 | (defun gravatar-build-url (mail-address) | 85 | (defun gravatar-build-url (mail-address) |
| 83 | "Return a URL to retrieve MAIL-ADDRESS gravatar." | 86 | "Return a URL to retrieve MAIL-ADDRESS gravatar." |
| @@ -114,7 +117,7 @@ Value is either an image descriptor, or the symbol `error' if the | |||
| 114 | retrieval failed." | 117 | retrieval failed." |
| 115 | (let ((url (gravatar-build-url mail-address))) | 118 | (let ((url (gravatar-build-url mail-address))) |
| 116 | (with-current-buffer (if (url-cache-expired url gravatar-cache-ttl) | 119 | (with-current-buffer (if (url-cache-expired url gravatar-cache-ttl) |
| 117 | (url-retrieve-synchronously url) | 120 | (url-retrieve-synchronously url t) |
| 118 | (url-fetch-from-cache url)) | 121 | (url-fetch-from-cache url)) |
| 119 | (gravatar-retrieved () #'identity)))) | 122 | (gravatar-retrieved () #'identity)))) |
| 120 | 123 | ||
| @@ -125,7 +128,8 @@ an image descriptor, or the symbol `error' on failure. | |||
| 125 | This function is intended as a callback for `url-retrieve'." | 128 | This function is intended as a callback for `url-retrieve'." |
| 126 | (let ((data (unless (plist-get status :error) | 129 | (let ((data (unless (plist-get status :error) |
| 127 | (gravatar-get-data)))) | 130 | (gravatar-get-data)))) |
| 128 | (and url-current-object ; Only cache if not already cached. | 131 | (and data ; Only cache on success. |
| 132 | url-current-object ; Only cache if not already cached. | ||
| 129 | gravatar-automatic-caching | 133 | gravatar-automatic-caching |
| 130 | (url-store-in-cache)) | 134 | (url-store-in-cache)) |
| 131 | (prog1 (apply cb (if data (create-image data nil t) 'error) cbargs) | 135 | (prog1 (apply cb (if data (create-image data nil t) 'error) cbargs) |
diff --git a/test/lisp/image/gravatar-tests.el b/test/lisp/image/gravatar-tests.el new file mode 100644 index 00000000000..e6239da0084 --- /dev/null +++ b/test/lisp/image/gravatar-tests.el | |||
| @@ -0,0 +1,34 @@ | |||
| 1 | ;;; gravatar-tests.el --- tests for gravatar.el -*- lexical-binding: t -*- | ||
| 2 | |||
| 3 | ;; Copyright (C) 2019 Free Software Foundation, Inc. | ||
| 4 | |||
| 5 | ;; This file is part of GNU Emacs. | ||
| 6 | |||
| 7 | ;; GNU Emacs is free software: you can redistribute it and/or modify | ||
| 8 | ;; it under the terms of the GNU General Public License as published by | ||
| 9 | ;; the Free Software Foundation, either version 3 of the License, or | ||
| 10 | ;; (at your option) any later version. | ||
| 11 | |||
| 12 | ;; GNU Emacs is distributed in the hope that it will be useful, | ||
| 13 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | ||
| 14 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
| 15 | ;; GNU General Public License for more details. | ||
| 16 | |||
| 17 | ;; You should have received a copy of the GNU General Public License | ||
| 18 | ;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. | ||
| 19 | |||
| 20 | ;;; Code: | ||
| 21 | |||
| 22 | (require 'ert) | ||
| 23 | (require 'gravatar) | ||
| 24 | |||
| 25 | (ert-deftest gravatar-hash () | ||
| 26 | "Test `gravatar-hash'." | ||
| 27 | (should (equal (gravatar-hash "") "d41d8cd98f00b204e9800998ecf8427e")) | ||
| 28 | (let ((hash "acbd18db4cc2f85cedef654fccc4a4d8")) | ||
| 29 | (should (equal (gravatar-hash "foo") hash)) | ||
| 30 | (should (equal (gravatar-hash "foo ") hash)) | ||
| 31 | (should (equal (gravatar-hash " foo") hash)) | ||
| 32 | (should (equal (gravatar-hash " foo ") hash)))) | ||
| 33 | |||
| 34 | ;;; gravatar-tests.el ends here | ||