1 ;;; gravatar.el --- Get Gravatars
3 ;; Copyright (C) 2010 Free Software Foundation, Inc.
5 ;; Author: Julien Danjou <julien@danjou.info>
8 ;; This file is part of GNU Emacs.
10 ;; GNU Emacs is free software: you can redistribute it and/or modify
11 ;; it under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation, either version 3 of the License, or
13 ;; (at your option) any later version.
15 ;; GNU Emacs is distributed in the hope that it will be useful,
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 ;; GNU General Public License for more details.
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
31 (defgroup gravatar nil
35 (defcustom gravatar-automatic-caching t
36 "Whether cache retrieved gravatar."
39 (defcustom gravatar-cache-ttl (days-to-time 30)
40 "Time to live for gravatar cache entries."
43 (defcustom gravatar-rating "g"
44 "Default rating for gravatar."
47 (defcustom gravatar-size 32
48 "Default size in pixels for gravatars."
51 (defconst gravatar-base-url
52 "http://www.gravatar.com/avatar"
53 "Base URL for getting gravatars.")
55 (defun gravatar-hash (mail-address)
56 "Create an hash from MAIL-ADDRESS."
57 (md5 (downcase mail-address)))
59 (defun gravatar-build-url (mail-address)
60 "Return an URL to retrieve MAIL-ADDRESS gravatar."
61 (format "%s/%s?d=404&r=%s&s=%d"
63 (gravatar-hash mail-address)
67 (defun gravatar-cache-expired (url)
68 "Check if URL is cached for more than `gravatar-cache-ttl'."
69 (cond (url-standalone-mode
70 (not (file-exists-p (url-cache-create-filename url))))
71 (t (let ((cache-time (url-is-cached url)))
80 (defun gravatar-get-data ()
81 "Get data from current buffer."
82 (when (string-match "^HTTP/.+ 200 OK$"
83 (buffer-substring (point-min) (line-end-position)))
84 (when (search-forward "\n\n" nil t)
85 (buffer-substring (point) (point-max)))))
88 (cond ((featurep 'xemacs)
90 (defalias 'gravatar-create-image 'gnus-xmas-create-image))
92 (defalias 'gravatar-create-image 'gnus-create-image))
95 (defalias 'gravatar-create-image 'create-image))))
97 (defun gravatar-data->image ()
98 "Get data of current buffer and return an image.
99 If no image available, return 'error."
100 (let ((data (gravatar-get-data)))
102 (gravatar-create-image data nil t)
106 (defun gravatar-retrieve (mail-address cb &optional cbargs)
107 "Retrieve MAIL-ADDRESS gravatar and call CB on retrieval.
108 You can provide a list of argument to pass to CB in CBARGS."
109 (let ((url (gravatar-build-url mail-address)))
110 (if (gravatar-cache-expired url)
113 (list cb (when cbargs cbargs)))
116 (mm-disable-multibyte)
117 (url-cache-extract (url-cache-create-filename url))
118 (gravatar-data->image))
121 (defun gravatar-retrieved (status cb &optional cbargs)
122 "Callback function used by `gravatar-retrieve'."
124 (when gravatar-automatic-caching
125 (url-store-in-cache (current-buffer)))
126 (if (plist-get status :error)
128 (apply cb 'error cbargs)
129 (apply cb (gravatar-data->image) cbargs)))
133 ;;; gravatar.el ends here