+2010-09-24 Julien Danjou <julien@danjou.info>
+
+ * 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 <larsi@gnus.org>
* gnus-sum.el (gnus-summary-fetch-faq): Removed.
: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)
(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
--- /dev/null
+;;; gnus-gravatar.el --- Gnus Gravatar support
+
+;; Copyright (C) 2010 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 '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
"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
["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
--- /dev/null
+;;; gravatar.el --- Get Gravatars
+
+;; Copyright (C) 2010 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 '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
+2010-09-24 Julien Danjou <julien@danjou.info>
+
+ * gnus.texi: Add Gravatars.
+
2010-09-23 Lars Magne Ingebrigtsen <larsi@gnus.org>
* gnus.texi (Startup Variables): Mention gnus-use-backend-marks.
* 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.
* 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
@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.
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.
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
@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
@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)
* 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
@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
projects / gnus / commitdiff