1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
|
;;; gravatar.el --- Get Gravatars
;; Copyright (C) 2010-2015 Free Software Foundation, Inc.
;; Author: Julien Danjou <julien@danjou.info>
;; Keywords: news
;; 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 <http://www.gnu.org/licenses/>.
;;; Commentary:
;;; Code:
(require 'url)
(require 'url-cache)
(defgroup gravatar nil
"Gravatar."
:version "24.1"
:group 'comm)
(defcustom gravatar-automatic-caching t
"Whether to cache retrieved gravatars."
: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)
:group 'gravatar)
;; FIXME Doc is tautological. What are the options?
(defcustom gravatar-rating "g"
"Default rating for gravatar."
:type 'string
:group 'gravatar)
(defcustom gravatar-size 32
"Default size in pixels for gravatars."
:type 'integer
:group 'gravatar)
(defconst gravatar-base-url
"http://www.gravatar.com/avatar"
"Base URL for getting gravatars.")
(defun gravatar-hash (mail-address)
"Create an hash from MAIL-ADDRESS."
(md5 (downcase mail-address)))
(defun gravatar-build-url (mail-address)
"Return an URL to retrieve MAIL-ADDRESS gravatar."
(format "%s/%s?d=404&r=%s&s=%d"
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)
(current-time))
t)))))
(defun gravatar-get-data ()
"Get data from current buffer."
(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))))))
(eval-and-compile
(cond ((featurep 'xemacs)
(require 'gnus-xmas)
(defalias 'gravatar-create-image 'gnus-xmas-create-image))
((featurep 'gnus-ems)
(defalias 'gravatar-create-image 'gnus-create-image))
(t
(require 'image)
(defalias 'gravatar-create-image 'create-image))))
(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
(gravatar-create-image data nil t)
'error)))
(autoload 'help-function-arglist "help-fns")
;;;###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."
(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 (if (featurep 'xemacs)
(cdr (split-string (function-arglist 'url-retrieve)))
(help-function-arglist 'url-retrieve)))
4)
(setq args (nconc args (list t))))
(apply #'url-retrieve args))
(apply cb
(with-temp-buffer
(mm-disable-multibyte)
(url-cache-extract (url-cache-create-filename url))
(gravatar-data->image))
cbargs))))
;;;###autoload
(defun gravatar-retrieve-synchronously (mail-address)
"Retrieve MAIL-ADDRESS gravatar and returns it."
(let ((url (gravatar-build-url mail-address)))
(if (gravatar-cache-expired url)
(with-current-buffer (if (featurep 'xemacs)
(url-retrieve url)
(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
(mm-disable-multibyte)
(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?
(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)))
(provide 'gravatar)
;;; gravatar.el ends here
|
