Commit 61b1af82 authored by Gnus developers's avatar Gnus developers Committed by Katsumi Yamaoka
Browse files

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.
parent 5816888b
...@@ -589,7 +589,7 @@ Article Treatment ...@@ -589,7 +589,7 @@ Article Treatment
* Article Buttons:: Click on URLs, Message-IDs, addresses and the like. * Article Buttons:: Click on URLs, Message-IDs, addresses and the like.
* Article Button Levels:: Controlling appearance of buttons. * Article Button Levels:: Controlling appearance of buttons.
* Article Date:: Grumble, UT! * 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 Signature:: What is a signature?
* Article Miscellanea:: Various other stuff. * Article Miscellanea:: Various other stuff.
   
...@@ -2616,18 +2616,6 @@ for a directory name (@code{gnus-group-make-directory-group}). ...@@ -2616,18 +2616,6 @@ for a directory name (@code{gnus-group-make-directory-group}).
@findex gnus-group-make-help-group @findex gnus-group-make-help-group
Make the Gnus help group (@code{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 @item G D
@kindex G D (Group) @kindex G D (Group)
@findex gnus-group-enter-directory @findex gnus-group-enter-directory
...@@ -5222,19 +5210,6 @@ used for fetching the file. ...@@ -5222,19 +5210,6 @@ used for fetching the file.
If fetching from the first site is unsuccessful, Gnus will attempt to go 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. 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 @item H C
@kindex H C (Group) @kindex H C (Group)
@findex gnus-group-fetch-control @findex gnus-group-fetch-control
...@@ -9255,7 +9230,8 @@ these articles easier. ...@@ -9255,7 +9230,8 @@ these articles easier.
* Article Buttons:: Click on URLs, Message-IDs, addresses and the like. * Article Buttons:: Click on URLs, Message-IDs, addresses and the like.
* Article Button Levels:: Controlling appearance of buttons. * Article Button Levels:: Controlling appearance of buttons.
* Article Date:: Grumble, UT! * 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 Signature:: What is a signature?
* Article Miscellanea:: Various other stuff. * Article Miscellanea:: Various other stuff.
@end menu @end menu
...@@ -10299,6 +10275,7 @@ preferred format automatically. ...@@ -10299,6 +10275,7 @@ preferred format automatically.
@cindex picons @cindex picons
@cindex x-face @cindex x-face
@cindex smileys @cindex smileys
@cindex gravatars
   
These commands add various frivolous display gimmicks to the article These commands add various frivolous display gimmicks to the article
buffer in Emacs versions that support them. buffer in Emacs versions that support them.
...@@ -10315,6 +10292,9 @@ their messages with (@pxref{Smileys}). ...@@ -10315,6 +10292,9 @@ their messages with (@pxref{Smileys}).
Picons, on the other hand, reside on your own system, and Gnus will Picons, on the other hand, reside on your own system, and Gnus will
try to match the headers to what you have (@pxref{Picons}). 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, All these functions are toggles---if the elements already exist,
they'll be removed. they'll be removed.
   
...@@ -10353,6 +10333,17 @@ Piconify all mail headers (i. e., @code{Cc}, @code{To}) ...@@ -10353,6 +10333,17 @@ Piconify all mail headers (i. e., @code{Cc}, @code{To})
Piconify all news headers (i. e., @code{Newsgroups} and Piconify all news headers (i. e., @code{Newsgroups} and
@code{Followup-To}) (@code{gnus-treat-newsgroups-picon}). @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 @item W D D
@kindex W D D (Summary) @kindex W D D (Summary)
@findex gnus-article-remove-images @findex gnus-article-remove-images
...@@ -11561,18 +11552,6 @@ sieve. ...@@ -11561,18 +11552,6 @@ sieve.
   
@table @kbd @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 @item H d
@kindex H d (Summary) @kindex H d (Summary)
@findex gnus-summary-describe-group @findex gnus-summary-describe-group
...@@ -12631,6 +12610,8 @@ controlling variable is a predicate list, as described above. ...@@ -12631,6 +12610,8 @@ controlling variable is a predicate list, as described above.
@vindex gnus-treat-from-picon @vindex gnus-treat-from-picon
@vindex gnus-treat-mail-picon @vindex gnus-treat-mail-picon
@vindex gnus-treat-newsgroups-picon @vindex gnus-treat-newsgroups-picon
@vindex gnus-treat-from-gravatar
@vindex gnus-treat-mail-gravatar
@vindex gnus-treat-display-smileys @vindex gnus-treat-display-smileys
@vindex gnus-treat-body-boundary @vindex gnus-treat-body-boundary
@vindex gnus-treat-display-x-face @vindex gnus-treat-display-x-face
...@@ -12697,6 +12678,11 @@ possible but those listed are probably sufficient for most people. ...@@ -12697,6 +12678,11 @@ possible but those listed are probably sufficient for most people.
   
@xref{Picons}. @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-display-smileys (t, integer)
   
@item gnus-treat-body-boundary (head) @item gnus-treat-body-boundary (head)
...@@ -23709,6 +23695,7 @@ stuff, so Gnus has taken advantage of that. ...@@ -23709,6 +23695,7 @@ stuff, so Gnus has taken advantage of that.
* Face:: Display a funkier, teensier colored image. * Face:: Display a funkier, teensier colored image.
* Smileys:: Show all those happy faces the way they were meant to be shown. * Smileys:: Show all those happy faces the way they were meant to be shown.
* Picons:: How to display pictures of what you're reading. * Picons:: How to display pictures of what you're reading.
* Gravatars:: Display the avatar of people you read.
* XVarious:: Other XEmacsy Gnusey variables. * XVarious:: Other XEmacsy Gnusey variables.
@end menu @end menu
   
...@@ -24037,6 +24024,48 @@ Ordered list of suffixes on picon file names to try. Defaults to ...@@ -24037,6 +24024,48 @@ Ordered list of suffixes on picon file names to try. Defaults to
   
@end table @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 @node XVarious
@subsection Various XEmacs Variables @subsection Various XEmacs Variables
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> 2010-09-24 Katsumi Yamaoka <yamaoka@jpl.org>
   
* gmm-utils.el (gmm-tool-bar-from-list): Always use tool-bar-local-item * gmm-utils.el (gmm-tool-bar-from-list): Always use tool-bar-local-item
......
...@@ -1529,10 +1529,40 @@ node `(gnus)Picons' for details." ...@@ -1529,10 +1529,40 @@ node `(gnus)Picons' for details."
:type gnus-article-treat-head-custom) :type gnus-article-treat-head-custom)
(put 'gnus-treat-newsgroups-picon 'highlight t) (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 (defcustom gnus-treat-body-boundary
(if (or gnus-treat-newsgroups-picon (if (or gnus-treat-newsgroups-picon
gnus-treat-mail-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. ;; If there's much decoration, the user might prefer a boundery.
'head 'head
nil) nil)
...@@ -1669,6 +1699,8 @@ This requires GNU Libidn, and by default only enabled if it is found." ...@@ -1669,6 +1699,8 @@ This requires GNU Libidn, and by default only enabled if it is found."
(gnus-treat-from-picon gnus-treat-from-picon) (gnus-treat-from-picon gnus-treat-from-picon)
(gnus-treat-mail-picon gnus-treat-mail-picon) (gnus-treat-mail-picon gnus-treat-mail-picon)
(gnus-treat-newsgroups-picon gnus-treat-newsgroups-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-headers gnus-article-highlight-headers)
(gnus-treat-highlight-signature gnus-article-highlight-signature) (gnus-treat-highlight-signature gnus-article-highlight-signature)
(gnus-treat-strip-trailing-blank-lines (gnus-treat-strip-trailing-blank-lines
......
...@@ -603,7 +603,7 @@ system for example was used.") ...@@ -603,7 +603,7 @@ system for example was used.")
(insert-file-contents (gnus-cache-file-name group entry))) (insert-file-contents (gnus-cache-file-name group entry)))
(goto-char (point-min)) (goto-char (point-min))
(insert "220 ") (insert "220 ")
(princ (car cached) (current-buffer)) (princ (pop cached) (current-buffer))
(insert " Article retrieved.\n") (insert " Article retrieved.\n")
(search-forward "\n\n" nil 'move) (search-forward "\n\n" nil 'move)
(delete-region (point) (point-max)) (delete-region (point) (point-max))
......
;;; 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
...@@ -55,18 +55,6 @@ ...@@ -55,18 +55,6 @@
(autoload 'gnus-agent-total-fetched-for "gnus-agent") (autoload 'gnus-agent-total-fetched-for "gnus-agent")
(autoload 'gnus-cache-total-fetched-for "gnus-cache") (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" (defcustom gnus-no-groups-message "No Gnus is good news"
"*Message displayed by Gnus when no groups are available." "*Message displayed by Gnus when no groups are available."
:group 'gnus-start :group 'gnus-start
...@@ -657,7 +645,6 @@ simple manner.") ...@@ -657,7 +645,6 @@ simple manner.")
"d" gnus-group-make-directory-group "d" gnus-group-make-directory-group
"h" gnus-group-make-help-group "h" gnus-group-make-help-group
"u" gnus-group-make-useful-group "u" gnus-group-make-useful-group
"a" gnus-group-make-archive-group
"l" gnus-group-nnimap-edit-acl "l" gnus-group-nnimap-edit-acl
"m" gnus-group-make-group "m" gnus-group-make-group
"E" gnus-group-edit-group "E" gnus-group-edit-group
...@@ -752,10 +739,8 @@ simple manner.") ...@@ -752,10 +739,8 @@ simple manner.")
"e" gnus-score-edit-all-score) "e" gnus-score-edit-all-score)
(gnus-define-keys (gnus-group-help-map "H" gnus-group-mode-map) (gnus-define-keys (gnus-group-help-map "H" gnus-group-mode-map)
"c" gnus-group-fetch-charter
"C" gnus-group-fetch-control "C" gnus-group-fetch-control
"d" gnus-group-describe-group "d" gnus-group-describe-group
"f" gnus-group-fetch-faq
"v" gnus-version) "v" gnus-version)
(gnus-define-keys (gnus-group-sub-map "S" gnus-group-mode-map) (gnus-define-keys (gnus-group-sub-map "S" gnus-group-mode-map)
...@@ -821,11 +806,6 @@ simple manner.") ...@@ -821,11 +806,6 @@ simple manner.")
["Describe" gnus-group-describe-group :active (gnus-group-group-name) ["Describe" gnus-group-describe-group :active (gnus-group-group-name)
,@(if (featurep 'xemacs) nil ,@(if (featurep 'xemacs) nil
'(:help "Display description of the current group"))] '(: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 ["Fetch control message" gnus-group-fetch-control
:active (gnus-group-group-name) :active (gnus-group-group-name)
,@(if (featurep 'xemacs) nil ,@(if (featurep 'xemacs) nil
...@@ -925,7 +905,6 @@ simple manner.") ...@@ -925,7 +905,6 @@ simple manner.")
["Make a foreign group..." gnus-group-make-group t] ["Make a foreign group..." gnus-group-make-group t]
["Add a directory group..." gnus-group-make-directory-group t] ["Add a directory group..." gnus-group-make-directory-group t]
["Add the help group" gnus-group-make-help-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 doc group..." gnus-group-make-doc-group t]
["Make a web group..." gnus-group-make-web-group t] ["Make a web group..." gnus-group-make-web-group t]
["Make a virtual group..." gnus-group-make-empty-virtual t] ["Make a virtual group..." gnus-group-make-empty-virtual t]
...@@ -3089,22 +3068,6 @@ If there is, use Gnus to create an nnrss group" ...@@ -3089,22 +3068,6 @@ If there is, use Gnus to create an nnrss group"
(nnrss-save-server-data nil)) (nnrss-save-server-data nil))
(error "No feeds found for %s" url)))) (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) (defun gnus-group-make-directory-group (dir)
"Create an nndir group. "Create an nndir group.
The user will be prompted for a directory. The contents of this The user will be prompted for a directory. The contents of this
...@@ -4049,62 +4012,6 @@ If DONT-SCAN is non-nil, scan non-activated groups as well." ...@@ -4049,62 +4012,6 @@ If DONT-SCAN is non-nil, scan non-activated groups as well."
(gnus-summary-position-point) (gnus-summary-position-point)
ret)) 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))