mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2024-12-22 10:26:20 +00:00
4d2226bff0
2014-03-14 Katsumi Yamaoka <yamaoka@jpl.org> * gnus-sum.el (gnus-summary-toggle-header): Display header attachment buttons when toggling the header off. 2014-03-07 Daiki Ueno <ueno@gnu.org> * mml2015.el (mml2015-use): Don't check the availability of GnuPG commands here; instead, only check if epg-config.el is available. 2014-03-06 Lars Ingebrigtsen <larsi@gnus.org> * mml.el (mml-expand-html-into-multipart-related): Allow sending HTML messages with embedded images. (mml-generate-mime): Don't bug out if you don't have libxml. 2014-03-06 Lars Ingebrigtsen <larsi@gnus.org> * message.el (message-make-html-message-with-image-files): New command. 2014-03-05 Lars Ingebrigtsen <larsi@gnus.org> * mml.el (mml-insert-mime-headers): Allow `recipient-filename'. 2014-02-23 David Engster <deng@randomsample.de> * auth-source.el (auth-source-netrc-saver): Do not depend on `cl-lib' to stay compatible with older Emacsen, so replace `cl-loop' with `loop'. 2014-02-17 Katsumi Yamaoka <yamaoka@jpl.org> * gnus-art.el (gnus-article-prepare, gnus-article-prepare-display): Display header attachment buttons by gnus-article-prepare-display rather than gnus-article-prepare so as to view in mml-preview as well. 2014-02-10 Katsumi Yamaoka <yamaoka@jpl.org> * gnus-art.el (gnus-article-goto-part): Find a button in the body first. (gnus-mime-buttonize-attachments-in-header): Number hidden buttons. 2014-02-07 Katsumi Yamaoka <yamaoka@jpl.org> * gnus-art.el (gnus-mime-buttonize-attachments-in-header): Display buttons that are hidden in unselected alternative part as well. (gnus-mime-display-alternative): Redraw attachment buttons in header. * gmm-utils.el (gmm-labels): Add edebug spec. 2014-02-07 Lars Ingebrigtsen <larsi@gnus.org> * gnus-srvr.el (gnus-server-toggle-cloud-server): New command and keystroke. (gnus-server-toggle-cloud-server): Only allow clouding applicable types. 2014-02-05 Katsumi Yamaoka <yamaoka@jpl.org> * gnus.el (gnus-copy-overlay, gnus-overlays-at): New functions. * gnus-art.el (gnus-mime-display-attachment-buttons-in-header): New user option. (gnus-mime-buttonize-attachments-in-header): New function. (gnus-article-prepare): Use it. (gnus-mime-inline-part): Suppress extra newline. (gnus-mm-display-part): Save excursion; remove useless deleting and adding of buttons. (gnus-insert-mime-button): Allow insertion in the middle of a line. * gnus-sum.el (gnus-summary-wash-mime-map, gnus-summary-article-menu): Add gnus-mime-buttonize-attachments-in-header. 2014-02-05 Lars Ingebrigtsen <larsi@gnus.org> * nnimap.el (nnimap-request-articles): New command to download several articles at once. * gnus.el (gnus-variable-list): Save Cloud variables. 2014-02-01 Lars Ingebrigtsen <larsi@gnus.org> * gnus-cloud.el: New file to provide the Emacs Cloud. * gravatar.el (gravatar-retrieve-synchronously): XEmacs also has `url-retrieve-synchronously', apparently. * gnus-notifications.el (gravatar-retrieve-synchronously): Declare for XEmacs. * nnrss.el (libxml-parse-html-region): Silence compilation error. 2014-02-01 Daniel Dehennin <daniel.dehennin@baby-gnu.org> * gnus-mlspl.el (gnus-group-split-fancy): Use `gnus-parameters' in `gnus-group-split-fancy'. 2014-02-01 Lars Ingebrigtsen <larsi@gnus.org> * message.el (message-remove-header): Doc fix. (message-forward-included-headers): New variable. (message-remove-ignored-headers): Use it. 2014-01-31 Dave Abrahams <dave@boostpro.com> * gnus-sum.el (gnus-summary-open-group-with-article): New command. 2013-09-04 Rasmus Pank Roulund <emacs@pank.eu> * gnus-fun.el (gnus-x-face-omit-files): Regexp to omit matched results from random face commands. (gnus-face-directory): Like `gnus-x-face-directory` for png files and Face. (gnus-face-omit-files): Like `gnus-x-face-omit-files` for Face. (gnus--random-face-with-type): Generic function returning a face-type as a string. (gnus--insert-random-face-with-type): Generic function inserting a face in a message buffer header. (gnus-random-x-face): Rewritten to use `gnus--random-face-with-type`. (gnus-insert-random-x-face-header): Rewritten to use `gnus--insert-random-face-with-type`. (gnus-random-face): Return random (png) Face as string. (nus-insert-random-face-header): Insert random (png) Face in a message buffer. 2014-01-31 Lars Ingebrigtsen <larsi@gnus.org> * mm-url.el: Remove all usage of w3. * nnrss.el: Ditto. * mm-decode.el: Ditto. * mm-view.el: Ditto. * gnus-setup.el: Remove outdated file.
167 lines
5.0 KiB
EmacsLisp
167 lines
5.0 KiB
EmacsLisp
;;; gravatar.el --- Get Gravatars
|
|
|
|
;; Copyright (C) 2010-2014 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 (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
|