Mercurial > emacs
changeset 110555:e07971bb896c
Merge changes made in Gnus trunk.
gnus.el (gnus-sloppily-equal-method-parameters): Avoid cl.el convenience functions.
nnrss.el (nnrss-retrieve-groups): Change to the group before checking its data structures.
nnimap.el (nnimap-split-incoming-mail): Fix paren typo in the 'junk handling.
starttls.el: (starttls-open-stream): Add autoload cookie.
nnimap.el (nnimap-command): Register the last command time so that we can use it for idling NOOPs.
nnimap.el: Implement IMAP keepalive.
gnus-cache.el (gnus-cache-braid-heads): When braiding heads, don't use the same article number for all the cached articles.
nnimap.el (nnimap-update-info): Protect against nil uidnexts.
gnus-group.el: Remove the outdated archive group stuff, which no longer works.
gnus-group.el, gnus.el: Remove the outdated charter support.
gnus-sum.el, gnus-group.el, gnus.el: Remove outdated support for FAQ fetching.
gnus-gravatar.el, gravatar.el: New files.
author | Katsumi Yamaoka <yamaoka@jpl.org> |
---|---|
date | Fri, 24 Sep 2010 22:33:34 +0000 |
parents | e49fcbdc458f |
children | 310fef3bdbbb |
files | doc/misc/gnus.texi lisp/gnus/ChangeLog lisp/gnus/gnus-art.el lisp/gnus/gnus-cache.el lisp/gnus/gnus-gravatar.el lisp/gnus/gnus-group.el lisp/gnus/gnus-sum.el lisp/gnus/gnus.el lisp/gnus/gravatar.el lisp/gnus/nnimap.el lisp/gnus/nnrss.el lisp/gnus/starttls.el |
diffstat | 12 files changed, 452 insertions(+), 250 deletions(-) [+] |
line wrap: on
line diff
--- a/doc/misc/gnus.texi Fri Sep 24 15:30:13 2010 -0400 +++ b/doc/misc/gnus.texi Fri Sep 24 22:33:34 2010 +0000 @@ -589,7 +589,7 @@ * 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. @@ -2616,18 +2616,6 @@ @findex gnus-group-make-help-group Make the Gnus help group (@code{gnus-group-make-help-group}). -@item G a -@kindex G a (Group) -@cindex (ding) archive -@cindex archive group -@findex gnus-group-make-archive-group -@vindex gnus-group-archive-directory -@vindex gnus-group-recent-archive-directory -Make a Gnus archive group (@code{gnus-group-make-archive-group}). By -default a group pointing to the most recent articles will be created -(@code{gnus-group-recent-archive-directory}), but given a prefix, a full -group will be created from @code{gnus-group-archive-directory}. - @item G D @kindex G D (Group) @findex gnus-group-enter-directory @@ -5222,19 +5210,6 @@ If fetching from the first site is unsuccessful, Gnus will attempt to go through @code{gnus-group-faq-directory} and try to open them one by one. -@item H c -@kindex H c (Group) -@findex gnus-group-fetch-charter -@vindex gnus-group-charter-alist -@cindex charter -Try to open the charter for the current group in a web browser -(@code{gnus-group-fetch-charter}). Query for a group if given a -prefix argument. - -Gnus will use @code{gnus-group-charter-alist} to find the location of -the charter. If no location is known, Gnus will fetch the control -messages for the group, which in some cases includes the charter. - @item H C @kindex H C (Group) @findex gnus-group-fetch-control @@ -9255,7 +9230,8 @@ * 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 +10275,7 @@ @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 +10292,9 @@ 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 +10333,17 @@ 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 @@ -11561,18 +11552,6 @@ @table @kbd -@item H f -@kindex H f (Summary) -@findex gnus-summary-fetch-faq -@vindex gnus-group-faq-directory -Try to fetch the @acronym{FAQ} (list of frequently asked questions) -for the current group (@code{gnus-summary-fetch-faq}). Gnus will try -to get the @acronym{FAQ} from @code{gnus-group-faq-directory}, which -is usually a directory on a remote machine. This variable can also be -a list of directories. In that case, giving a prefix to this command -will allow you to choose between the various sites. @code{ange-ftp} -or @code{efs} will probably be used for fetching the file. - @item H d @kindex H d (Summary) @findex gnus-summary-describe-group @@ -12631,6 +12610,8 @@ @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 +12678,11 @@ @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 +23695,7 @@ * 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 +24024,48 @@ @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
--- a/lisp/gnus/ChangeLog Fri Sep 24 15:30:13 2010 -0400 +++ b/lisp/gnus/ChangeLog Fri Sep 24 22:33:34 2010 +0000 @@ -1,3 +1,57 @@ +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. + + * gnus-group.el (gnus-group-fetch-faq): Removed. + + * gnus.el (gnus-group-faq-directory): Removed. + + * gnus-group.el (gnus-group-fetch-charter): Removed. + + * gnus.el (gnus-group-charter-alist): Removed. + + * gnus-group.el (gnus-group-archive-directory): Removed. + (gnus-group-recent-archive-directory): Ditto. + (gnus-group-make-archive-group): Removed. + + * nnimap.el (nnimap-update-info): Protect against nil uidnexts. + + * gnus-cache.el (gnus-cache-braid-heads): When braiding heads, don't + use the same article number for all the cached articles. + + * nnimap.el (nnimap-command): Register the last command time so + that we can use it for idling NOOPs. + (nnimap-open-connection): Start the keeplive timer. + (nnimap-make-process-buffer): Store all the process buffers. + (nnimap-keepalive): New function. + + * starttls.el: (starttls-open-stream): Add autoload cookie. + +2010-09-24 Michael Welsh Duggan <md5i@md5i.com> (tiny change) + + * nnimap.el (nnimap-split-incoming-mail): Fix paren typo in the 'junk + handling. + +2010-09-24 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * nnrss.el (nnrss-retrieve-groups): Change to the group before checking + its data structures. + + * gnus.el (gnus-sloppily-equal-method-parameters): Use copy-sequence + instead of the cl.el copy-list. + (gnus-sloppily-equal-method-parameters): Use equal instead of the cl + equalp. + 2010-09-24 Katsumi Yamaoka <yamaoka@jpl.org> * gmm-utils.el (gmm-tool-bar-from-list): Always use tool-bar-local-item
--- a/lisp/gnus/gnus-art.el Fri Sep 24 15:30:13 2010 -0400 +++ b/lisp/gnus/gnus-art.el Fri Sep 24 22:33:34 2010 +0000 @@ -1529,10 +1529,40 @@ :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 @@ (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
--- a/lisp/gnus/gnus-cache.el Fri Sep 24 15:30:13 2010 -0400 +++ b/lisp/gnus/gnus-cache.el Fri Sep 24 22:33:34 2010 +0000 @@ -603,7 +603,7 @@ (insert-file-contents (gnus-cache-file-name group entry))) (goto-char (point-min)) (insert "220 ") - (princ (car cached) (current-buffer)) + (princ (pop cached) (current-buffer)) (insert " Article retrieved.\n") (search-forward "\n\n" nil 'move) (delete-region (point) (point-max))
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/gnus/gnus-gravatar.el Fri Sep 24 22:33:34 2010 +0000 @@ -0,0 +1,112 @@ +;;; 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
--- a/lisp/gnus/gnus-group.el Fri Sep 24 15:30:13 2010 -0400 +++ b/lisp/gnus/gnus-group.el Fri Sep 24 22:33:34 2010 +0000 @@ -55,18 +55,6 @@ (autoload 'gnus-agent-total-fetched-for "gnus-agent") (autoload 'gnus-cache-total-fetched-for "gnus-cache") -(defcustom gnus-group-archive-directory - "/ftp@ftp.hpc.uh.edu:/pub/emacs/ding-list/" - "*The address of the (ding) archives." - :group 'gnus-group-foreign - :type 'directory) - -(defcustom gnus-group-recent-archive-directory - "/ftp@ftp.hpc.uh.edu:/pub/emacs/ding-list-recent/" - "*The address of the most recent (ding) articles." - :group 'gnus-group-foreign - :type 'directory) - (defcustom gnus-no-groups-message "No Gnus is good news" "*Message displayed by Gnus when no groups are available." :group 'gnus-start @@ -657,7 +645,6 @@ "d" gnus-group-make-directory-group "h" gnus-group-make-help-group "u" gnus-group-make-useful-group - "a" gnus-group-make-archive-group "l" gnus-group-nnimap-edit-acl "m" gnus-group-make-group "E" gnus-group-edit-group @@ -752,10 +739,8 @@ "e" gnus-score-edit-all-score) (gnus-define-keys (gnus-group-help-map "H" gnus-group-mode-map) - "c" gnus-group-fetch-charter "C" gnus-group-fetch-control "d" gnus-group-describe-group - "f" gnus-group-fetch-faq "v" gnus-version) (gnus-define-keys (gnus-group-sub-map "S" gnus-group-mode-map) @@ -821,11 +806,6 @@ ["Describe" gnus-group-describe-group :active (gnus-group-group-name) ,@(if (featurep 'xemacs) nil '(:help "Display description of the current group"))] - ["Fetch FAQ" gnus-group-fetch-faq (gnus-group-group-name)] - ["Fetch charter" gnus-group-fetch-charter - :active (gnus-group-group-name) - ,@(if (featurep 'xemacs) nil - '(:help "Display the charter of the current group"))] ["Fetch control message" gnus-group-fetch-control :active (gnus-group-group-name) ,@(if (featurep 'xemacs) nil @@ -925,7 +905,6 @@ ["Make a foreign group..." gnus-group-make-group t] ["Add a directory group..." gnus-group-make-directory-group t] ["Add the help group" gnus-group-make-help-group t] - ["Add the archive group" gnus-group-make-archive-group t] ["Make a doc group..." gnus-group-make-doc-group t] ["Make a web group..." gnus-group-make-web-group t] ["Make a virtual group..." gnus-group-make-empty-virtual t] @@ -3089,22 +3068,6 @@ (nnrss-save-server-data nil)) (error "No feeds found for %s" url)))) -(defun gnus-group-make-archive-group (&optional all) - "Create the (ding) Gnus archive group of the most recent articles. -Given a prefix, create a full group." - (interactive "P") - (let ((group (gnus-group-prefixed-name - (if all "ding.archives" "ding.recent") '(nndir "")))) - (when (gnus-group-entry group) - (error "Archive group already exists")) - (gnus-group-make-group - (gnus-group-real-name group) - (list 'nndir (if all "hpc" "edu") - (list 'nndir-directory - (if all gnus-group-archive-directory - gnus-group-recent-archive-directory)))) - (gnus-group-add-parameter group (cons 'to-address "ding@gnus.org")))) - (defun gnus-group-make-directory-group (dir) "Create an nndir group. The user will be prompted for a directory. The contents of this @@ -4049,62 +4012,6 @@ (gnus-summary-position-point) ret)) -(defun gnus-group-fetch-faq (group &optional faq-dir) - "Fetch the FAQ for the current group. -If given a prefix argument, prompt for the FAQ dir -to use." - (interactive - (list - (gnus-group-group-name) - (when current-prefix-arg - (completing-read - "FAQ dir: " (and (listp gnus-group-faq-directory) - (mapcar #'list - gnus-group-faq-directory)))))) - (unless group - (error "No group name given")) - (let ((dirs (or faq-dir gnus-group-faq-directory)) - dir found file) - (unless (listp dirs) - (setq dirs (list dirs))) - (while (and (not found) - (setq dir (pop dirs))) - (let ((name (gnus-group-real-name group))) - (setq file (expand-file-name name dir))) - (if (not (file-exists-p file)) - (gnus-message 1 "No such file: %s" file) - (let ((enable-local-variables nil)) - (find-file file) - (setq found t)))))) - -(defun gnus-group-fetch-charter (group) - "Fetch the charter for the current group. -If given a prefix argument, prompt for a group." - (interactive - (list (or (when current-prefix-arg - (gnus-group-completing-read "Group: ")) - (gnus-group-group-name) - gnus-newsgroup-name))) - (unless group - (error "No group name given")) - (require 'mm-url) - (condition-case nil (require 'url-http) (error nil)) - (let ((name (mm-url-form-encode-xwfu (gnus-group-real-name group))) - url hierarchy) - (when (string-match "\\(^[^\\.]+\\)\\..*" name) - (setq hierarchy (match-string 1 name)) - (if (and (setq url (cdr (assoc hierarchy gnus-group-charter-alist))) - (if (fboundp 'url-http-file-exists-p) - (url-http-file-exists-p (eval url)) - t)) - (browse-url (eval url)) - (setq url (concat "http://" hierarchy - ".news-admin.org/charters/" name)) - (if (and (fboundp 'url-http-file-exists-p) - (url-http-file-exists-p url)) - (browse-url url) - (gnus-group-fetch-control group)))))) - (defun gnus-group-fetch-control (group) "Fetch the archived control messages for the current group. If given a prefix argument, prompt for a group."
--- a/lisp/gnus/gnus-sum.el Fri Sep 24 15:30:13 2010 -0400 +++ b/lisp/gnus/gnus-sum.el Fri Sep 24 22:33:34 2010 +0000 @@ -2124,7 +2124,9 @@ "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 @@ -2154,11 +2156,9 @@ (gnus-define-keys (gnus-summary-help-map "H" gnus-summary-mode-map) "v" gnus-version - "f" gnus-summary-fetch-faq "d" gnus-summary-describe-group "h" gnus-summary-describe-briefly "i" gnus-info-find-node - "c" gnus-group-fetch-charter "C" gnus-group-fetch-control) (gnus-define-keys (gnus-summary-backend-map "B" gnus-summary-mode-map) @@ -2374,6 +2374,8 @@ ["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 @@ -2733,11 +2735,7 @@ ["Randomize" gnus-summary-sort-by-random t] ["Original sort" gnus-summary-sort-by-original t]) ("Help" - ["Fetch group FAQ" gnus-summary-fetch-faq t] ["Describe group" gnus-summary-describe-group t] - ["Fetch charter" gnus-group-fetch-charter - ,@(if (featurep 'xemacs) nil - '(:help "Display the charter of the current group"))] ["Fetch control message" gnus-group-fetch-control ,@(if (featurep 'xemacs) nil '(:help "Display the archived control message for the current group"))] @@ -5370,18 +5368,18 @@ (if (= gnus-tmp-lines -1) (setq gnus-tmp-lines "?") (setq gnus-tmp-lines (number-to-string gnus-tmp-lines))) - (gnus-put-text-property - (point) - (progn (eval gnus-summary-line-format-spec) (point)) - 'gnus-number number) - (when gnus-visual-p - (forward-line -1) - (gnus-summary-highlight-line) - (when gnus-summary-update-hook - (gnus-run-hooks 'gnus-summary-update-hook)) - (forward-line 1)) - - (setq gnus-tmp-prev-subject simp-subject))) + (gnus-put-text-property + (point) + (progn (eval gnus-summary-line-format-spec) (point)) + 'gnus-number number) + (when gnus-visual-p + (forward-line -1) + (gnus-summary-highlight-line) + (when gnus-summary-update-hook + (gnus-run-hooks 'gnus-summary-update-hook)) + (forward-line 1)) + + (setq gnus-tmp-prev-subject simp-subject))) (when (nth 1 thread) (push (list (max 0 gnus-tmp-level) @@ -7324,23 +7322,6 @@ t))) (gnus-message 3 "This dead summary is now alive again")) -;; Suggested by Andrew Eskilsson <pi92ae@pt.hk-r.se>. -(defun gnus-summary-fetch-faq (&optional faq-dir) - "Fetch the FAQ for the current group. -If FAQ-DIR (the prefix), prompt for a directory to search for the faq -in." - (interactive - (list - (when current-prefix-arg - (completing-read - "FAQ dir: " (and (listp gnus-group-faq-directory) - (mapcar 'list - gnus-group-faq-directory)))))) - (let (gnus-faq-buffer) - (when (setq gnus-faq-buffer - (gnus-group-fetch-faq gnus-newsgroup-name faq-dir)) - (gnus-configure-windows 'summary-faq)))) - ;; Suggested by Per Abrahamsen <amanda@iesd.auc.dk>. (defun gnus-summary-describe-group (&optional force) "Describe the current newsgroup."
--- a/lisp/gnus/gnus.el Fri Sep 24 15:30:13 2010 -0400 +++ b/lisp/gnus/gnus.el Fri Sep 24 22:33:34 2010 +0000 @@ -1470,75 +1470,6 @@ (nnweb "refer" (nnweb-type google))) gnus-select-method)))) -(defcustom gnus-group-faq-directory - '("/ftp@mirrors.aol.com:/pub/rtfm/usenet/" - "/ftp@sunsite.doc.ic.ac.uk:/pub/usenet/news-faqs/" - "/ftp@src.doc.ic.ac.uk:/usenet/news-FAQS/" - "/ftp@ftp.seas.gwu.edu:/pub/rtfm/" - "/ftp@ftp.pasteur.fr:/pub/FAQ/" - "/ftp@rtfm.mit.edu:/pub/usenet/" - "/ftp@ftp.uni-paderborn.de:/pub/FAQ/" - "/ftp@ftp.sunet.se:/pub/usenet/" - "/ftp@nctuccca.nctu.edu.tw:/pub/Documents/rtfm/usenet-by-group/" - "/ftp@hwarang.postech.ac.kr:/pub/usenet/" - "/ftp@ftp.hk.super.net:/mirror/faqs/") - "*Directory where the group FAQs are stored. -This will most commonly be on a remote machine, and the file will be -fetched by ange-ftp. - -This variable can also be a list of directories. In that case, the -first element in the list will be used by default. The others can -be used when being prompted for a site. - -Note that Gnus uses an aol machine as the default directory. If this -feels fundamentally unclean, just think of it as a way to finally get -something of value back from them. - -If the default site is too slow, try one of these: - - North America: mirrors.aol.com /pub/rtfm/usenet - ftp.seas.gwu.edu /pub/rtfm - rtfm.mit.edu /pub/usenet - Europe: ftp.uni-paderborn.de /pub/FAQ - src.doc.ic.ac.uk /usenet/news-FAQS - ftp.sunet.se /pub/usenet - ftp.pasteur.fr /pub/FAQ - Asia: nctuccca.nctu.edu.tw /pub/Documents/rtfm/usenet-by-group/ - hwarang.postech.ac.kr /pub/usenet - ftp.hk.super.net /mirror/faqs" - :group 'gnus-group-various - :type '(choice directory - (repeat directory))) - -(defcustom gnus-group-charter-alist - '(("no" . (concat "http://no.news-admin.org/charter/" name ".txt")) - ("de" . (concat "http://purl.net/charta/" name ".html")) - ("dk" . (concat "http://www.usenet.dk/grupper.pl?get=" name)) - ("england" . (concat "http://england.news-admin.org/charters/" name)) - ("fr" . (concat "http://www.usenet-fr.net/fur/chartes/" name ".html")) - ("europa" . (concat "http://www.europa.usenet.eu.org/chartas/charta-en-" - (gnus-replace-in-string name "europa\\." "") ".html")) - ("nl" . (concat "http://www.xs4all.nl/~sister/usenet/charters/" name)) - ("aus" . (concat "http://aus.news-admin.org/groupinfo.cgi/" name)) - ("pl" . (concat "http://www.usenet.pl/opisy/" name)) - ("ch" . (concat "http://www.use-net.ch/Usenet/charter.html#" name)) - ("at" . (concat "http://www.usenet.at/chartas/" name "/charta")) - ("uk" . (concat "http://www.usenet.org.uk/" name ".html")) - ("dfw" . (concat "http://www.cirr.com/dfw/charters/" name ".html")) - ("se" . (concat "http://www.usenet-se.net/Reglementen/" - (gnus-replace-in-string name "\\." "_") ".html")) - ("milw" . (concat "http://usenet.mil.wi.us/" - (gnus-replace-in-string name "milw\\." "") "-charter")) - ("ca" . (concat "http://www.sbay.org/ca/charter-" name ".html")) - ("netins" . (concat "http://www.netins.net/usenet/charter/" - (gnus-replace-in-string name "\\." "-") "-charter.html"))) - "*An alist of (HIERARCHY . FORM) pairs used to construct the URL of a charter. -When FORM is evaluated `name' is bound to the name of the group." - :version "22.1" - :group 'gnus-group-various - :type '(repeat (cons (string :tag "Hierarchy") (sexp :tag "Form")))) -(put 'gnus-group-charter-alist 'risky-local-variable t) - (defcustom gnus-group-fetch-control-use-browse-url nil "*Non-nil means that control messages are displayed using `browse-url'. Otherwise they are fetched with ange-ftp and displayed in an ephemeral @@ -3695,8 +3626,8 @@ (defsubst gnus-sloppily-equal-method-parameters (m1 m2) ;; Check parameters for sloppy equalness. - (let ((p1 (copy-list (cddr m1))) - (p2 (copy-list (cddr m2))) + (let ((p1 (copy-sequence (cddr m1))) + (p2 (copy-sequence (cddr m2))) e1 e2) (block nil (while (setq e1 (pop p1)) @@ -3704,7 +3635,7 @@ ;; The parameter doesn't exist in p2. (return nil)) (setq p2 (delq e2 p2)) - (unless (equalp e1 e2) + (unless (equal e1 e2) (if (not (and (stringp (cadr e1)) (stringp (cadr e2)))) (return nil)
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/gnus/gravatar.el Fri Sep 24 22:33:34 2010 +0000 @@ -0,0 +1,123 @@ +;;; 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
--- a/lisp/gnus/nnimap.el Fri Sep 24 15:30:13 2010 -0400 +++ b/lisp/gnus/nnimap.el Fri Sep 24 22:33:34 2010 +0000 @@ -90,8 +90,12 @@ (defvar nnimap-split-download-body-default nil "Internal variable with default value for `nnimap-split-download-body'.") +(defvar nnimap-keepalive-timer nil) +(defvar nnimap-process-buffers nil) + (defstruct nnimap - group process commands capabilities select-result newlinep server) + group process commands capabilities select-result newlinep server + last-command-time) (defvar nnimap-object nil) @@ -223,6 +227,7 @@ (set (make-local-variable 'nnimap-object) (make-nnimap :server (nnoo-current-server 'nnimap))) (push (list buffer (current-buffer)) nnimap-connection-alist) + (push (current-buffer) nnimap-process-buffers) (current-buffer))) (defun nnimap-open-shell-stream (name buffer host port) @@ -246,7 +251,25 @@ '("login" "password") address port nil (null ports)))) credentials)) +(defun nnimap-keepalive () + (let ((now (current-time))) + (dolist (buffer nnimap-process-buffers) + (when (buffer-name buffer) + (with-current-buffer buffer + (when (and nnimap-object + (nnimap-last-command-time nnimap-object) + (> (time-to-seconds + (time-subtract + now + (nnimap-last-command-time nnimap-object))) + ;; More than five minutes since the last command. + (* 5 60))) + (nnimap-send-command "NOOP"))))))) + (defun nnimap-open-connection (buffer) + (unless nnimap-keepalive-timer + (setq nnimap-keepalive-timer (run-at-time (* 60 15) (* 60 15) + 'nnimap-keepalive))) (with-current-buffer (nnimap-make-process-buffer buffer) (let* ((coding-system-for-read 'binary) (coding-system-for-write 'binary) @@ -801,12 +824,20 @@ (if (or completep (not (gnus-active group))) (gnus-set-active group - (if (and low high) - (cons low high) + (cond + ((and low high) + (cons low high)) + (uidnext ;; No articles in this group. - (cons uidnext (1- uidnext)))) + (cons uidnext (1- uidnext))) + (start-article + (cons start-article (1- start-article))) + (t + ;; No articles and no uidnext. + nil))) (setcdr (gnus-active group) (or high (1- uidnext)))) - (unless high + (when (and (not high) + uidnext) (setq high (1- uidnext))) ;; Then update the list of read articles. (let* ((unread @@ -986,6 +1017,7 @@ (defun nnimap-command (&rest args) (erase-buffer) + (setf (nnimap-last-command-time nnimap-object) (current-time)) (let* ((sequence (apply #'nnimap-send-command args)) (response (nnimap-get-response sequence))) (if (equal (caar response) "OK") @@ -1154,8 +1186,8 @@ ;; And then mark the successful copy actions as deleted, ;; and possibly expunge them. (nnimap-mark-and-expunge-incoming - (nnimap-parse-copied-articles sequences)) - (nnimap-mark-and-expunge-incoming junk-articles)))))))) + (nnimap-parse-copied-articles sequences))) + (nnimap-mark-and-expunge-incoming junk-articles))))))) (defun nnimap-mark-and-expunge-incoming (range) (when range
--- a/lisp/gnus/nnrss.el Fri Sep 24 15:30:13 2010 -0400 +++ b/lisp/gnus/nnrss.el Fri Sep 24 22:33:34 2010 +0000 @@ -391,8 +391,8 @@ t) (deffoo nnrss-retrieve-groups (groups &optional server) - (nnrss-possibly-change-group nil server) (dolist (group groups) + (nnrss-possibly-change-group group server) (nnrss-check-group group server)) (with-current-buffer nntp-server-buffer (erase-buffer)
--- a/lisp/gnus/starttls.el Fri Sep 24 15:30:13 2010 -0400 +++ b/lisp/gnus/starttls.el Fri Sep 24 22:33:34 2010 +0000 @@ -269,6 +269,7 @@ host port (if done "done" "failed")) process)) +;;;###autoload (defun starttls-open-stream (name buffer host port) "Open a TLS connection for a port to a host. Returns a subprocess object to represent the connection.