From mboxrd@z Thu Jan 1 00:00:00 1970 X-Msuck: nntp://news.gmane.io/gmane.emacs.gnus.general/71649 Path: news.gmane.org!not-for-mail From: Julien Danjou Newsgroups: gmane.emacs.gnus.general Subject: [PATCH] Add Gravatar support Date: Fri, 24 Sep 2010 19:13:56 +0200 Message-ID: <1285348436-7582-2-git-send-email-julien@danjou.info> References: <1285348436-7582-1-git-send-email-julien@danjou.info> NNTP-Posting-Host: lo.gmane.org X-Trace: dough.gmane.org 1285348520 17529 80.91.229.12 (24 Sep 2010 17:15:20 GMT) X-Complaints-To: usenet@dough.gmane.org NNTP-Posting-Date: Fri, 24 Sep 2010 17:15:20 +0000 (UTC) Cc: Julien Danjou To: ding@gnus.org Original-X-From: ding-owner+M20022@lists.math.uh.edu Fri Sep 24 19:15:18 2010 Return-path: Envelope-to: ding-account@gmane.org Original-Received: from util0.math.uh.edu ([129.7.128.18]) by lo.gmane.org with esmtp (Exim 4.69) (envelope-from ) id 1OzBri-0000JL-7y for ding-account@gmane.org; Fri, 24 Sep 2010 19:15:18 +0200 Original-Received: from localhost ([127.0.0.1] helo=lists.math.uh.edu) by util0.math.uh.edu with smtp (Exim 4.63) (envelope-from ) id 1OzBrh-0006fU-6s; Fri, 24 Sep 2010 12:15:17 -0500 Original-Received: from mx1.math.uh.edu ([129.7.128.32]) by util0.math.uh.edu with esmtps (TLSv1:AES256-SHA:256) (Exim 4.63) (envelope-from ) id 1OzBre-0006f9-Qv for ding@lists.math.uh.edu; Fri, 24 Sep 2010 12:15:14 -0500 Original-Received: from quimby.gnus.org ([80.91.231.51]) by mx1.math.uh.edu with esmtp (Exim 4.72) (envelope-from ) id 1OzBra-0007nH-33 for ding@lists.math.uh.edu; Fri, 24 Sep 2010 12:15:14 -0500 Original-Received: from prometheus.naquadah.org ([212.85.154.174] helo=mx1.naquadah.org) by quimby.gnus.org with esmtp (Exim 3.36 #1 (Debian)) id 1OzBrZ-0004aS-00 for ; Fri, 24 Sep 2010 19:15:09 +0200 Original-Received: by mx1.naquadah.org (Postfix, from userid 8) id C7A8F5C0EF; Fri, 24 Sep 2010 19:14:35 +0200 (CEST) X-Spam-Checker-Version: SpamAssassin 3.3.1 (2010-03-16) on prometheus.naquadah.org X-Spam-Level: X-Spam-Status: No, score=-2.9 required=4.5 tests=ALL_TRUSTED,BAYES_00 autolearn=ham version=3.3.1 Original-Received: from keller.adm.naquadah.org (unknown [IPv6:2a01:e35:2e39:e900:222:faff:fe9d:ce44]) (using TLSv1 with cipher AES256-SHA (256/256 bits)) (No client certificate requested) by mx1.naquadah.org (Postfix) with ESMTPSA id 0BE355C0F2; Fri, 24 Sep 2010 19:14:30 +0200 (CEST) Original-Received: from jd by keller.adm.naquadah.org with local (Exim 4.72) (envelope-from ) id 1OzBqv-00025h-Dm; Fri, 24 Sep 2010 19:14:29 +0200 X-Mailer: git-send-email 1.7.1 In-Reply-To: <1285348436-7582-1-git-send-email-julien@danjou.info> X-Spam-Score: -1.9 (-) List-ID: Precedence: bulk Xref: news.gmane.org gmane.emacs.gnus.general:71649 Archived-At: Signed-off-by: Julien Danjou --- lisp/ChangeLog | 10 ++++ lisp/gnus-art.el | 34 +++++++++++++- lisp/gnus-gravatar.el | 112 ++++++++++++++++++++++++++++++++++++++++++++ lisp/gnus-sum.el | 6 ++- lisp/gravatar.el | 123 +++++++++++++++++++++++++++++++++++++++++++++++++ texi/ChangeLog | 4 ++ texi/gnus.texi | 70 +++++++++++++++++++++++++++- 7 files changed, 355 insertions(+), 4 deletions(-) create mode 100644 lisp/gnus-gravatar.el create mode 100644 lisp/gravatar.el diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 9733760..c19c5cd 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,13 @@ +2010-09-24 Julien Danjou + + * gnus-sum.el: Add support for Gravatars. + + * gnus-art.el: Add support for Gravatars. + + * gnus-gravatar.el: Add this file. + + * gravatar.el: Add this file. + 2010-09-24 Lars Magne Ingebrigtsen * nnimap.el (nnimap-command): Register the last command time so diff --git a/lisp/gnus-art.el b/lisp/gnus-art.el index d92d29d..231f9e9 100644 --- a/lisp/gnus-art.el +++ b/lisp/gnus-art.el @@ -1529,10 +1529,40 @@ node `(gnus)Picons' for details." :type gnus-article-treat-head-custom) (put 'gnus-treat-newsgroups-picon 'highlight t) +(defcustom gnus-treat-from-gravatar + (when (display-images-p) 'head) + "Display gravatars in the From header. +Valid values are nil, t, `head', `first', `last', an integer or a +predicate. See Info node `(gnus)Customizing Articles' and Info +node `(gnus)Gravatars' for details." + :version "24.1" + :group 'gnus-article-treat + :group 'gnus-gravatar + :link '(custom-manual "(gnus)Customizing Articles") + :link '(custom-manual "(gnus)Gravatars") + :type gnus-article-treat-head-custom) +(put 'gnus-treat-from-gravatar 'highlight t) + +(defcustom gnus-treat-mail-gravatar + (when (display-images-p) 'head) + "Display gravatars in To and Cc headers. +Valid values are nil, t, `head', `first', `last', an integer or a +predicate. See Info node `(gnus)Customizing Articles' and Info +node `(gnus)Gravatars' for details." + :version "24.1" + :group 'gnus-article-treat + :group 'gnus-gravatar + :link '(custom-manual "(gnus)Customizing Articles") + :link '(custom-manual "(gnus)Gravatars") + :type gnus-article-treat-head-custom) +(put 'gnus-treat-mail-gravatar 'highlight t) + (defcustom gnus-treat-body-boundary (if (or gnus-treat-newsgroups-picon gnus-treat-mail-picon - gnus-treat-from-picon) + gnus-treat-from-picon + gnus-treat-from-gravatar + gnus-treat-mail-gravatar) ;; If there's much decoration, the user might prefer a boundery. 'head nil) @@ -1669,6 +1699,8 @@ This requires GNU Libidn, and by default only enabled if it is found." (gnus-treat-from-picon gnus-treat-from-picon) (gnus-treat-mail-picon gnus-treat-mail-picon) (gnus-treat-newsgroups-picon gnus-treat-newsgroups-picon) + (gnus-treat-from-gravatar gnus-treat-from-gravatar) + (gnus-treat-mail-gravatar gnus-treat-mail-gravatar) (gnus-treat-highlight-headers gnus-article-highlight-headers) (gnus-treat-highlight-signature gnus-article-highlight-signature) (gnus-treat-strip-trailing-blank-lines diff --git a/lisp/gnus-gravatar.el b/lisp/gnus-gravatar.el new file mode 100644 index 0000000..6b97a54 --- /dev/null +++ b/lisp/gnus-gravatar.el @@ -0,0 +1,112 @@ +;;; gnus-gravatar.el --- Gnus Gravatar support + +;; Copyright (C) 2010 Free Software Foundation, Inc. + +;; Author: Julien Danjou +;; 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 . + +;;; Commentary: + +;;; Code: + +(require 'gravatar) + +(defgroup gnus-gravatar nil + "Gnus Gravatar." + :group 'gnus-visual) + +(defcustom gnus-gravatar-size 32 + "How big should gravatars be displayed." + :type 'integer + :group 'gnus-gravatar) + +(defcustom gnus-gravatar-relief 1 + "If non-nil, adds a shadow rectangle around the image. The +value, relief, specifies the width of the shadow lines, in +pixels. If relief is negative, shadows are drawn so that the +image appears as a pressed button; otherwise, it appears as an +unpressed button." + :group 'gnus-gravatar) + +(defun gnus-gravatar-transform-address (header category) + (gnus-with-article-headers + (let ((addresses + (mail-header-parse-addresses + ;; mail-header-parse-addresses does not work (reliably) on + ;; decoded headers. + (or + (ignore-errors + (mail-encode-encoded-word-string + (or (mail-fetch-field header) ""))) + (mail-fetch-field header))))) + (dolist (address addresses) + (gravatar-retrieve + (car address) + 'gnus-gravatar-insert + (list header (car 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." + (unless (eq gravatar 'error) + (gnus-with-article-headers + (gnus-article-goto-header header) + (mail-header-narrow-to-field) + (when (and (search-forward address nil t) + (or (search-backward ", " nil t) + (search-backward ": " nil t))) + (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 ((inhibit-read-only t) + (point (point)) + (gravatar (append + gravatar + `(:ascent center :relief ,gnus-gravatar-relief)))) + (gnus-put-image gravatar nil category) + (put-text-property point (point) 'gnus-gravatar address) + (gnus-add-wash-type category) + (gnus-add-image category gravatar))))))) + +;;;###autoload +(defun gnus-treat-from-gravatar () + "Display gravatar in the From header. +If gravatar is already displayed, remove it." + (interactive) + (gnus-with-article-buffer + (if (memq 'from-gravatar gnus-article-wash-types) + (gnus-delete-images 'from-gravatar) + (gnus-gravatar-transform-address "from" 'from-gravatar)))) + +;;;###autoload +(defun gnus-treat-mail-gravatar () + "Display gravatars in the Cc and To headers. +If gravatars are already displayed, remove them." + (interactive) + (gnus-with-article-buffer + (if (memq 'mail-gravatar gnus-article-wash-types) + (gnus-delete-images 'mail-gravatar) + (gnus-gravatar-transform-address "cc" 'mail-gravatar) + (gnus-gravatar-transform-address "to" 'mail-gravatar)))) + +(provide 'gnus-gravatar) + +;;; gnus-gravatar.el ends here diff --git a/lisp/gnus-sum.el b/lisp/gnus-sum.el index 50f9b32..062a2be 100644 --- a/lisp/gnus-sum.el +++ b/lisp/gnus-sum.el @@ -2124,7 +2124,9 @@ increase the score of each group you read." "W" gnus-html-show-images "f" gnus-treat-from-picon "m" gnus-treat-mail-picon - "n" gnus-treat-newsgroups-picon) + "n" gnus-treat-newsgroups-picon + "g" gnus-treat-from-gravatar + "h" gnus-treat-mail-gravatar) (gnus-define-keys (gnus-summary-wash-mime-map "M" gnus-summary-wash-map) "w" gnus-article-decode-mime-words @@ -2374,6 +2376,8 @@ increase the score of each group you read." ["Show picons in From" gnus-treat-from-picon t] ["Show picons in mail headers" gnus-treat-mail-picon t] ["Show picons in news headers" gnus-treat-newsgroups-picon t] + ["Show Gravatars in From" gnus-treat-from-gravatar t] + ["Show Gravatars in mail headers" gnus-treat-mail-gravatar t] ("View as different encoding" ,@(gnus-summary-menu-split (mapcar diff --git a/lisp/gravatar.el b/lisp/gravatar.el new file mode 100644 index 0000000..ec03b1b --- /dev/null +++ b/lisp/gravatar.el @@ -0,0 +1,123 @@ +;;; gravatar.el --- Get Gravatars + +;; Copyright (C) 2010 Free Software Foundation, Inc. + +;; Author: Julien Danjou +;; 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 . + +;;; Commentary: + +;;; Code: + +(require 'image) +(require 'url) +(require 'url-cache) + +(defgroup gravatar nil + "Gravatar." + :group 'comm) + +(defcustom gravatar-automatic-caching t + "Whether cache retrieved gravatar." + :group 'gravatar) + +(defcustom gravatar-cache-ttl (days-to-time 30) + "Time to live for gravatar cache entries." + :group 'gravatar) + +(defcustom gravatar-rating "g" + "Default rating for gravatar." + :group 'gravatar) + +(defcustom gravatar-size 32 + "Default size in pixels for gravatars." + :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." + (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))))) + +(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 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))) + (apply cb + (with-temp-buffer + (mm-disable-multibyte) + (url-cache-extract (url-cache-create-filename url)) + (gravatar-data->image)) + cbargs)))) + +(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))) + +(provide 'gravatar) + +;;; gravatar.el ends here diff --git a/texi/ChangeLog b/texi/ChangeLog index 17022dd..5cedf17 100644 --- a/texi/ChangeLog +++ b/texi/ChangeLog @@ -1,3 +1,7 @@ +2010-09-24 Julien Danjou + + * gnus.texi: Add Gravatars. + 2010-09-23 Lars Magne Ingebrigtsen * gnus.texi (Startup Variables): Mention gnus-use-backend-marks. diff --git a/texi/gnus.texi b/texi/gnus.texi index 7f20f96..678a1e7 100644 --- a/texi/gnus.texi +++ b/texi/gnus.texi @@ -589,7 +589,7 @@ Article Treatment * Article Buttons:: Click on URLs, Message-IDs, addresses and the like. * Article Button Levels:: Controlling appearance of buttons. * Article Date:: Grumble, UT! -* Article Display:: Display various stuff---X-Face, Picons, Smileys +* Article Display:: Display various stuff---X-Face, Picons, Smileys, Gravatars * Article Signature:: What is a signature? * Article Miscellanea:: Various other stuff. @@ -9255,7 +9255,8 @@ these articles easier. * Article Buttons:: Click on URLs, Message-IDs, addresses and the like. * Article Button Levels:: Controlling appearance of buttons. * Article Date:: Grumble, UT! -* Article Display:: Display various stuff---X-Face, Picons, Smileys +* Article Display:: Display various stuff: + X-Face, Picons, Gravatars, Smileys. * Article Signature:: What is a signature? * Article Miscellanea:: Various other stuff. @end menu @@ -10299,6 +10300,7 @@ preferred format automatically. @cindex picons @cindex x-face @cindex smileys +@cindex gravatars These commands add various frivolous display gimmicks to the article buffer in Emacs versions that support them. @@ -10315,6 +10317,9 @@ their messages with (@pxref{Smileys}). Picons, on the other hand, reside on your own system, and Gnus will try to match the headers to what you have (@pxref{Picons}). +Gravatars reside on-line and are fetched from +@uref{http://www.gravatar.com/} (@pxref{Gravatars}). + All these functions are toggles---if the elements already exist, they'll be removed. @@ -10353,6 +10358,17 @@ Piconify all mail headers (i. e., @code{Cc}, @code{To}) Piconify all news headers (i. e., @code{Newsgroups} and @code{Followup-To}) (@code{gnus-treat-newsgroups-picon}). +@item W D g +@kindex W D g (Summary) +@findex gnus-treat-from-gravatar +Gravatarify the @code{From} header (@code{gnus-treat-from-gravatar}). + +@item W D h +@kindex W D h (Summary) +@findex gnus-treat-mail-gravatar +Gravatarify all mail headers (i. e., @code{Cc}, @code{To}) +(@code{gnus-treat-from-gravatar}). + @item W D D @kindex W D D (Summary) @findex gnus-article-remove-images @@ -12631,6 +12647,8 @@ controlling variable is a predicate list, as described above. @vindex gnus-treat-from-picon @vindex gnus-treat-mail-picon @vindex gnus-treat-newsgroups-picon +@vindex gnus-treat-from-gravatar +@vindex gnus-treat-mail-gravatar @vindex gnus-treat-display-smileys @vindex gnus-treat-body-boundary @vindex gnus-treat-display-x-face @@ -12697,6 +12715,11 @@ possible but those listed are probably sufficient for most people. @xref{Picons}. +@item gnus-treat-from-gravatar (head) +@item gnus-treat-mail-gravatar (head) + +@xref{Gravatars}. + @item gnus-treat-display-smileys (t, integer) @item gnus-treat-body-boundary (head) @@ -23709,6 +23732,7 @@ stuff, so Gnus has taken advantage of that. * Face:: Display a funkier, teensier colored image. * Smileys:: Show all those happy faces the way they were meant to be shown. * Picons:: How to display pictures of what you're reading. +* Gravatars:: Display the avatar of people you read. * XVarious:: Other XEmacsy Gnusey variables. @end menu @@ -24037,6 +24061,48 @@ Ordered list of suffixes on picon file names to try. Defaults to @end table +@node Gravatars +@subsection Gravatars + +@iftex +@iflatex +\include{gravatars} +@end iflatex +@end iftex + +A gravatar is an image registered to an e-mail address. + +You can submit yours on-line at @uref{http://www.gravatar.com}. + +The following variables offer control over how things are displayed. + +@table @code + +@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. + +@item gnus-gravatar-relief +@vindex gnus-gravatar-relief +If non-nil, adds a shadow rectangle around the image. The value, +relief, specifies the width of the shadow lines, in pixels. If relief +is negative, shadows are drawn so that the image appears as a pressed +button; otherwise, it appears as an unpressed button. + +@end table + +If you want to see them in the From field, set: +@lisp +(setq gnus-treat-from-gravatar 'head) +@end lisp + +If you want to see them in the Cc and To fields, set: + +@lisp +(setq gnus-treat-mail-gravatar 'head) +@end lisp + @node XVarious @subsection Various XEmacs Variables -- 1.7.1