[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] /srv/bzr/emacs/trunk r101598: Merge changes made in Gnus t
|
From: |
Katsumi Yamaoka |
|
Subject: |
[Emacs-diffs] /srv/bzr/emacs/trunk r101598: Merge changes made in Gnus trunk. |
|
Date: |
Fri, 24 Sep 2010 22:33:34 +0000 |
|
User-agent: |
Bazaar (2.0.3) |
------------------------------------------------------------
revno: 101598
author: Gnus developers
committer: Katsumi Yamaoka <address@hidden>
branch nick: trunk
timestamp: Fri 2010-09-24 22:33:34 +0000
message:
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.
added:
lisp/gnus/gnus-gravatar.el
lisp/gnus/gravatar.el
modified:
doc/misc/gnus.texi
lisp/gnus/ChangeLog
lisp/gnus/gnus-art.el
lisp/gnus/gnus-cache.el
lisp/gnus/gnus-group.el
lisp/gnus/gnus-sum.el
lisp/gnus/gnus.el
lisp/gnus/nnimap.el
lisp/gnus/nnrss.el
lisp/gnus/starttls.el
=== modified file 'doc/misc/gnus.texi'
--- a/doc/misc/gnus.texi 2010-09-23 23:14:02 +0000
+++ b/doc/misc/gnus.texi 2010-09-24 22:33:34 +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}).
address@hidden G a
address@hidden G a (Group)
address@hidden (ding) archive
address@hidden archive group
address@hidden gnus-group-make-archive-group
address@hidden gnus-group-archive-directory
address@hidden 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.
address@hidden H c
address@hidden H c (Group)
address@hidden gnus-group-fetch-charter
address@hidden gnus-group-charter-alist
address@hidden 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
address@hidden 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
address@hidden://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}).
address@hidden W D g
address@hidden W D g (Summary)
address@hidden gnus-treat-from-gravatar
+Gravatarify the @code{From} header (@code{gnus-treat-from-gravatar}).
+
address@hidden W D h
address@hidden W D h (Summary)
address@hidden 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
address@hidden H f
address@hidden H f (Summary)
address@hidden gnus-summary-fetch-faq
address@hidden 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
address@hidden gnus-treat-from-gravatar
address@hidden 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}.
address@hidden gnus-treat-from-gravatar (head)
address@hidden gnus-treat-mail-gravatar (head)
+
address@hidden
+
@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
address@hidden Gravatars
address@hidden Gravatars
+
address@hidden
address@hidden
+\include{gravatars}
address@hidden iflatex
address@hidden 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.
+
address@hidden @code
+
address@hidden gnus-gravatar-size
address@hidden gnus-gravatar-size
+The size in pixels of gravatars. Gravatars are always square, so one
+number for the size is enough.
+
address@hidden gnus-gravatar-relief
address@hidden 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.
+
address@hidden table
+
+If you want to see them in the From field, set:
address@hidden
+(setq gnus-treat-from-gravatar 'head)
address@hidden lisp
+
+If you want to see them in the Cc and To fields, set:
+
address@hidden
+(setq gnus-treat-mail-gravatar 'head)
address@hidden lisp
+
@node XVarious
@subsection Various XEmacs Variables
=== modified file 'lisp/gnus/ChangeLog'
--- a/lisp/gnus/ChangeLog 2010-09-24 07:25:37 +0000
+++ b/lisp/gnus/ChangeLog 2010-09-24 22:33:34 +0000
@@ -1,3 +1,57 @@
+2010-09-24 Julien Danjou <address@hidden>
+
+ * 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 <address@hidden>
+
+ * 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 <address@hidden> (tiny change)
+
+ * nnimap.el (nnimap-split-incoming-mail): Fix paren typo in the 'junk
+ handling.
+
+2010-09-24 Lars Magne Ingebrigtsen <address@hidden>
+
+ * 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 <address@hidden>
* gmm-utils.el (gmm-tool-bar-from-list): Always use tool-bar-local-item
=== modified file 'lisp/gnus/gnus-art.el'
--- a/lisp/gnus/gnus-art.el 2010-09-24 07:25:37 +0000
+++ b/lisp/gnus/gnus-art.el 2010-09-24 22:33:34 +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
=== modified file 'lisp/gnus/gnus-cache.el'
--- a/lisp/gnus/gnus-cache.el 2010-09-18 10:02:19 +0000
+++ b/lisp/gnus/gnus-cache.el 2010-09-24 22:33:34 +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))
=== added file 'lisp/gnus/gnus-gravatar.el'
--- a/lisp/gnus/gnus-gravatar.el 1970-01-01 00:00:00 +0000
+++ b/lisp/gnus/gnus-gravatar.el 2010-09-24 22:33:34 +0000
@@ -0,0 +1,112 @@
+;;; gnus-gravatar.el --- Gnus Gravatar support
+
+;; Copyright (C) 2010 Free Software Foundation, Inc.
+
+;; Author: Julien Danjou <address@hidden>
+;; 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
=== modified file 'lisp/gnus/gnus-group.el'
--- a/lisp/gnus/gnus-group.el 2010-09-24 07:25:37 +0000
+++ b/lisp/gnus/gnus-group.el 2010-09-24 22:33:34 +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
- "/address@hidden:/pub/emacs/ding-list/"
- "*The address of the (ding) archives."
- :group 'gnus-group-foreign
- :type 'directory)
-
-(defcustom gnus-group-recent-archive-directory
- "/address@hidden:/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 "address@hidden"))))
-
(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."
=== modified file 'lisp/gnus/gnus-sum.el'
--- a/lisp/gnus/gnus-sum.el 2010-09-24 07:25:37 +0000
+++ b/lisp/gnus/gnus-sum.el 2010-09-24 22:33:34 +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))
+ (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)))
+ (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 <address@hidden>.
-(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 <address@hidden>.
(defun gnus-summary-describe-group (&optional force)
"Describe the current newsgroup."
=== modified file 'lisp/gnus/gnus.el'
--- a/lisp/gnus/gnus.el 2010-09-23 00:30:37 +0000
+++ b/lisp/gnus/gnus.el 2010-09-24 22:33:34 +0000
@@ -1470,75 +1470,6 @@
(nnweb "refer" (nnweb-type google)))
gnus-select-method))))
-(defcustom gnus-group-faq-directory
- '("/address@hidden:/pub/rtfm/usenet/"
- "/address@hidden:/pub/usenet/news-faqs/"
- "/address@hidden:/usenet/news-FAQS/"
- "/address@hidden:/pub/rtfm/"
- "/address@hidden:/pub/FAQ/"
- "/address@hidden:/pub/usenet/"
- "/address@hidden:/pub/FAQ/"
- "/address@hidden:/pub/usenet/"
- "/address@hidden:/pub/Documents/rtfm/usenet-by-group/"
- "/address@hidden:/pub/usenet/"
- "/address@hidden:/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)
=== added file 'lisp/gnus/gravatar.el'
--- a/lisp/gnus/gravatar.el 1970-01-01 00:00:00 +0000
+++ b/lisp/gnus/gravatar.el 2010-09-24 22:33:34 +0000
@@ -0,0 +1,123 @@
+;;; gravatar.el --- Get Gravatars
+
+;; Copyright (C) 2010 Free Software Foundation, Inc.
+
+;; Author: Julien Danjou <address@hidden>
+;; 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
=== modified file 'lisp/gnus/nnimap.el'
--- a/lisp/gnus/nnimap.el 2010-09-23 23:14:02 +0000
+++ b/lisp/gnus/nnimap.el 2010-09-24 22:33:34 +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
=== modified file 'lisp/gnus/nnrss.el'
--- a/lisp/gnus/nnrss.el 2010-09-18 23:36:29 +0000
+++ b/lisp/gnus/nnrss.el 2010-09-24 22:33:34 +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)
=== modified file 'lisp/gnus/starttls.el'
--- a/lisp/gnus/starttls.el 2010-09-18 10:02:19 +0000
+++ b/lisp/gnus/starttls.el 2010-09-24 22:33:34 +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.
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Emacs-diffs] /srv/bzr/emacs/trunk r101598: Merge changes made in Gnus trunk.,
Katsumi Yamaoka <=