From: "Basil L. Contovounesios" <contovob@tcd.ie>
To: Andy Moreton <andrewjmoreton@gmail.com>
Cc: emacs-devel@gnu.org
Subject: Re: [PATCH] Improve Gravatar support
Date: Mon, 22 Jul 2019 22:42:27 +0100 [thread overview]
Message-ID: <878ssp6918.fsf@tcd.ie> (raw)
In-Reply-To: <vz1imruxk71.fsf@gmail.com> (Andy Moreton's message of "Mon, 22 Jul 2019 14:39:14 +0100")
[-- Attachment #1: Type: text/plain, Size: 561 bytes --]
Andy Moreton <andrewjmoreton@gmail.com> writes:
> On Mon 22 Jul 2019, Basil L. Contovounesios wrote:
>
>> The attached patch adds support for more Gravatar features, improves
>> existing docs, and reduces some code duplication. WDYT?
>
> This patch seems to mix three things:
> - conversion to lexical binding
> - minor bugfixes
> - new features
>
> It is better to put each in a separate patch, to ease later bisection if
> needed.
More often I see reviewers express the opposite feeling here, but since
I don't personally mind and you asked so nicely:
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Clarify-Gravatar-docs.patch --]
[-- Type: text/x-diff, Size: 6216 bytes --]
From 8445814d560b2ecbd7423c41b6fb492772a6a98f Mon Sep 17 00:00:00 2001
From: "Basil L. Contovounesios" <contovob@tcd.ie>
Date: Mon, 22 Jul 2019 21:14:18 +0100
Subject: [PATCH 1/5] Clarify Gravatar docs
For discussion, see the following thread:
https://lists.gnu.org/archive/html/emacs-devel/2019-07/msg00528.html
* doc/misc/gnus.texi (X-Face): Fix cross-reference.
(Gravatars):
* lisp/gnus/gnus-gravatar.el (gnus-gravatar-too-ugly):
* lisp/image/gravatar.el (gravatar-cache-ttl, gravatar-rating)
(gravatar-size): Clarify user option descriptions.
(gravatar-retrieve, gravatar-retrieve-synchronously): Document
return value.
---
doc/misc/gnus.texi | 26 +++++++++++++++-----------
lisp/gnus/gnus-gravatar.el | 3 ++-
lisp/image/gravatar.el | 35 ++++++++++++++++++++++++++++-------
3 files changed, 45 insertions(+), 19 deletions(-)
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/lisp/gnus/gnus-gravatar.el b/lisp/gnus/gnus-gravatar.el
index d271a52f90..19cbf529c6 100644
--- a/lisp/gnus/gnus-gravatar.el
+++ b/lisp/gnus/gnus-gravatar.el
@@ -46,7 +46,8 @@ 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."
+ "Regexp matching posters whose avatar shouldn't be shown automatically.
+If nil, show all avatars."
:type '(choice regexp (const nil))
:version "24.1"
:group 'gnus-gravatar)
diff --git a/lisp/image/gravatar.el b/lisp/image/gravatar.el
index 91da840e3a..9a1ec3b556 100644
--- a/lisp/image/gravatar.el
+++ b/lisp/image/gravatar.el
@@ -40,18 +40,35 @@ gravatar-automatic-caching
;; 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."
+ "Time to live for gravatar cache entries.
+If a requested gravatar has been cached for longer than this, it
+is retrieved anew."
:type '(repeat integer)
:group 'gravatar)
-;; FIXME Doc is tautological. What are the options?
(defcustom gravatar-rating "g"
- "Default rating for gravatar."
+ "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 'string
:group 'gravatar)
(defcustom gravatar-size 32
- "Default size in pixels for gravatars."
+ "Gravatar size in pixels to request.
+Valid sizes range from 1 to 2048 inclusive."
:type 'integer
:group 'gravatar)
@@ -100,8 +117,10 @@ gravatar-data->image
;;;###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."
+ "Asynchronously retrieve a gravatar for MAIL-ADDRESS.
+When finished, call CB as (apply CB 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
@@ -120,7 +139,9 @@ gravatar-retrieve
;;;###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)
--
2.20.1
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: 0002-Use-lexical-binding-for-Gravatar-support.patch --]
[-- Type: text/x-diff, Size: 11643 bytes --]
From 2fc7925abe4cfdf6db32439f066b8b3f3fa33e2c Mon Sep 17 00:00:00 2001
From: "Basil L. Contovounesios" <contovob@tcd.ie>
Date: Mon, 22 Jul 2019 22:06:22 +0100
Subject: [PATCH 2/5] Use lexical-binding for Gravatar support
For discussion, see the following thread:
https://lists.gnu.org/archive/html/emacs-devel/2019-07/msg00528.html
* lisp/gnus/gnus-gravatar.el: Use lexical-binding. Link custom
group 'gnus-gravatar' to 'gravatar'.
(gnus-gravatar-size, gnus-gravatar-too-ugly): Doc fix.
(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-expired): Remove. Change all callers to use
url-cache-expired instead.
(gravatar-get-data, gravatar-retrieve)
(gravatar-retrieve-synchronously): Simplify.
---
lisp/gnus/gnus-gravatar.el | 101 +++++++++++++++++++------------------
lisp/image/gravatar.el | 60 +++++++---------------
2 files changed, 71 insertions(+), 90 deletions(-)
diff --git a/lisp/gnus/gnus-gravatar.el b/lisp/gnus/gnus-gravatar.el
index 19cbf529c6..ec3f909161 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 :tag "Default" nil)
+ (integer :tag "Pixels"))
:version "24.1"
:group 'gnus-gravatar)
@@ -48,7 +50,7 @@ gnus-gravatar-properties
(defcustom gnus-gravatar-too-ugly gnus-article-x-face-too-ugly
"Regexp matching posters whose avatar shouldn't be shown automatically.
If nil, show all avatars."
- :type '(choice regexp (const nil))
+ :type '(choice regexp (const :tag "Allow all" nil))
:version "24.1"
:group 'gnus-gravatar)
@@ -74,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-live-p (current-buffer))
+ (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")
(gnus-with-article-buffer
(if (memq 'from-gravatar gnus-article-wash-types)
(gnus-delete-images 'from-gravatar)
@@ -133,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")
+ (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 9a1ec3b556..ea746b71d7 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,9 @@
(require 'url)
(require 'url-cache)
-(require 'image)
(defgroup gravatar nil
- "Gravatar."
+ "Gravatars."
:version "24.1"
:group 'comm)
@@ -88,22 +87,13 @@ gravatar-build-url
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)))))
-
(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))))))
+ (and (re-search-forward "^HTTP/.+ 200 OK$" nil (line-end-position))
+ (search-forward "\n\n" nil t)
+ (buffer-substring (point) (point-max)))))
(defun gravatar-data->image ()
"Get data of current buffer and return an image.
@@ -113,29 +103,20 @@ gravatar-data->image
(create-image data nil t)
'error)))
-(autoload 'help-function-arglist "help-fns")
-
;;;###autoload
-(defun gravatar-retrieve (mail-address cb &optional cbargs)
+(defun gravatar-retrieve (mail-address callback &optional cbargs)
"Asynchronously retrieve a gravatar for MAIL-ADDRESS.
-When finished, call CB as (apply CB GRAVATAR CBARGS),
+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)
+ (apply callback
+ (with-temp-buffer
+ (url-cache-extract (url-cache-create-filename url))
+ (gravatar-data->image))
+ cbargs))))
;;;###autoload
(defun gravatar-retrieve-synchronously (mail-address)
@@ -143,19 +124,16 @@ gravatar-retrieve-synchronously
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)
+ (if (url-cache-expired url gravatar-cache-ttl)
(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))
+ (prog1 (gravatar-data->image)
+ (kill-buffer (current-buffer))))
(with-temp-buffer
- (set-buffer-multibyte nil)
(url-cache-extract (url-cache-create-filename url))
(gravatar-data->image)))))
-
(defun gravatar-retrieved (status cb &optional cbargs)
"Callback function used by `gravatar-retrieve'."
;; Store gravatar?
--
2.20.1
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #4: 0003-DRY-in-gravatar.el.patch --]
[-- Type: text/x-diff, Size: 3846 bytes --]
From f1326ea96d656d507c2017080356684523a28cdc Mon Sep 17 00:00:00 2001
From: "Basil L. Contovounesios" <contovob@tcd.ie>
Date: Mon, 22 Jul 2019 21:49:47 +0100
Subject: [PATCH 3/5] DRY in gravatar.el
For discussion, see the following thread:
https://lists.gnu.org/archive/html/emacs-devel/2019-07/msg00528.html
* lisp/image/gravatar.el (gravatar-data->image): Remove.
(gravatar-retrieve, gravatar-retrieve-synchronously): Reuse
url-fetch-from-cache and gravatar-retrieved to reduce duplication.
(gravatar-retrieved): Only cache buffer if url-current-object is
non-nil and return result of callback. This affords reusing this
function in cached URL buffers.
---
lisp/image/gravatar.el | 48 +++++++++++++++---------------------------
1 file changed, 17 insertions(+), 31 deletions(-)
diff --git a/lisp/image/gravatar.el b/lisp/image/gravatar.el
index ea746b71d7..fb539bcdbd 100644
--- a/lisp/image/gravatar.el
+++ b/lisp/image/gravatar.el
@@ -95,14 +95,6 @@ gravatar-get-data
(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
(defun gravatar-retrieve (mail-address callback &optional cbargs)
"Asynchronously retrieve a gravatar for MAIL-ADDRESS.
@@ -112,11 +104,8 @@ gravatar-retrieve
(let ((url (gravatar-build-url mail-address)))
(if (url-cache-expired url gravatar-cache-ttl)
(url-retrieve url #'gravatar-retrieved (list callback cbargs) t)
- (apply callback
- (with-temp-buffer
- (url-cache-extract (url-cache-create-filename url))
- (gravatar-data->image))
- cbargs))))
+ (with-current-buffer (url-fetch-from-cache url)
+ (gravatar-retrieved () callback cbargs)))))
;;;###autoload
(defun gravatar-retrieve-synchronously (mail-address)
@@ -124,26 +113,23 @@ gravatar-retrieve-synchronously
Value is either an image descriptor, or the symbol `error' if the
retrieval failed."
(let ((url (gravatar-build-url mail-address)))
- (if (url-cache-expired url gravatar-cache-ttl)
- (with-current-buffer (url-retrieve-synchronously url)
- (when gravatar-automatic-caching
- (url-store-in-cache (current-buffer)))
- (prog1 (gravatar-data->image)
- (kill-buffer (current-buffer))))
- (with-temp-buffer
- (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)
+ (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.
+Return the result of (apply CB DATA CBARGS), where DATA is either
+an image descriptor, or the symbol `error' on failure.
+This function is intended as a callback for `url-retrieve'."
+ (let ((data (unless (plist-get status :error)
+ (gravatar-get-data))))
+ (and url-current-object ; Only cache if not already cached.
+ gravatar-automatic-caching
+ (url-store-in-cache))
+ (prog1 (apply cb (if data (create-image data nil t) 'error) cbargs)
+ (kill-buffer))))
(provide 'gravatar)
--
2.20.1
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #5: 0004-Fix-some-minor-gravatar.el-issues.patch --]
[-- Type: text/x-diff, Size: 4108 bytes --]
From d12f5f9520153e7d0b7d2b4b9c63d1a582918e16 Mon Sep 17 00:00:00 2001
From: "Basil L. Contovounesios" <contovob@tcd.ie>
Date: Mon, 22 Jul 2019 21:48:45 +0100
Subject: [PATCH 4/5] 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.
---
lisp/image/gravatar.el | 12 +++++++----
test/lisp/image/gravatar-tests.el | 34 +++++++++++++++++++++++++++++++
2 files changed, 42 insertions(+), 4 deletions(-)
create mode 100644 test/lisp/image/gravatar-tests.el
diff --git a/lisp/image/gravatar.el b/lisp/image/gravatar.el
index fb539bcdbd..52fd875d68 100644
--- a/lisp/image/gravatar.el
+++ b/lisp/image/gravatar.el
@@ -26,6 +26,8 @@
(require 'url)
(require 'url-cache)
+(eval-when-compile
+ (require 'subr-x))
(defgroup gravatar nil
"Gravatars."
@@ -76,8 +78,9 @@ gravatar-base-url
"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-build-url (mail-address)
"Return a URL to retrieve MAIL-ADDRESS gravatar."
@@ -114,7 +117,7 @@ gravatar-retrieve-synchronously
retrieval failed."
(let ((url (gravatar-build-url mail-address)))
(with-current-buffer (if (url-cache-expired url gravatar-cache-ttl)
- (url-retrieve-synchronously url)
+ (url-retrieve-synchronously url t)
(url-fetch-from-cache url))
(gravatar-retrieved () #'identity))))
@@ -125,7 +128,8 @@ gravatar-retrieved
This function is intended as a callback for `url-retrieve'."
(let ((data (unless (plist-get status :error)
(gravatar-get-data))))
- (and url-current-object ; Only cache if not already cached.
+ (and data ; Only cache on success.
+ url-current-object ; Only cache if not already cached.
gravatar-automatic-caching
(url-store-in-cache))
(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 0000000000..e6239da008
--- /dev/null
+++ b/test/lisp/image/gravatar-tests.el
@@ -0,0 +1,34 @@
+;;; 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))))
+
+;;; gravatar-tests.el ends here
--
2.20.1
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #6: 0005-Make-gravatar.el-more-configurable.patch --]
[-- Type: text/x-diff, Size: 8552 bytes --]
From 2f39a42e469c28a86e8f76e0f73e05c7c017bc85 Mon Sep 17 00:00:00 2001
From: "Basil L. Contovounesios" <contovob@tcd.ie>
Date: Mon, 22 Jul 2019 21:57:39 +0100
Subject: [PATCH 5/5] 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.
---
etc/NEWS | 16 ++++++
lisp/image/gravatar.el | 82 ++++++++++++++++++++++++++-----
test/lisp/image/gravatar-tests.el | 38 ++++++++++++++
3 files changed, 123 insertions(+), 13 deletions(-)
diff --git a/etc/NEWS b/etc/NEWS
index 5378e56bca..a7590aac00 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -1714,6 +1714,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'.
+
\f
* New Modes and Packages in Emacs 27.1
diff --git a/lisp/image/gravatar.el b/lisp/image/gravatar.el
index 52fd875d68..e235fdd76f 100644
--- a/lisp/image/gravatar.el
+++ b/lisp/image/gravatar.el
@@ -39,12 +39,13 @@ 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.
+(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 @@ gravatar-rating
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 @@ gravatar-hash
;; 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 e6239da008..bd61663f0e 100644
--- a/test/lisp/image/gravatar-tests.el
+++ b/test/lisp/image/gravatar-tests.el
@@ -31,4 +31,42 @@ gravatar-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 #7: Type: text/plain, Size: 256 bytes --]
Since the first patch only touches existing documentation, it could even
be applied to emacs-26. Eli?
The other patches also address Lars' initial feedback:
https://lists.gnu.org/archive/html/emacs-devel/2019-07/msg00529.html
WDYT?
Thanks,
--
Basil
next prev parent reply other threads:[~2019-07-22 21:42 UTC|newest]
Thread overview: 11+ messages / expand[flat|nested] mbox.gz Atom feed top
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 [this message]
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=878ssp6918.fsf@tcd.ie \
--to=contovob@tcd.ie \
--cc=andrewjmoreton@gmail.com \
--cc=emacs-devel@gnu.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.