X-Git-Url: http://cgit.sxemacs.org/?a=blobdiff_plain;ds=sidebyside;f=lisp%2Fgravatar.el;h=ffbc37ae15887748346f35d7c2aa433a5434dc4d;hb=588b80f005a762584b71ddc93961a8db19cca6ab;hp=e6c18f74cd5d7530018a090a3ece06ec34ca6181;hpb=8de732a4fa3a98465ee38dc7490d3f4297784921;p=gnus

diff --git a/lisp/gravatar.el b/lisp/gravatar.el
index e6c18f74c..ffbc37ae1 100644
--- a/lisp/gravatar.el
+++ b/lisp/gravatar.el
@@ -1,6 +1,6 @@
 ;;; gravatar.el --- Get Gravatars
 
-;; Copyright (C) 2010 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2014 Free Software Foundation, Inc.
 
 ;; Author: Julien Danjou <julien@danjou.info>
 ;; Keywords: news
@@ -24,28 +24,34 @@
 
 ;;; Code:
 
-(require 'image)
 (require 'url)
 (require 'url-cache)
 
 (defgroup gravatar nil
   "Gravatar."
+  :version "24.1"
   :group 'comm)
 
 (defcustom gravatar-automatic-caching t
-  "Whether cache retrieved gravatar."
+  "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
@@ -79,10 +85,11 @@
 
 (defun gravatar-get-data ()
   "Get data from current buffer."
-  (when (string-match "^HTTP/.+ 200 OK$"
-                      (buffer-substring (point-min) (line-end-position)))
-    (when (search-forward "\n\n" nil t)
-      (buffer-substring (point) (point-max)))))
+  (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)
@@ -99,18 +106,26 @@
 If no image available, return 'error."
   (let ((data (gravatar-get-data)))
     (if data
-	(gravatar-create-image data  nil t)
+	(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)
-        (url-retrieve url
-                      'gravatar-retrieved
-                      (list cb (when cbargs cbargs)))
+	(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)
@@ -118,6 +133,23 @@ You can provide a list of argument to pass to CB in CBARGS."
                  (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 (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?
@@ -126,7 +158,8 @@ You can provide a list of argument to pass to CB in CBARGS."
   (if (plist-get status :error)
       ;; Error happened.
       (apply cb 'error cbargs)
-    (apply cb (gravatar-data->image) cbargs)))
+    (apply cb (gravatar-data->image) cbargs))
+  (kill-buffer (current-buffer)))
 
 (provide 'gravatar)