7720c1cc7e6d6f1e7adddedec41c7f2fae53b564
[gnus] / lisp / gnus-group.el
1 ;;; gnus-group.el --- group mode commands for Gnus
2
3 ;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
4 ;;   2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
5
6 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
7 ;; Keywords: news
8
9 ;; This file is part of GNU Emacs.
10
11 ;; GNU Emacs is free software: you can redistribute it and/or modify
12 ;; it under the terms of the GNU General Public License as published by
13 ;; the Free Software Foundation, either version 3 of the License, or
14 ;; (at your option) any later version.
15
16 ;; GNU Emacs is distributed in the hope that it will be useful,
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
19 ;; GNU General Public License for more details.
20
21 ;; You should have received a copy of the GNU General Public License
22 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
23
24 ;;; Commentary:
25
26 ;;; Code:
27
28 ;; For Emacs <22.2 and XEmacs.
29 (eval-and-compile
30   (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
31
32 (eval-when-compile
33   (require 'cl))
34 (defvar tool-bar-mode)
35
36 (require 'gnus)
37 (require 'gnus-start)
38 (require 'nnmail)
39 (require 'gnus-spec)
40 (require 'gnus-int)
41 (require 'gnus-range)
42 (require 'gnus-win)
43 (require 'gnus-undo)
44 (require 'gmm-utils)
45 (require 'time-date)
46 (require 'gnus-ems)
47
48 (eval-when-compile
49   (require 'mm-url)
50   (let ((features (cons 'gnus-group features)))
51     (require 'gnus-sum))
52   (unless (boundp 'gnus-cache-active-hashtb)
53     (defvar gnus-cache-active-hashtb nil)))
54
55 (autoload 'gnus-agent-total-fetched-for "gnus-agent")
56 (autoload 'gnus-cache-total-fetched-for "gnus-cache")
57
58 (defcustom gnus-no-groups-message "No Gnus is good news"
59   "*Message displayed by Gnus when no groups are available."
60   :group 'gnus-start
61   :type 'string)
62
63 (defcustom gnus-keep-same-level nil
64   "*Non-nil means that the next newsgroup after the current will be on the same level.
65 When you type, for instance, `n' after reading the last article in the
66 current newsgroup, you will go to the next newsgroup.  If this variable
67 is nil, the next newsgroup will be the next from the group
68 buffer.
69 If this variable is non-nil, Gnus will either put you in the
70 next newsgroup with the same level, or, if no such newsgroup is
71 available, the next newsgroup with the lowest possible level higher
72 than the current level.
73 If this variable is `best', Gnus will make the next newsgroup the one
74 with the best level."
75   :group 'gnus-group-levels
76   :type '(choice (const nil)
77                  (const best)
78                  (sexp :tag "other" t)))
79
80 (defcustom gnus-group-goto-unread t
81   "*If non-nil, movement commands will go to the next unread and subscribed group."
82   :link '(custom-manual "(gnus)Group Maneuvering")
83   :group 'gnus-group-various
84   :type 'boolean)
85
86 (defcustom gnus-goto-next-group-when-activating t
87   "*If non-nil, the \\<gnus-group-mode-map>\\[gnus-group-get-new-news-this-group] command will advance point to the next group."
88   :link '(custom-manual "(gnus)Scanning New Messages")
89   :group 'gnus-group-various
90   :type 'boolean)
91
92 (defcustom gnus-permanently-visible-groups nil
93   "*Regexp to match groups that should always be listed in the group buffer.
94 This means that they will still be listed even when there are no
95 unread articles in the groups.
96
97 If nil, no groups are permanently visible."
98   :group 'gnus-group-listing
99   :type '(choice regexp (const nil)))
100
101 (defcustom gnus-safe-html-newsgroups "\\`nnrss[+:]"
102   "Groups in which links in html articles are considered all safe.
103 The value may be a regexp matching those groups, a list of group names,
104 or nil.  This overrides `mm-w3m-safe-url-regexp' (which see).  This is
105 effective only when emacs-w3m renders html articles, i.e., in the case
106 `mm-text-html-renderer' is set to `w3m'."
107   :version "23.2"
108   :group 'gnus-group-various
109   :type '(choice regexp
110                  (repeat :tag "List of group names" (string :tag "Group"))
111                  (const nil)))
112
113 (defcustom gnus-list-groups-with-ticked-articles t
114   "*If non-nil, list groups that have only ticked articles.
115 If nil, only list groups that have unread articles."
116   :group 'gnus-group-listing
117   :type 'boolean)
118
119 (defcustom gnus-group-default-list-level gnus-level-subscribed
120   "*Default listing level.
121 Ignored if `gnus-group-use-permanent-levels' is non-nil."
122   :group 'gnus-group-listing
123   :type 'integer)
124
125 (defcustom gnus-group-list-inactive-groups t
126   "*If non-nil, inactive groups will be listed."
127   :group 'gnus-group-listing
128   :group 'gnus-group-levels
129   :type 'boolean)
130
131 (defcustom gnus-group-sort-function 'gnus-group-sort-by-alphabet
132   "*Function used for sorting the group buffer.
133 This function will be called with group info entries as the arguments
134 for the groups to be sorted.  Pre-made functions include
135 `gnus-group-sort-by-alphabet', `gnus-group-sort-by-real-name',
136 `gnus-group-sort-by-unread', `gnus-group-sort-by-level',
137 `gnus-group-sort-by-score', `gnus-group-sort-by-method',
138 `gnus-group-sort-by-server', and `gnus-group-sort-by-rank'.
139
140 This variable can also be a list of sorting functions.  In that case,
141 the most significant sort function should be the last function in the
142 list."
143   :group 'gnus-group-listing
144   :link '(custom-manual "(gnus)Sorting Groups")
145   :type '(repeat :value-to-internal (lambda (widget value)
146                                       (if (listp value) value (list value)))
147                  :match (lambda (widget value)
148                           (or (symbolp value)
149                               (widget-editable-list-match widget value)))
150                  (choice (function-item gnus-group-sort-by-alphabet)
151                          (function-item gnus-group-sort-by-real-name)
152                          (function-item gnus-group-sort-by-unread)
153                          (function-item gnus-group-sort-by-level)
154                          (function-item gnus-group-sort-by-score)
155                          (function-item gnus-group-sort-by-method)
156                          (function-item gnus-group-sort-by-server)
157                          (function-item gnus-group-sort-by-rank)
158                          (function :tag "other" nil))))
159
160 (defcustom gnus-group-line-format "%M\%S\%p\%P\%5y:%B%(%g%)\n"
161   "*Format of group lines.
162 It works along the same lines as a normal formatting string,
163 with some simple extensions.
164
165 %M    Only marked articles (character, \"*\" or \" \")
166 %S    Whether the group is subscribed (character, \"U\", \"K\", \"Z\" or \" \")
167 %L    Level of subscribedness (integer)
168 %N    Number of unread articles (integer)
169 %I    Number of dormant articles (integer)
170 %i    Number of ticked and dormant (integer)
171 %T    Number of ticked articles (integer)
172 %R    Number of read articles (integer)
173 %U    Number of unseen articles (integer)
174 %t    Estimated total number of articles (integer)
175 %y    Number of unread, unticked articles (integer)
176 %G    Group name (string)
177 %g    Qualified group name (string)
178 %c    Short (collapsed) group name.  See `gnus-group-uncollapsed-levels'.
179 %C    Group comment (string)
180 %D    Group description (string)
181 %s    Select method (string)
182 %o    Moderated group (char, \"m\")
183 %p    Process mark (char)
184 %B    Whether a summary buffer for the group is open (char, \"*\")
185 %O    Moderated group (string, \"(m)\" or \"\")
186 %P    Topic indentation (string)
187 %m    Whether there is new(ish) mail in the group (char, \"%\")
188 %n    Select from where (string)
189 %z    A string that look like `<%s:%n>' if a foreign select method is used
190 %d    The date the group was last entered.
191 %E    Icon as defined by `gnus-group-icon-list'.
192 %F    The disk space used by the articles fetched by both the cache and agent.
193 %u    User defined specifier.  The next character in the format string should
194       be a letter.  Gnus will call the function gnus-user-format-function-X,
195       where X is the letter following %u.  The function will be passed a
196       single dummy parameter as argument.  The function should return a
197       string, which will be inserted into the buffer just like information
198       from any other group specifier.
199
200 Note that this format specification is not always respected.  For
201 reasons of efficiency, when listing killed groups, this specification
202 is ignored altogether.  If the spec is changed considerably, your
203 output may end up looking strange when listing both alive and killed
204 groups.
205
206 If you use %o or %O, reading the active file will be slower and quite
207 a bit of extra memory will be used.  %D and %F will also worsen
208 performance.  Also note that if you change the format specification to
209 include any of these specs, you must probably re-start Gnus to see
210 them go into effect.
211
212 General format specifiers can also be used.
213 See Info node `(gnus)Formatting Variables'."
214   :link '(custom-manual "(gnus)Formatting Variables")
215   :group 'gnus-group-visual
216   :type 'string)
217
218 (defcustom gnus-group-mode-line-format "Gnus: %%b {%M\%:%S}"
219   "*The format specification for the group mode line.
220 It works along the same lines as a normal formatting string,
221 with some simple extensions:
222
223 %S   The native news server.
224 %M   The native select method.
225 %:   \":\" if %S isn't \"\"."
226   :group 'gnus-group-visual
227   :type 'string)
228
229 ;; Extracted from gnus-xmas-redefine in order to preserve user settings
230 (when (featurep 'xemacs)
231   (add-hook 'gnus-group-mode-hook 'gnus-xmas-group-menu-add)
232   (add-hook 'gnus-group-mode-hook 'gnus-xmas-setup-group-toolbar))
233
234 (defcustom gnus-group-menu-hook nil
235   "Hook run after the creation of the group mode menu."
236   :group 'gnus-group-various
237   :type 'hook)
238
239 (defcustom gnus-group-catchup-group-hook nil
240   "Hook run when catching up a group from the group buffer."
241   :group 'gnus-group-various
242   :link '(custom-manual "(gnus)Group Data")
243   :type 'hook)
244
245 (defcustom gnus-group-update-group-hook nil
246   "Hook called when updating group lines."
247   :group 'gnus-group-visual
248   :type 'hook)
249
250 (defcustom gnus-group-prepare-function 'gnus-group-prepare-flat
251   "*A function that is called to generate the group buffer.
252 The function is called with three arguments: The first is a number;
253 all group with a level less or equal to that number should be listed,
254 if the second is non-nil, empty groups should also be displayed.  If
255 the third is non-nil, it is a number.  No groups with a level lower
256 than this number should be displayed.
257
258 The only current function implemented is `gnus-group-prepare-flat'."
259   :group 'gnus-group-listing
260   :type 'function)
261
262 (defcustom gnus-group-prepare-hook nil
263   "Hook called after the group buffer has been generated.
264 If you want to modify the group buffer, you can use this hook."
265   :group 'gnus-group-listing
266   :type 'hook)
267
268 (defcustom gnus-suspend-gnus-hook nil
269   "Hook called when suspending (not exiting) Gnus."
270   :group 'gnus-exit
271   :type 'hook)
272
273 (defcustom gnus-exit-gnus-hook nil
274   "Hook called when exiting Gnus."
275   :group 'gnus-exit
276   :type 'hook)
277
278 (defcustom gnus-after-exiting-gnus-hook nil
279   "Hook called after exiting Gnus."
280   :group 'gnus-exit
281   :type 'hook)
282
283 (defcustom gnus-group-update-hook nil
284   "Hook called when a group line is changed."
285   :group 'gnus-group-visual
286   :version "24.1"
287   :type 'hook)
288
289 (defcustom gnus-useful-groups
290   '(("(ding) mailing list mirrored at gmane.org"
291      "gmane.emacs.gnus.general"
292      (nntp "Gmane"
293            (nntp-address "news.gmane.org")))
294     ("Gnus bug archive"
295      "gnus.gnus-bug"
296      (nntp "news.gnus.org"
297            (nntp-address "news.gnus.org")))
298     ("Local Gnus help group"
299      "gnus-help"
300      (nndoc "gnus-help"
301             (nndoc-article-type mbox)
302             (eval `(nndoc-address
303                     ,(let ((file (nnheader-find-etc-directory
304                                   "gnus-tut.txt" t)))
305                        (unless file
306                          (error "Couldn't find doc group"))
307                        file))))))
308   "*Alist of useful group-server pairs."
309   :group 'gnus-group-listing
310   :type '(repeat (list (string :tag "Description")
311                        (string :tag "Name")
312                        (sexp :tag "Method"))))
313
314 (defcustom gnus-group-highlight
315   '(;; Mail.
316     ((and mailp (= unread 0) (eq level 1)) .
317      gnus-group-mail-1-empty)
318     ((and mailp (eq level 1)) .
319      gnus-group-mail-1)
320     ((and mailp (= unread 0) (eq level 2)) .
321      gnus-group-mail-2-empty)
322     ((and mailp (eq level 2)) .
323      gnus-group-mail-2)
324     ((and mailp (= unread 0) (eq level 3)) .
325      gnus-group-mail-3-empty)
326     ((and mailp (eq level 3)) .
327      gnus-group-mail-3)
328     ((and mailp (= unread 0)) .
329      gnus-group-mail-low-empty)
330     ((and mailp) .
331      gnus-group-mail-low)
332     ;; News.
333     ((and (= unread 0) (eq level 1)) .
334      gnus-group-news-1-empty)
335     ((and (eq level 1)) .
336      gnus-group-news-1)
337     ((and (= unread 0) (eq level 2)) .
338      gnus-group-news-2-empty)
339     ((and (eq level 2)) .
340      gnus-group-news-2)
341     ((and (= unread 0) (eq level 3)) .
342      gnus-group-news-3-empty)
343     ((and (eq level 3)) .
344      gnus-group-news-3)
345     ((and (= unread 0) (eq level 4)) .
346      gnus-group-news-4-empty)
347     ((and (eq level 4)) .
348      gnus-group-news-4)
349     ((and (= unread 0) (eq level 5)) .
350      gnus-group-news-5-empty)
351     ((and (eq level 5)) .
352      gnus-group-news-5)
353     ((and (= unread 0) (eq level 6)) .
354      gnus-group-news-6-empty)
355     ((and (eq level 6)) .
356      gnus-group-news-6)
357     ((and (= unread 0)) .
358      gnus-group-news-low-empty)
359     (t .
360      gnus-group-news-low))
361   "*Controls the highlighting of group buffer lines.
362
363 Below is a list of `Form'/`Face' pairs.  When deciding how a a
364 particular group line should be displayed, each form is
365 evaluated.  The content of the face field after the first true form is
366 used.  You can change how those group lines are displayed by
367 editing the face field.
368
369 It is also possible to change and add form fields, but currently that
370 requires an understanding of Lisp expressions.  Hopefully this will
371 change in a future release.  For now, you can use the following
372 variables in the Lisp expression:
373
374 group: The name of the group.
375 unread: The number of unread articles in the group.
376 method: The select method used.
377 mailp: Whether it's a mail group or not.
378 level: The level of the group.
379 score: The score of the group.
380 ticked: The number of ticked articles."
381   :group 'gnus-group-visual
382   :type '(repeat (cons (sexp :tag "Form") face)))
383 (put 'gnus-group-highlight 'risky-local-variable t)
384
385 (defcustom gnus-new-mail-mark ?%
386   "Mark used for groups with new mail."
387   :group 'gnus-group-visual
388   :type 'character)
389
390 (defgroup gnus-group-icons nil
391   "Add Icons to your group buffer."
392   :group 'gnus-group-visual)
393
394 (defcustom gnus-group-icon-list
395   nil
396   "*Controls the insertion of icons into group buffer lines.
397
398 Below is a list of `Form'/`File' pairs.  When deciding how a
399 particular group line should be displayed, each form is evaluated.
400 The icon from the file field after the first true form is used.  You
401 can change how those group lines are displayed by editing the file
402 field.  The File will either be found in the
403 `gnus-group-glyph-directory' or by designating absolute name of the
404 file.
405
406 It is also possible to change and add form fields, but currently that
407 requires an understanding of Lisp expressions.  Hopefully this will
408 change in a future release.  For now, you can use the following
409 variables in the Lisp expression:
410
411 group: The name of the group.
412 unread: The number of unread articles in the group.
413 method: The select method used.
414 mailp: Whether it's a mail group or not.
415 level: The level of the group.
416 score: The score of the group.
417 ticked: The number of ticked articles."
418   :group 'gnus-group-icons
419   :type '(repeat (cons (sexp :tag "Form") file)))
420 (put 'gnus-group-icon-list 'risky-local-variable t)
421
422 (defcustom gnus-group-name-charset-method-alist nil
423   "Alist of method and the charset for group names.
424
425 For example:
426     (((nntp \"news.com.cn\") . cn-gb-2312))"
427   :version "21.1"
428   :group 'gnus-charset
429   :type '(repeat (cons (sexp :tag "Method") (symbol :tag "Charset"))))
430
431 (defcustom gnus-group-name-charset-group-alist
432   (if (or (and (fboundp 'find-coding-system) (find-coding-system 'utf-8))
433           (mm-coding-system-p 'utf-8))
434       '((".*" . utf-8))
435     nil)
436   "Alist of group regexp and the charset for group names.
437
438 For example:
439     ((\"\\.com\\.cn:\" . cn-gb-2312))"
440   :group 'gnus-charset
441   :type '(repeat (cons (regexp :tag "Group") (symbol :tag "Charset"))))
442
443 (defcustom gnus-group-jump-to-group-prompt nil
444   "Default prompt for `gnus-group-jump-to-group'.
445
446 If non-nil, the value should be a string or an alist.  If it is a string,
447 e.g. \"nnml:\", in which case `gnus-group-jump-to-group' offers \"Group:
448 nnml:\" in the minibuffer prompt.
449
450 If it is an alist, it must consist of \(NUMBER .  PROMPT\) pairs, for example:
451 \((1 .  \"\") (2 .  \"nnfolder+archive:\")).  The element with number 0 is
452 used when no prefix argument is given to `gnus-group-jump-to-group'."
453   :version "22.1"
454   :group 'gnus-group-various
455   :type '(choice (string :tag "Prompt string")
456                  (const :tag "Empty" nil)
457                  (repeat (cons (integer :tag "Argument")
458                                (string :tag "Prompt string")))))
459
460 (defvar gnus-group-listing-limit 1000
461   "*A limit of the number of groups when listing.
462 If the number of groups is larger than the limit, list them in a
463 simple manner.")
464
465 ;;; Internal variables
466
467 (defvar gnus-group-is-exiting-p nil)
468 (defvar gnus-group-is-exiting-without-update-p nil)
469 (defvar gnus-group-sort-alist-function 'gnus-group-sort-flat
470   "Function for sorting the group buffer.")
471
472 (defvar gnus-group-sort-selected-function 'gnus-group-sort-selected-flat
473   "Function for sorting the selected groups in the group buffer.")
474
475 (defvar gnus-group-indentation-function nil)
476 (defvar gnus-goto-missing-group-function nil)
477 (defvar gnus-group-update-group-function nil)
478 (defvar gnus-group-goto-next-group-function nil
479   "Function to override finding the next group after listing groups.")
480
481 (defvar gnus-group-edit-buffer nil)
482
483 (defvar gnus-group-line-format-alist
484   `((?M gnus-tmp-marked-mark ?c)
485     (?S gnus-tmp-subscribed ?c)
486     (?L gnus-tmp-level ?d)
487     (?N (cond ((eq number t) "*" )
488               ((numberp number)
489                (int-to-string
490                 (+ number
491                    (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked)))
492                    (gnus-range-length (cdr (assq 'tick gnus-tmp-marked))))))
493               (t number)) ?s)
494     (?R gnus-tmp-number-of-read ?s)
495     (?U (if (gnus-active gnus-tmp-group)
496             (gnus-number-of-unseen-articles-in-group gnus-tmp-group)
497           "*")
498         ?s)
499     (?t gnus-tmp-number-total ?d)
500     (?y gnus-tmp-number-of-unread ?s)
501     (?I (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked))) ?d)
502     (?T (gnus-range-length (cdr (assq 'tick gnus-tmp-marked))) ?d)
503     (?i (+ (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked)))
504            (gnus-range-length (cdr (assq 'tick gnus-tmp-marked)))) ?d)
505     (?g (if (boundp 'gnus-tmp-decoded-group)
506             gnus-tmp-decoded-group
507           gnus-tmp-group)
508         ?s)
509     (?G gnus-tmp-qualified-group ?s)
510     (?c (gnus-short-group-name (if (boundp 'gnus-tmp-decoded-group)
511                                    gnus-tmp-decoded-group
512                                  gnus-tmp-group))
513         ?s)
514     (?C gnus-tmp-comment ?s)
515     (?D gnus-tmp-newsgroup-description ?s)
516     (?o gnus-tmp-moderated ?c)
517     (?O gnus-tmp-moderated-string ?s)
518     (?p gnus-tmp-process-marked ?c)
519     (?s gnus-tmp-news-server ?s)
520     (?n ,(if (featurep 'xemacs)
521              '(symbol-name gnus-tmp-news-method)
522            'gnus-tmp-news-method)
523         ?s)
524     (?P gnus-group-indentation ?s)
525     (?E gnus-tmp-group-icon ?s)
526     (?B gnus-tmp-summary-live ?c)
527     (?z gnus-tmp-news-method-string ?s)
528     (?m (gnus-group-new-mail gnus-tmp-group) ?c)
529     (?d (gnus-group-timestamp-string gnus-tmp-group) ?s)
530     (?u gnus-tmp-user-defined ?s)
531     (?F (gnus-total-fetched-for gnus-tmp-group) ?s)
532     ))
533
534 (defvar gnus-group-mode-line-format-alist
535   `((?S gnus-tmp-news-server ?s)
536     (?M gnus-tmp-news-method ?s)
537     (?u gnus-tmp-user-defined ?s)
538     (?: gnus-tmp-colon ?s)))
539
540 (defvar gnus-topic-topology nil
541   "The complete topic hierarchy.")
542
543 (defvar gnus-topic-alist nil
544   "The complete topic-group alist.")
545
546 (defvar gnus-group-marked nil)
547
548 (defvar gnus-group-list-mode nil)
549
550
551 (defvar gnus-group-listed-groups nil)
552 (defvar gnus-group-list-option nil)
553
554 ;;;
555 ;;; Gnus group mode
556 ;;;
557
558 (put 'gnus-group-mode 'mode-class 'special)
559
560 (gnus-define-keys gnus-group-mode-map
561   " " gnus-group-read-group
562   "=" gnus-group-select-group
563   "\r" gnus-group-select-group
564   "\M-\r" gnus-group-quick-select-group
565   "\M- " gnus-group-visible-select-group
566   [(meta control return)] gnus-group-select-group-ephemerally
567   "j" gnus-group-jump-to-group
568   "n" gnus-group-next-unread-group
569   "p" gnus-group-prev-unread-group
570   "\177" gnus-group-prev-unread-group
571   [delete] gnus-group-prev-unread-group
572   [backspace] gnus-group-prev-unread-group
573   "N" gnus-group-next-group
574   "P" gnus-group-prev-group
575   "\M-n" gnus-group-next-unread-group-same-level
576   "\M-p" gnus-group-prev-unread-group-same-level
577   "," gnus-group-best-unread-group
578   "." gnus-group-first-unread-group
579   "u" gnus-group-unsubscribe-current-group
580   "U" gnus-group-unsubscribe-group
581   "c" gnus-group-catchup-current
582   "C" gnus-group-catchup-current-all
583   "\M-c" gnus-group-clear-data
584   "l" gnus-group-list-groups
585   "L" gnus-group-list-all-groups
586   "m" gnus-group-mail
587   "i" gnus-group-news
588   "g" gnus-group-get-new-news
589   "\M-g" gnus-group-get-new-news-this-group
590   "R" gnus-group-restart
591   "r" gnus-group-read-init-file
592   "B" gnus-group-browse-foreign-server
593   "b" gnus-group-check-bogus-groups
594   "F" gnus-group-find-new-groups
595   "\C-c\C-d" gnus-group-describe-group
596   "\M-d" gnus-group-describe-all-groups
597   "\C-c\C-a" gnus-group-apropos
598   "\C-c\M-\C-a" gnus-group-description-apropos
599   "a" gnus-group-post-news
600   "\ek" gnus-group-edit-local-kill
601   "\eK" gnus-group-edit-global-kill
602   "\C-k" gnus-group-kill-group
603   "\C-y" gnus-group-yank-group
604   "\C-w" gnus-group-kill-region
605   "\C-x\C-t" gnus-group-transpose-groups
606   "\C-c\C-l" gnus-group-list-killed
607   "\C-c\C-x" gnus-group-expire-articles
608   "\C-c\M-\C-x" gnus-group-expire-all-groups
609   "V" gnus-version
610   "s" gnus-group-save-newsrc
611   "z" gnus-group-suspend
612   "q" gnus-group-exit
613   "Q" gnus-group-quit
614   "?" gnus-group-describe-briefly
615   "\C-c\C-i" gnus-info-find-node
616   "\M-e" gnus-group-edit-group-method
617   "^" gnus-group-enter-server-mode
618   gnus-mouse-2 gnus-mouse-pick-group
619   [follow-link] mouse-face
620   "<" beginning-of-buffer
621   ">" end-of-buffer
622   "\C-c\C-b" gnus-bug
623   "\C-c\C-s" gnus-group-sort-groups
624   "t" gnus-topic-mode
625   "\C-c\M-g" gnus-activate-all-groups
626   "\M-&" gnus-group-universal-argument
627   "#" gnus-group-mark-group
628   "\M-#" gnus-group-unmark-group)
629
630 (gnus-define-keys (gnus-group-mark-map "M" gnus-group-mode-map)
631   "m" gnus-group-mark-group
632   "u" gnus-group-unmark-group
633   "w" gnus-group-mark-region
634   "b" gnus-group-mark-buffer
635   "r" gnus-group-mark-regexp
636   "U" gnus-group-unmark-all-groups)
637
638 (gnus-define-keys (gnus-group-sieve-map "D" gnus-group-mode-map)
639   "u" gnus-sieve-update
640   "g" gnus-sieve-generate)
641
642 (gnus-define-keys (gnus-group-group-map "G" gnus-group-mode-map)
643   "d" gnus-group-make-directory-group
644   "h" gnus-group-make-help-group
645   "u" gnus-group-make-useful-group
646   "l" gnus-group-nnimap-edit-acl
647   "m" gnus-group-make-group
648   "E" gnus-group-edit-group
649   "e" gnus-group-edit-group-method
650   "p" gnus-group-edit-group-parameters
651   "v" gnus-group-add-to-virtual
652   "V" gnus-group-make-empty-virtual
653   "D" gnus-group-enter-directory
654   "f" gnus-group-make-doc-group
655   "w" gnus-group-make-web-group
656   "M" gnus-group-read-ephemeral-group
657   "r" gnus-group-rename-group
658   "R" gnus-group-make-rss-group
659   "c" gnus-group-customize
660   "z" gnus-group-compact-group
661   "x" gnus-group-expunge-group
662   "\177" gnus-group-delete-group
663   [delete] gnus-group-delete-group)
664
665 (gnus-define-keys (gnus-group-sort-map "S" gnus-group-group-map)
666   "s" gnus-group-sort-groups
667   "a" gnus-group-sort-groups-by-alphabet
668   "u" gnus-group-sort-groups-by-unread
669   "l" gnus-group-sort-groups-by-level
670   "v" gnus-group-sort-groups-by-score
671   "r" gnus-group-sort-groups-by-rank
672   "m" gnus-group-sort-groups-by-method
673   "n" gnus-group-sort-groups-by-real-name)
674
675 (gnus-define-keys (gnus-group-sort-selected-map "P" gnus-group-group-map)
676   "s" gnus-group-sort-selected-groups
677   "a" gnus-group-sort-selected-groups-by-alphabet
678   "u" gnus-group-sort-selected-groups-by-unread
679   "l" gnus-group-sort-selected-groups-by-level
680   "v" gnus-group-sort-selected-groups-by-score
681   "r" gnus-group-sort-selected-groups-by-rank
682   "m" gnus-group-sort-selected-groups-by-method
683   "n" gnus-group-sort-selected-groups-by-real-name)
684
685 (gnus-define-keys (gnus-group-list-map "A" gnus-group-mode-map)
686   "k" gnus-group-list-killed
687   "z" gnus-group-list-zombies
688   "s" gnus-group-list-groups
689   "u" gnus-group-list-all-groups
690   "A" gnus-group-list-active
691   "a" gnus-group-apropos
692   "d" gnus-group-description-apropos
693   "m" gnus-group-list-matching
694   "M" gnus-group-list-all-matching
695   "l" gnus-group-list-level
696   "c" gnus-group-list-cached
697   "?" gnus-group-list-dormant)
698
699 (gnus-define-keys (gnus-group-list-limit-map "/" gnus-group-list-map)
700   "k"  gnus-group-list-limit
701   "z"  gnus-group-list-limit
702   "s"  gnus-group-list-limit
703   "u"  gnus-group-list-limit
704   "A"  gnus-group-list-limit
705   "m"  gnus-group-list-limit
706   "M"  gnus-group-list-limit
707   "l"  gnus-group-list-limit
708   "c"  gnus-group-list-limit
709   "?"  gnus-group-list-limit)
710
711 (gnus-define-keys (gnus-group-list-flush-map "f" gnus-group-list-map)
712   "k"  gnus-group-list-flush
713   "z"  gnus-group-list-flush
714   "s"  gnus-group-list-flush
715   "u"  gnus-group-list-flush
716   "A"  gnus-group-list-flush
717   "m"  gnus-group-list-flush
718   "M"  gnus-group-list-flush
719   "l"  gnus-group-list-flush
720   "c"  gnus-group-list-flush
721   "?"  gnus-group-list-flush)
722
723 (gnus-define-keys (gnus-group-list-plus-map "p" gnus-group-list-map)
724   "k"  gnus-group-list-plus
725   "z"  gnus-group-list-plus
726   "s"  gnus-group-list-plus
727   "u"  gnus-group-list-plus
728   "A"  gnus-group-list-plus
729   "m"  gnus-group-list-plus
730   "M"  gnus-group-list-plus
731   "l"  gnus-group-list-plus
732   "c"  gnus-group-list-plus
733   "?"  gnus-group-list-plus)
734
735 (gnus-define-keys (gnus-group-score-map "W" gnus-group-mode-map)
736   "f" gnus-score-flush-cache
737   "e" gnus-score-edit-all-score)
738
739 (gnus-define-keys (gnus-group-help-map "H" gnus-group-mode-map)
740   "C" gnus-group-fetch-control
741   "d" gnus-group-describe-group
742   "v" gnus-version)
743
744 (gnus-define-keys (gnus-group-sub-map "S" gnus-group-mode-map)
745   "l" gnus-group-set-current-level
746   "t" gnus-group-unsubscribe-current-group
747   "s" gnus-group-unsubscribe-group
748   "k" gnus-group-kill-group
749   "y" gnus-group-yank-group
750   "w" gnus-group-kill-region
751   "\C-k" gnus-group-kill-level
752   "z" gnus-group-kill-all-zombies)
753
754 (defun gnus-topic-mode-p ()
755   "Return non-nil in `gnus-topic-mode'."
756   (and (boundp 'gnus-topic-mode)
757        (symbol-value 'gnus-topic-mode)))
758
759 (defun gnus-group-make-menu-bar ()
760   (unless (boundp 'gnus-group-reading-menu)
761
762     (easy-menu-define
763      gnus-group-reading-menu gnus-group-mode-map ""
764      `("Group"
765        ["Read" gnus-group-read-group
766         :included (not (gnus-topic-mode-p))
767         :active (gnus-group-group-name)]
768        ["Read " gnus-topic-read-group
769         :included (gnus-topic-mode-p)]
770        ["Select" gnus-group-select-group
771         :included (not (gnus-topic-mode-p))
772         :active (gnus-group-group-name)]
773        ["Select " gnus-topic-select-group
774         :included (gnus-topic-mode-p)]
775        ["See old articles" (gnus-group-select-group 'all)
776         :keys "C-u SPC" :active (gnus-group-group-name)]
777        ["Catch up" gnus-group-catchup-current
778         :included (not (gnus-topic-mode-p))
779         :active (gnus-group-group-name)
780         ,@(if (featurep 'xemacs) nil
781             '(:help "Mark unread articles in the current group as read"))]
782        ["Catch up " gnus-topic-catchup-articles
783         :included (gnus-topic-mode-p)
784         ,@(if (featurep 'xemacs) nil
785             '(:help "Mark unread articles in the current group or topic as read"))]
786        ["Catch up all articles" gnus-group-catchup-current-all
787         (gnus-group-group-name)]
788        ["Check for new articles" gnus-group-get-new-news-this-group
789         :included (not (gnus-topic-mode-p))
790         :active (gnus-group-group-name)
791         ,@(if (featurep 'xemacs) nil
792             '(:help "Check for new messages in current group"))]
793        ["Check for new articles " gnus-topic-get-new-news-this-topic
794         :included (gnus-topic-mode-p)
795         ,@(if (featurep 'xemacs) nil
796             '(:help "Check for new messages in current group or topic"))]
797        ["Toggle subscription" gnus-group-unsubscribe-current-group
798         (gnus-group-group-name)]
799        ["Kill" gnus-group-kill-group :active (gnus-group-group-name)
800         ,@(if (featurep 'xemacs) nil
801               '(:help "Kill (remove) current group"))]
802        ["Yank" gnus-group-yank-group gnus-list-of-killed-groups]
803        ["Describe" gnus-group-describe-group :active (gnus-group-group-name)
804         ,@(if (featurep 'xemacs) nil
805             '(:help "Display description of the current group"))]
806        ["Fetch control message" gnus-group-fetch-control
807         :active (gnus-group-group-name)
808         ,@(if (featurep 'xemacs) nil
809             '(:help "Display the archived control message for the current group"))]
810        ;; Actually one should check, if any of the marked groups gives t for
811        ;; (gnus-check-backend-function 'request-expire-articles ...)
812        ["Expire articles" gnus-group-expire-articles
813         :included (not (gnus-topic-mode-p))
814         :active (or (and (gnus-group-group-name)
815                          (gnus-check-backend-function
816                           'request-expire-articles
817                           (gnus-group-group-name))) gnus-group-marked)]
818        ["Expire articles " gnus-topic-expire-articles
819         :included (gnus-topic-mode-p)]
820        ["Set group level..." gnus-group-set-current-level
821         (gnus-group-group-name)]
822        ["Select quick" gnus-group-quick-select-group (gnus-group-group-name)]
823        ["Customize" gnus-group-customize (gnus-group-group-name)]
824        ["Compact" gnus-group-compact-group
825         :active (gnus-group-group-name)]
826        ("Edit"
827         ["Parameters" gnus-group-edit-group-parameters
828          :included (not (gnus-topic-mode-p))
829          :active (gnus-group-group-name)]
830         ["Parameters " gnus-topic-edit-parameters
831          :included (gnus-topic-mode-p)]
832         ["Select method" gnus-group-edit-group-method
833          (gnus-group-group-name)]
834         ["Info" gnus-group-edit-group (gnus-group-group-name)]
835         ["Local kill file" gnus-group-edit-local-kill (gnus-group-group-name)]
836         ["Global kill file" gnus-group-edit-global-kill t])))
837
838     (easy-menu-define
839      gnus-group-group-menu gnus-group-mode-map ""
840      '("Groups"
841        ("Listing"
842         ["List unread subscribed groups" gnus-group-list-groups t]
843         ["List (un)subscribed groups" gnus-group-list-all-groups t]
844         ["List killed groups" gnus-group-list-killed gnus-killed-list]
845         ["List zombie groups" gnus-group-list-zombies gnus-zombie-list]
846         ["List level..." gnus-group-list-level t]
847         ["Describe all groups" gnus-group-describe-all-groups t]
848         ["Group apropos..." gnus-group-apropos t]
849         ["Group and description apropos..." gnus-group-description-apropos t]
850         ["List groups matching..." gnus-group-list-matching t]
851         ["List all groups matching..." gnus-group-list-all-matching t]
852         ["List active file" gnus-group-list-active t]
853         ["List groups with cached" gnus-group-list-cached t]
854         ["List groups with dormant" gnus-group-list-dormant t])
855        ("Sort"
856         ["Default sort" gnus-group-sort-groups t]
857         ["Sort by method" gnus-group-sort-groups-by-method t]
858         ["Sort by rank" gnus-group-sort-groups-by-rank t]
859         ["Sort by score" gnus-group-sort-groups-by-score t]
860         ["Sort by level" gnus-group-sort-groups-by-level t]
861         ["Sort by unread" gnus-group-sort-groups-by-unread t]
862         ["Sort by name" gnus-group-sort-groups-by-alphabet t]
863         ["Sort by real name" gnus-group-sort-groups-by-real-name t])
864        ("Sort process/prefixed"
865         ["Default sort" gnus-group-sort-selected-groups
866          (not (gnus-topic-mode-p))]
867         ["Sort by method" gnus-group-sort-selected-groups-by-method
868          (not (gnus-topic-mode-p))]
869         ["Sort by rank" gnus-group-sort-selected-groups-by-rank
870          (not (gnus-topic-mode-p))]
871         ["Sort by score" gnus-group-sort-selected-groups-by-score
872          (not (gnus-topic-mode-p))]
873         ["Sort by level" gnus-group-sort-selected-groups-by-level
874          (not (gnus-topic-mode-p))]
875         ["Sort by unread" gnus-group-sort-selected-groups-by-unread
876          (not (gnus-topic-mode-p))]
877         ["Sort by name" gnus-group-sort-selected-groups-by-alphabet
878          (not (gnus-topic-mode-p))]
879         ["Sort by real name" gnus-group-sort-selected-groups-by-real-name
880          (not (gnus-topic-mode-p))])
881        ("Mark"
882         ["Mark group" gnus-group-mark-group
883          (and (gnus-group-group-name)
884               (not (memq (gnus-group-group-name) gnus-group-marked)))]
885         ["Unmark group" gnus-group-unmark-group
886          (and (gnus-group-group-name)
887               (memq (gnus-group-group-name) gnus-group-marked))]
888         ["Unmark all" gnus-group-unmark-all-groups gnus-group-marked]
889         ["Mark regexp..." gnus-group-mark-regexp t]
890         ["Mark region" gnus-group-mark-region :active (gnus-mark-active-p)]
891         ["Mark buffer" gnus-group-mark-buffer t]
892         ["Execute command" gnus-group-universal-argument
893          (or gnus-group-marked (gnus-group-group-name))])
894        ("Subscribe"
895         ["Subscribe to a group..." gnus-group-unsubscribe-group t]
896         ["Kill all newsgroups in region" gnus-group-kill-region
897          :active (gnus-mark-active-p)]
898         ["Kill all zombie groups" gnus-group-kill-all-zombies
899          gnus-zombie-list]
900         ["Kill all groups on level..." gnus-group-kill-level t])
901        ("Foreign groups"
902         ["Make a foreign group..." gnus-group-make-group t]
903         ["Add a directory group..." gnus-group-make-directory-group t]
904         ["Add the help group" gnus-group-make-help-group t]
905         ["Make a doc group..." gnus-group-make-doc-group t]
906         ["Make a web group..." gnus-group-make-web-group t]
907         ["Make a virtual group..." gnus-group-make-empty-virtual t]
908         ["Add a group to a virtual..." gnus-group-add-to-virtual t]
909         ["Make an ephemeral group..." gnus-group-read-ephemeral-group t]
910         ["Make an RSS group..." gnus-group-make-rss-group t]
911         ["Rename group..." gnus-group-rename-group
912          (gnus-check-backend-function
913           'request-rename-group (gnus-group-group-name))]
914         ["Delete group" gnus-group-delete-group
915          (gnus-check-backend-function
916           'request-delete-group (gnus-group-group-name))])
917        ("Move"
918         ["Next" gnus-group-next-group t]
919         ["Previous" gnus-group-prev-group t]
920         ["Next unread" gnus-group-next-unread-group t]
921         ["Previous unread" gnus-group-prev-unread-group t]
922         ["Next unread same level" gnus-group-next-unread-group-same-level t]
923         ["Previous unread same level"
924          gnus-group-prev-unread-group-same-level t]
925         ["Jump to group..." gnus-group-jump-to-group t]
926         ["First unread group" gnus-group-first-unread-group t]
927         ["Best unread group" gnus-group-best-unread-group t])
928        ("Sieve"
929         ["Generate" gnus-sieve-generate t]
930         ["Generate and update" gnus-sieve-update t])
931        ["Delete bogus groups" gnus-group-check-bogus-groups t]
932        ["Find new newsgroups" gnus-group-find-new-groups t]
933        ["Transpose" gnus-group-transpose-groups
934         (gnus-group-group-name)]
935        ["Read a directory as a group..." gnus-group-enter-directory t]))
936
937     (easy-menu-define
938      gnus-group-misc-menu gnus-group-mode-map ""
939      `("Gnus"
940        ["Send a mail" gnus-group-mail t]
941        ["Send a message (mail or news)" gnus-group-post-news t]
942        ["Create a local message" gnus-group-news t]
943        ["Check for new news" gnus-group-get-new-news
944         ,@(if (featurep 'xemacs) '(t)
945             '(:help "Get newly arrived articles"))
946         ]
947        ["Send queued messages" gnus-delay-send-queue
948         ,@(if (featurep 'xemacs) '(t)
949             '(:help "Send all messages that are scheduled to be sent now"))
950         ]
951        ["Activate all groups" gnus-activate-all-groups t]
952        ["Restart Gnus" gnus-group-restart t]
953        ["Read init file" gnus-group-read-init-file t]
954        ["Browse foreign server..." gnus-group-browse-foreign-server t]
955        ["Enter server buffer" gnus-group-enter-server-mode t]
956        ["Expire all expirable articles" gnus-group-expire-all-groups t]
957        ["Gnus version" gnus-version t]
958        ["Save .newsrc files" gnus-group-save-newsrc t]
959        ["Suspend Gnus" gnus-group-suspend t]
960        ["Clear dribble buffer" gnus-group-clear-dribble t]
961        ["Read manual" gnus-info-find-node t]
962        ["Flush score cache" gnus-score-flush-cache t]
963        ["Toggle topics" gnus-topic-mode t]
964        ["Send a bug report" gnus-bug t]
965        ["Exit from Gnus" gnus-group-exit
966         ,@(if (featurep 'xemacs) '(t)
967             '(:help "Quit reading news"))]
968        ["Exit without saving" gnus-group-quit t]))
969
970     (gnus-run-hooks 'gnus-group-menu-hook)))
971
972
973 (defvar gnus-group-tool-bar-map nil)
974
975 (defun gnus-group-tool-bar-update (&optional symbol value)
976   "Update group buffer toolbar.
977 Setter function for custom variables."
978   (when symbol
979     (set-default symbol value))
980   ;; (setq-default gnus-group-tool-bar-map nil)
981   ;; (use-local-map gnus-group-mode-map)
982   (when (gnus-alive-p)
983     (with-current-buffer gnus-group-buffer
984       (gnus-group-make-tool-bar t))))
985
986 (defcustom gnus-group-tool-bar (if (eq gmm-tool-bar-style 'gnome)
987                                    'gnus-group-tool-bar-gnome
988                                  'gnus-group-tool-bar-retro)
989   "Specifies the Gnus group tool bar.
990
991 It can be either a list or a symbol refering to a list.  See
992 `gmm-tool-bar-from-list' for the format of the list.  The
993 default key map is `gnus-group-mode-map'.
994
995 Pre-defined symbols include `gnus-group-tool-bar-gnome' and
996 `gnus-group-tool-bar-retro'."
997   :type '(choice (const :tag "GNOME style" gnus-group-tool-bar-gnome)
998                  (const :tag "Retro look" gnus-group-tool-bar-retro)
999                  (repeat :tag "User defined list" gmm-tool-bar-item)
1000                  (symbol))
1001   :version "23.1" ;; No Gnus
1002   :initialize 'custom-initialize-default
1003   :set 'gnus-group-tool-bar-update
1004   :group 'gnus-group)
1005
1006 (defcustom gnus-group-tool-bar-gnome
1007   '((gnus-group-post-news "mail/compose")
1008     ;; Some useful agent icons?  I don't use the agent so agent users should
1009     ;; suggest useful commands:
1010     (gnus-agent-toggle-plugged "disconnect" t
1011                                :help "Gnus is currently unplugged.  Click to work online."
1012                                :visible (and gnus-agent (not gnus-plugged)))
1013     (gnus-agent-toggle-plugged "connect" t
1014                                :help "Gnus is currently plugged.  Click to work offline."
1015                                :visible (and gnus-agent gnus-plugged))
1016     ;; FIXME: gnus-agent-toggle-plugged (in gnus-agent-group-make-menu-bar)
1017     ;; should have a better help text.
1018     (gnus-group-send-queue "mail/outbox" t
1019                            :visible (and gnus-agent gnus-plugged)
1020                            :help "Send articles from the queue group")
1021     (gnus-group-get-new-news "mail/inbox" nil
1022                              :visible (or (not gnus-agent)
1023                                           gnus-plugged))
1024     ;; FIXME: gnus-*-read-group should have a better help text.
1025     (gnus-topic-read-group "open" nil
1026                            :visible (and (boundp 'gnus-topic-mode)
1027                                          gnus-topic-mode))
1028     (gnus-group-read-group "open" nil
1029                            :visible (not (and (boundp 'gnus-topic-mode)
1030                                               gnus-topic-mode)))
1031     ;; (gnus-group-find-new-groups "???" nil)
1032     (gnus-group-save-newsrc "save")
1033     (gnus-group-describe-group "describe")
1034     (gnus-group-unsubscribe-current-group "gnus/toggle-subscription")
1035     (gnus-group-prev-unread-group "left-arrow")
1036     (gnus-group-next-unread-group "right-arrow")
1037     (gnus-group-exit "exit")
1038     (gmm-customize-mode "preferences" t :help "Edit mode preferences")
1039     (gnus-info-find-node "help"))
1040   "List of functions for the group tool bar (GNOME style).
1041
1042 See `gmm-tool-bar-from-list' for the format of the list."
1043   :type '(repeat gmm-tool-bar-item)
1044   :version "23.1" ;; No Gnus
1045   :initialize 'custom-initialize-default
1046   :set 'gnus-group-tool-bar-update
1047   :group 'gnus-group)
1048
1049 (defcustom gnus-group-tool-bar-retro
1050   '((gnus-group-get-new-news "gnus/get-news")
1051     (gnus-group-get-new-news-this-group "gnus/gnntg")
1052     (gnus-group-catchup-current "gnus/catchup")
1053     (gnus-group-describe-group "gnus/describe-group")
1054     (gnus-group-subscribe "gnus/subscribe" t
1055                           :help "Subscribe to the current group")
1056     (gnus-group-unsubscribe "gnus/unsubscribe" t
1057                             :help "Unsubscribe from the current group")
1058     (gnus-group-exit "gnus/exit-gnus" gnus-group-mode-map))
1059   "List of functions for the group tool bar (retro look).
1060
1061 See `gmm-tool-bar-from-list' for the format of the list."
1062   :type '(repeat gmm-tool-bar-item)
1063   :version "23.1" ;; No Gnus
1064   :initialize 'custom-initialize-default
1065   :set 'gnus-group-tool-bar-update
1066   :group 'gnus-group)
1067
1068 (defcustom gnus-group-tool-bar-zap-list t
1069   "List of icon items from the global tool bar.
1070 These items are not displayed in the Gnus group mode tool bar.
1071
1072 See `gmm-tool-bar-from-list' for the format of the list."
1073   :type 'gmm-tool-bar-zap-list
1074   :version "23.1" ;; No Gnus
1075   :initialize 'custom-initialize-default
1076   :set 'gnus-group-tool-bar-update
1077   :group 'gnus-group)
1078
1079 (defvar image-load-path)
1080 (defvar tool-bar-map)
1081
1082 (defun gnus-group-make-tool-bar (&optional force)
1083   "Make a group mode tool bar from `gnus-group-tool-bar'.
1084 When FORCE, rebuild the tool bar."
1085   (when (and (not (featurep 'xemacs))
1086              (boundp 'tool-bar-mode)
1087              tool-bar-mode
1088              ;; The Gnus 5.10.6 code checked (default-value 'tool-bar-mode).
1089              ;; Why?  --rsteib
1090              (or (not gnus-group-tool-bar-map) force))
1091     (let* ((load-path
1092             (gmm-image-load-path-for-library "gnus"
1093                                              "gnus/toggle-subscription.xpm"
1094                                              nil t))
1095            (image-load-path (cons (car load-path)
1096                                   (when (boundp 'image-load-path)
1097                                     image-load-path)))
1098            (map (gmm-tool-bar-from-list gnus-group-tool-bar
1099                                         gnus-group-tool-bar-zap-list
1100                                         'gnus-group-mode-map)))
1101       (if map
1102           (set (make-local-variable 'tool-bar-map) map))))
1103   gnus-group-tool-bar-map)
1104
1105 (defun gnus-group-mode ()
1106   "Major mode for reading news.
1107
1108 All normal editing commands are switched off.
1109 \\<gnus-group-mode-map>
1110 The group buffer lists (some of) the groups available.  For instance,
1111 `\\[gnus-group-list-groups]' will list all subscribed groups with unread articles, while `\\[gnus-group-list-zombies]'
1112 lists all zombie groups.
1113
1114 Groups that are displayed can be entered with `\\[gnus-group-read-group]'.  To subscribe
1115 to a group not displayed, type `\\[gnus-group-unsubscribe-group]'.
1116
1117 For more in-depth information on this mode, read the manual (`\\[gnus-info-find-node]').
1118
1119 The following commands are available:
1120
1121 \\{gnus-group-mode-map}"
1122   (interactive)
1123   (kill-all-local-variables)
1124   (when (gnus-visual-p 'group-menu 'menu)
1125     (gnus-group-make-menu-bar)
1126     (gnus-group-make-tool-bar))
1127   (gnus-simplify-mode-line)
1128   (setq major-mode 'gnus-group-mode)
1129   (setq mode-name "Group")
1130   (gnus-group-set-mode-line)
1131   (setq mode-line-process nil)
1132   (use-local-map gnus-group-mode-map)
1133   (buffer-disable-undo)
1134   (setq truncate-lines t)
1135   (setq buffer-read-only t
1136         show-trailing-whitespace nil)
1137   (gnus-set-default-directory)
1138   (gnus-update-format-specifications nil 'group 'group-mode)
1139   (gnus-update-group-mark-positions)
1140   (when gnus-use-undo
1141     (gnus-undo-mode 1))
1142   (when gnus-slave
1143     (gnus-slave-mode))
1144   (gnus-run-mode-hooks 'gnus-group-mode-hook))
1145
1146 (defun gnus-update-group-mark-positions ()
1147   (save-excursion
1148     (let ((gnus-process-mark ?\200)
1149           (gnus-group-update-hook nil)
1150           (gnus-group-marked '("dummy.group"))
1151           (gnus-active-hashtb (make-vector 10 0))
1152           (topic ""))
1153       (gnus-set-active "dummy.group" '(0 . 0))
1154       (gnus-set-work-buffer)
1155       (gnus-group-insert-group-line "dummy.group" 0 nil 0 nil)
1156       (goto-char (point-min))
1157       (setq gnus-group-mark-positions
1158             (list (cons 'process (and (search-forward
1159                                        (mm-string-to-multibyte "\200") nil t)
1160                                       (- (point) (point-min) 1))))))))
1161
1162 (defun gnus-mouse-pick-group (e)
1163   "Enter the group under the mouse pointer."
1164   (interactive "e")
1165   (mouse-set-point e)
1166   (gnus-group-read-group nil))
1167
1168 ;; Look at LEVEL and find out what the level is really supposed to be.
1169 ;; If LEVEL is non-nil, LEVEL will be returned, if not, what happens
1170 ;; will depend on whether `gnus-group-use-permanent-levels' is used.
1171 (defun gnus-group-default-level (&optional level number-or-nil)
1172   (cond
1173    (gnus-group-use-permanent-levels
1174     (or (setq gnus-group-use-permanent-levels
1175               (or level (if (numberp gnus-group-use-permanent-levels)
1176                             gnus-group-use-permanent-levels
1177                           (or gnus-group-default-list-level
1178                               gnus-level-subscribed))))
1179         gnus-group-default-list-level gnus-level-subscribed))
1180    (number-or-nil
1181     level)
1182    (t
1183     (or level gnus-group-default-list-level gnus-level-subscribed))))
1184
1185 (defun gnus-group-setup-buffer ()
1186   (set-buffer (gnus-get-buffer-create gnus-group-buffer))
1187   (unless (eq major-mode 'gnus-group-mode)
1188     (gnus-group-mode)))
1189
1190 (defun gnus-group-name-charset (method group)
1191   (if (null method)
1192       (setq method (gnus-find-method-for-group group)))
1193   (let ((item (or (assoc method gnus-group-name-charset-method-alist)
1194                   (and (consp method)
1195                        (assoc (list (car method) (cadr method))
1196                               gnus-group-name-charset-method-alist))))
1197         (alist gnus-group-name-charset-group-alist)
1198         result)
1199     (if item
1200         (cdr item)
1201       (while (setq item (pop alist))
1202         (if (string-match (car item) group)
1203             (setq alist nil
1204                   result (cdr item))))
1205       result)))
1206
1207 (defun gnus-group-name-decode (string charset)
1208   ;; Fixme: Don't decode in unibyte mode.
1209   (if (and string charset (featurep 'mule))
1210       (mm-decode-coding-string string charset)
1211     string))
1212
1213 (defun gnus-group-decoded-name (string)
1214   (let ((charset (gnus-group-name-charset nil string)))
1215     (gnus-group-name-decode string charset)))
1216
1217 (defun gnus-group-list-groups (&optional level unread lowest)
1218   "List newsgroups with level LEVEL or lower that have unread articles.
1219 Default is all subscribed groups.
1220 If argument UNREAD is non-nil, groups with no unread articles are also
1221 listed.
1222
1223 Also see the `gnus-group-use-permanent-levels' variable."
1224   (interactive
1225    (list (if current-prefix-arg
1226              (prefix-numeric-value current-prefix-arg)
1227            (or
1228             (gnus-group-default-level nil t)
1229             gnus-group-default-list-level
1230             gnus-level-subscribed))))
1231   (unless level
1232     (setq level (car gnus-group-list-mode)
1233           unread (cdr gnus-group-list-mode)))
1234   (setq level (gnus-group-default-level level))
1235   (gnus-group-setup-buffer)
1236   (gnus-update-format-specifications nil 'group 'group-mode)
1237   (let ((case-fold-search nil)
1238         (props (text-properties-at (point-at-bol)))
1239         (empty (= (point-min) (point-max)))
1240         (group (gnus-group-group-name))
1241         number)
1242     (set-buffer gnus-group-buffer)
1243     (setq number (funcall gnus-group-prepare-function level unread lowest))
1244     (when (or (and (numberp number)
1245                    (zerop number))
1246               (zerop (buffer-size)))
1247       ;; No groups in the buffer.
1248       (gnus-message 5 "%s" gnus-no-groups-message))
1249     ;; We have some groups displayed.
1250     (goto-char (point-max))
1251     (when (or (not gnus-group-goto-next-group-function)
1252               (not (funcall gnus-group-goto-next-group-function
1253                             group props)))
1254       (cond
1255        (empty
1256         (goto-char (point-min)))
1257        ((not group)
1258         ;; Go to the first group with unread articles.
1259         (gnus-group-search-forward t))
1260        (t
1261         ;; Find the right group to put point on.  If the current group
1262         ;; has disappeared in the new listing, try to find the next
1263         ;; one.  If no next one can be found, just leave point at the
1264         ;; first newsgroup in the buffer.
1265         (when (not (gnus-goto-char
1266                     (text-property-any
1267                      (point-min) (point-max)
1268                      'gnus-group (gnus-intern-safe
1269                                   group gnus-active-hashtb))))
1270           (let ((newsrc (cdddr (gnus-group-entry group))))
1271             (while (and newsrc
1272                         (not (gnus-goto-char
1273                               (text-property-any
1274                                (point-min) (point-max) 'gnus-group
1275                                (gnus-intern-safe
1276                                 (caar newsrc) gnus-active-hashtb)))))
1277               (setq newsrc (cdr newsrc)))
1278             (unless newsrc
1279               (goto-char (point-max))
1280               (forward-line -1)))))))
1281     ;; Adjust cursor point.
1282     (gnus-group-position-point)))
1283
1284 (defun gnus-group-list-level (level &optional all)
1285   "List groups on LEVEL.
1286 If ALL (the prefix), also list groups that have no unread articles."
1287   (interactive "nList groups on level: \nP")
1288   (gnus-group-list-groups level all level))
1289
1290 (defun gnus-group-prepare-logic (group test)
1291   (or (and gnus-group-listed-groups
1292            (null gnus-group-list-option)
1293            (member group gnus-group-listed-groups))
1294       (cond
1295        ((null gnus-group-listed-groups) test)
1296        ((null gnus-group-list-option) test)
1297        (t (and (member group gnus-group-listed-groups)
1298                (if (eq gnus-group-list-option 'flush)
1299                    (not test)
1300                  test))))))
1301
1302 (defun gnus-group-prepare-flat (level &optional predicate lowest regexp)
1303   "List all newsgroups with unread articles of level LEVEL or lower.
1304 If PREDICATE is a function, list groups that the function returns non-nil;
1305 if it is t, list groups that have no unread articles.
1306 If LOWEST is non-nil, list all newsgroups of level LOWEST or higher.
1307 If REGEXP is a function, list dead groups that the function returns non-nil;
1308 if it is a string, only list groups matching REGEXP."
1309   (set-buffer gnus-group-buffer)
1310   (let ((buffer-read-only nil)
1311         (newsrc (cdr gnus-newsrc-alist))
1312         (lowest (or lowest 1))
1313         (not-in-list (and gnus-group-listed-groups
1314                           (copy-sequence gnus-group-listed-groups)))
1315         info clevel unread group params)
1316     (erase-buffer)
1317     (when (or (< lowest gnus-level-zombie)
1318               gnus-group-listed-groups)
1319       ;; List living groups.
1320       (while newsrc
1321         (setq info (car newsrc)
1322               group (gnus-info-group info)
1323               params (gnus-info-params info)
1324               newsrc (cdr newsrc)
1325               unread (gnus-group-unread group))
1326         (when not-in-list
1327           (setq not-in-list (delete group not-in-list)))
1328         (when (gnus-group-prepare-logic
1329                group
1330                (and (or unread          ; This group might be unchecked
1331                         predicate)      ; Check if this group should be listed
1332                     (or (not (stringp regexp))
1333                         (string-match regexp group))
1334                     (<= (setq clevel (gnus-info-level info)) level)
1335                     (>= clevel lowest)
1336                     (cond
1337                      ((functionp predicate)
1338                       (funcall predicate info))
1339                      (predicate t)      ; We list all groups?
1340                      (t
1341                       (or
1342                        (if (eq unread t) ; Unactivated?
1343                            gnus-group-list-inactive-groups
1344                                         ; We list unactivated
1345                          (and (numberp unread) (> unread 0)))
1346                                         ; We list groups with unread articles
1347                        (and gnus-list-groups-with-ticked-articles
1348                             (cdr (assq 'tick (gnus-info-marks info))))
1349                                         ; And groups with tickeds
1350                        ;; Check for permanent visibility.
1351                        (and gnus-permanently-visible-groups
1352                             (string-match gnus-permanently-visible-groups
1353                                           group))
1354                        (memq 'visible params)
1355                        (cdr (assq 'visible params)))))))
1356           (gnus-group-insert-group-line
1357            group (gnus-info-level info)
1358            (gnus-info-marks info) unread (gnus-info-method info)))))
1359
1360     ;; List dead groups.
1361     (when (or gnus-group-listed-groups
1362               (and (>= level gnus-level-zombie)
1363                    (<= lowest gnus-level-zombie)))
1364       (gnus-group-prepare-flat-list-dead
1365        (setq gnus-zombie-list (sort gnus-zombie-list 'string<))
1366        gnus-level-zombie ?Z
1367        regexp))
1368     (when not-in-list
1369       (dolist (group gnus-zombie-list)
1370         (setq not-in-list (delete group not-in-list))))
1371     (when (or gnus-group-listed-groups
1372               (and (>= level gnus-level-killed) (<= lowest gnus-level-killed)))
1373       (gnus-group-prepare-flat-list-dead
1374        (gnus-union
1375         not-in-list
1376         (setq gnus-killed-list (sort gnus-killed-list 'string<)))
1377        gnus-level-killed ?K regexp))
1378
1379     (gnus-group-set-mode-line)
1380     (setq gnus-group-list-mode (cons level predicate))
1381     (gnus-run-hooks 'gnus-group-prepare-hook)
1382     t))
1383
1384 (defun gnus-group-prepare-flat-list-dead (groups level mark regexp)
1385   ;; List zombies and killed lists somewhat faster, which was
1386   ;; suggested by Jack Vinson <vinson@unagi.cis.upenn.edu>.  It does
1387   ;; this by ignoring the group format specification altogether.
1388   (let (group)
1389     (if (> (length groups) gnus-group-listing-limit)
1390         (while groups
1391           (setq group (pop groups))
1392           (when (gnus-group-prepare-logic
1393                  group
1394                  (or (not regexp)
1395                      (and (stringp regexp) (string-match regexp group))
1396                      (and (functionp regexp) (funcall regexp group))))
1397             (gnus-add-text-properties
1398              (point) (prog1 (1+ (point))
1399                        (insert " " mark "     *: "
1400                                (gnus-group-decoded-name group)
1401                                "\n"))
1402              (list 'gnus-group (gnus-intern-safe group gnus-active-hashtb)
1403                    'gnus-unread t
1404                    'gnus-level level))))
1405       (while groups
1406         (setq group (pop groups))
1407         (when (gnus-group-prepare-logic
1408                group
1409                (or (not regexp)
1410                    (and (stringp regexp) (string-match regexp group))
1411                    (and (functionp regexp) (funcall regexp group))))
1412           (gnus-group-insert-group-line
1413            group level nil
1414            (let ((active (gnus-active group)))
1415              (if active
1416                  (if (zerop (cdr active))
1417                      0
1418                    (- (1+ (cdr active)) (car active)))
1419                nil))
1420            (gnus-method-simplify (gnus-find-method-for-group group))))))))
1421
1422 (defun gnus-group-update-group-line ()
1423   "Update the current line in the group buffer."
1424   (let* ((buffer-read-only nil)
1425          (group (gnus-group-group-name))
1426          (entry (and group (gnus-group-entry group)))
1427          gnus-group-indentation)
1428     (when group
1429       (and entry
1430            (not (gnus-ephemeral-group-p group))
1431            (gnus-dribble-enter
1432             (concat "(gnus-group-set-info '"
1433                     (gnus-prin1-to-string (nth 2 entry))
1434                     ")")))
1435       (setq gnus-group-indentation (gnus-group-group-indentation))
1436       (gnus-delete-line)
1437       (gnus-group-insert-group-line-info group)
1438       (forward-line -1)
1439       (gnus-group-position-point))))
1440
1441 (defun gnus-group-insert-group-line-info (group)
1442   "Insert GROUP on the current line."
1443   (let ((entry (gnus-group-entry group))
1444         (gnus-group-indentation (gnus-group-group-indentation))
1445         active info)
1446     (if entry
1447         (progn
1448           ;; (Un)subscribed group.
1449           (setq info (nth 2 entry))
1450           (gnus-group-insert-group-line
1451            group (gnus-info-level info) (gnus-info-marks info)
1452            (or (car entry) t) (gnus-info-method info)))
1453       ;; This group is dead.
1454       (gnus-group-insert-group-line
1455        group
1456        (if (member group gnus-zombie-list) gnus-level-zombie gnus-level-killed)
1457        nil
1458        (if (setq active (gnus-active group))
1459            (if (zerop (cdr active))
1460                0
1461              (- (1+ (cdr active)) (car active)))
1462          nil)
1463        (gnus-method-simplify (gnus-find-method-for-group group))))))
1464
1465 (defun gnus-number-of-unseen-articles-in-group (group)
1466   (let* ((info (nth 2 (gnus-group-entry group)))
1467          (marked (gnus-info-marks info))
1468          (seen (cdr (assq 'seen marked)))
1469          (active (gnus-active group)))
1470     (if (not active)
1471         0
1472       (length (gnus-uncompress-range
1473                (gnus-range-difference
1474                 (gnus-range-difference (list active) (gnus-info-read info))
1475                 seen))))))
1476
1477 ;; Moving through the Group buffer (in topic mode) e.g. with C-n doesn't
1478 ;; update the state (enabled/disabled) of the icon `gnus-group-describe-group'
1479 ;; automatically.  After `C-l' the state is correct.  See the following report
1480 ;; on emacs-devel
1481 ;; <http://thread.gmane.org/v9acdmrcse.fsf@marauder.physik.uni-ulm.de>:
1482 ;; From: Reiner Steib
1483 ;; Subject: tool bar icons not updated according to :active condition
1484 ;; Newsgroups: gmane.emacs.devel
1485 ;; Date: Mon, 23 Jan 2006 19:59:13 +0100
1486 ;; Message-ID: <v9acdmrcse.fsf@marauder.physik.uni-ulm.de>
1487
1488 (defcustom gnus-group-update-tool-bar
1489   (and (not (featurep 'xemacs))
1490        (boundp 'tool-bar-mode)
1491        tool-bar-mode
1492        ;; Using `redraw-frame' (see `gnus-tool-bar-update') in Emacs might
1493        ;; be confusing, so maybe we shouldn't call it by default.
1494        (fboundp 'force-window-update))
1495   "Force updating the group buffer tool bar."
1496   :group 'gnus-group
1497   :version "22.1"
1498   :initialize 'custom-initialize-default
1499   :set (lambda (symbol value)
1500          (set-default symbol value)
1501          (when (gnus-alive-p)
1502            (with-current-buffer gnus-group-buffer
1503              ;; FIXME: Is there a better way to redraw the group buffer?
1504              (gnus-group-get-new-news 0))))
1505   :type 'boolean)
1506
1507 (defun gnus-group-insert-group-line (gnus-tmp-group gnus-tmp-level
1508                                                     gnus-tmp-marked number
1509                                                     gnus-tmp-method)
1510   "Insert a group line in the group buffer."
1511   (let* ((gnus-tmp-method
1512           (gnus-server-get-method gnus-tmp-group gnus-tmp-method))
1513          (group-name-charset (gnus-group-name-charset gnus-tmp-method
1514                                                       gnus-tmp-group))
1515          (gnus-tmp-active (gnus-active gnus-tmp-group))
1516          (gnus-tmp-number-total
1517           (if gnus-tmp-active
1518               (1+ (- (cdr gnus-tmp-active) (car gnus-tmp-active)))
1519             0))
1520          (gnus-tmp-number-of-unread
1521           (if (numberp number) (int-to-string (max 0 number))
1522             "*"))
1523          (gnus-tmp-number-of-read
1524           (if (numberp number)
1525               (int-to-string (max 0 (- gnus-tmp-number-total number)))
1526             "*"))
1527          (gnus-tmp-subscribed
1528           (cond ((<= gnus-tmp-level gnus-level-subscribed) ? )
1529                 ((<= gnus-tmp-level gnus-level-unsubscribed) ?U)
1530                 ((= gnus-tmp-level gnus-level-zombie) ?Z)
1531                 (t ?K)))
1532          (gnus-tmp-qualified-group
1533           (gnus-group-name-decode (gnus-group-real-name gnus-tmp-group)
1534                                   group-name-charset))
1535          (gnus-tmp-comment
1536           (or (gnus-group-get-parameter gnus-tmp-group 'comment t)
1537               gnus-tmp-group))
1538          (gnus-tmp-newsgroup-description
1539           (if gnus-description-hashtb
1540               (or (gnus-group-name-decode
1541                    (gnus-gethash gnus-tmp-group gnus-description-hashtb)
1542                    group-name-charset) "")
1543             ""))
1544          (gnus-tmp-moderated
1545           (if (and gnus-moderated-hashtb
1546                    (gnus-gethash gnus-tmp-group gnus-moderated-hashtb))
1547               ?m ? ))
1548          (gnus-tmp-moderated-string
1549           (if (eq gnus-tmp-moderated ?m) "(m)" ""))
1550          (gnus-tmp-group-icon (gnus-group-get-icon gnus-tmp-group))
1551          (gnus-tmp-news-server (or (cadr gnus-tmp-method) ""))
1552          (gnus-tmp-news-method (or (car gnus-tmp-method) ""))
1553          (gnus-tmp-news-method-string
1554           (if gnus-tmp-method
1555               (format "(%s:%s)" (car gnus-tmp-method)
1556                       (cadr gnus-tmp-method)) ""))
1557          (gnus-tmp-marked-mark
1558           (if (and (numberp number)
1559                    (zerop number)
1560                    (cdr (assq 'tick gnus-tmp-marked)))
1561               ?* ? ))
1562          (gnus-tmp-summary-live
1563           (if (and (not gnus-group-is-exiting-p)
1564                    (gnus-buffer-live-p (gnus-summary-buffer-name
1565                                         gnus-tmp-group)))
1566               ?* ? ))
1567          (gnus-tmp-process-marked
1568           (if (member gnus-tmp-group gnus-group-marked)
1569               gnus-process-mark ? ))
1570          (buffer-read-only nil)
1571          beg end
1572          header gnus-tmp-header)        ; passed as parameter to user-funcs.
1573     (beginning-of-line)
1574     (setq beg (point))
1575     (gnus-add-text-properties
1576      (point)
1577      (prog1 (1+ (point))
1578        ;; Insert the text.
1579        (let ((gnus-tmp-decoded-group (gnus-group-name-decode
1580                                       gnus-tmp-group group-name-charset)))
1581          (eval gnus-group-line-format-spec)))
1582      `(gnus-group ,(gnus-intern-safe gnus-tmp-group gnus-active-hashtb)
1583                   gnus-unread ,(if (numberp number)
1584                                    (string-to-number gnus-tmp-number-of-unread)
1585                                  t)
1586                   gnus-marked ,gnus-tmp-marked-mark
1587                   gnus-indentation ,gnus-group-indentation
1588                   gnus-level ,gnus-tmp-level))
1589     (setq end (point))
1590     (when gnus-group-update-tool-bar
1591       (gnus-put-text-property beg end 'point-entered
1592                               'gnus-tool-bar-update)
1593       (gnus-put-text-property beg end 'point-left
1594                               'gnus-tool-bar-update))
1595     (forward-line -1)
1596     (when (inline (gnus-visual-p 'group-highlight 'highlight))
1597       (gnus-group-highlight-line gnus-tmp-group beg end))
1598     (gnus-run-hooks 'gnus-group-update-hook)
1599     (forward-line)
1600     ;; Allow XEmacs to remove front-sticky text properties.
1601     (gnus-group-remove-excess-properties)))
1602
1603 (defun gnus-group-update-eval-form (group list)
1604   "Eval `car' of each element of LIST, and return the first that return t.
1605 Some value are bound so the form can use them."
1606   (when list
1607     (let* ((entry (gnus-group-entry group))
1608            (unread (if (numberp (car entry)) (car entry) 0))
1609            (active (gnus-active group))
1610            (total (if active (1+ (- (cdr active) (car active))) 0))
1611            (info (nth 2 entry))
1612            (method (inline (gnus-server-get-method group (gnus-info-method info))))
1613            (marked (gnus-info-marks info))
1614            (mailp (apply 'append
1615                          (mapcar
1616                           (lambda (x)
1617                             (memq x (assoc (symbol-name
1618                                             (car (or method gnus-select-method)))
1619                                            gnus-valid-select-methods)))
1620                           '(mail post-mail))))
1621            (level (or (gnus-info-level info) gnus-level-killed))
1622            (score (or (gnus-info-score info) 0))
1623            (ticked (gnus-range-length (cdr (assq 'tick marked))))
1624            (group-age (gnus-group-timestamp-delta group)))
1625       ;; FIXME: http://thread.gmane.org/gmane.emacs.gnus.general/65451/focus=65465
1626       ;; ======================================================================
1627       ;; From: Richard Stallman
1628       ;; Subject: Re: Rewriting gnus-group-highlight-line (was: [...])
1629       ;; Cc: ding@gnus.org
1630       ;; Date: Sat, 27 Oct 2007 19:41:20 -0400
1631       ;; Message-ID: <E1IlvHM-0006TS-7t@fencepost.gnu.org>
1632       ;;
1633       ;; [...]
1634       ;; The kludge is that the alist elements contain expressions that refer
1635       ;; to local variables with short names.  Perhaps write your own tiny
1636       ;; evaluator that handles just `and', `or', and numeric comparisons
1637       ;; and just a few specific variables.
1638       ;; ======================================================================
1639       ;;
1640       ;; Similar for other evaluated variables.  Grep for risky-local-variable
1641       ;; to find them!  -- rsteib
1642       ;;
1643       ;; Eval the cars of the lists until we find a match.
1644       (while (and list
1645                   (not (eval (caar list))))
1646         (setq list (cdr list)))
1647       list)))
1648
1649 (defun gnus-group-highlight-line (group beg end)
1650   "Highlight the current line according to `gnus-group-highlight'.
1651 GROUP is current group, and the line to highlight starts at BEG
1652 and ends at END."
1653   (let ((face (cdar (gnus-group-update-eval-form
1654                       group
1655                       gnus-group-highlight))))
1656     (unless (eq face (get-text-property beg 'face))
1657       (let ((inhibit-read-only t))
1658         (gnus-put-text-property-excluding-characters-with-faces
1659          beg end 'face
1660          (if (boundp face) (symbol-value face) face)))
1661       (gnus-extent-start-open beg))))
1662
1663 (defun gnus-group-get-icon (group)
1664   "Return an icon for GROUP according to `gnus-group-icon-list'."
1665   (if gnus-group-icon-list
1666       (let ((image-path
1667              (cdar (gnus-group-update-eval-form group gnus-group-icon-list))))
1668         (if image-path
1669             (propertize " "
1670                         'display
1671                         (append
1672                          (gnus-create-image (expand-file-name image-path))
1673                          '(:ascent center)))
1674           " "))
1675     " "))
1676
1677 (defun gnus-group-update-group (group &optional visible-only)
1678   "Update all lines where GROUP appear.
1679 If VISIBLE-ONLY is non-nil, the group won't be displayed if it isn't
1680 already."
1681   (with-current-buffer gnus-group-buffer
1682     (save-excursion
1683       ;; The buffer may be narrowed.
1684       (save-restriction
1685         (widen)
1686         (let ((ident (gnus-intern-safe group gnus-active-hashtb))
1687               (loc (point-min))
1688               found buffer-read-only)
1689           ;; Enter the current status into the dribble buffer.
1690           (let ((entry (gnus-group-entry group)))
1691             (when (and entry
1692                        (not (gnus-ephemeral-group-p group)))
1693               (gnus-dribble-enter
1694                (concat "(gnus-group-set-info '"
1695                        (gnus-prin1-to-string (nth 2 entry))
1696                        ")"))))
1697           ;; Find all group instances.  If topics are in use, each group
1698           ;; may be listed in more than once.
1699           (while (setq loc (text-property-any
1700                             loc (point-max) 'gnus-group ident))
1701             (setq found t)
1702             (goto-char loc)
1703             (let ((gnus-group-indentation (gnus-group-group-indentation)))
1704               (gnus-delete-line)
1705               (gnus-group-insert-group-line-info group)
1706               (save-excursion
1707                 (forward-line -1)
1708                 (gnus-run-hooks 'gnus-group-update-group-hook)))
1709             (setq loc (1+ loc)))
1710           (unless (or found visible-only)
1711             ;; No such line in the buffer, find out where it's supposed to
1712             ;; go, and insert it there (or at the end of the buffer).
1713             (if gnus-goto-missing-group-function
1714                 (funcall gnus-goto-missing-group-function group)
1715               (let ((entry (cddr (gnus-group-entry group))))
1716                 (while (and entry (car entry)
1717                             (not
1718                              (gnus-goto-char
1719                               (text-property-any
1720                                (point-min) (point-max)
1721                                'gnus-group (gnus-intern-safe
1722                                             (caar entry)
1723                                             gnus-active-hashtb)))))
1724                   (setq entry (cdr entry)))
1725                 (or entry (goto-char (point-max)))))
1726             ;; Finally insert the line.
1727             (let ((gnus-group-indentation (gnus-group-group-indentation)))
1728               (gnus-group-insert-group-line-info group)
1729               (save-excursion
1730                 (forward-line -1)
1731                 (gnus-run-hooks 'gnus-group-update-group-hook))))
1732           (when gnus-group-update-group-function
1733             (funcall gnus-group-update-group-function group))
1734           (gnus-group-set-mode-line))))))
1735
1736 (defun gnus-group-set-mode-line ()
1737   "Update the mode line in the group buffer."
1738   (when (memq 'group gnus-updated-mode-lines)
1739     ;; Yes, we want to keep this mode line updated.
1740     (with-current-buffer gnus-group-buffer
1741       (let* ((gformat (or gnus-group-mode-line-format-spec
1742                           (gnus-set-format 'group-mode)))
1743              (gnus-tmp-news-server (cadr gnus-select-method))
1744              (gnus-tmp-news-method (car gnus-select-method))
1745              (gnus-tmp-colon (if (equal gnus-tmp-news-server "") "" ":"))
1746              (max-len 60)
1747              gnus-tmp-header            ;Dummy binding for user-defined formats
1748              ;; Get the resulting string.
1749              (modified
1750               (and gnus-dribble-buffer
1751                    (buffer-name gnus-dribble-buffer)
1752                    (buffer-modified-p gnus-dribble-buffer)
1753                    (with-current-buffer gnus-dribble-buffer
1754                      (not (zerop (buffer-size))))))
1755              (mode-string (eval gformat)))
1756         ;; Say whether the dribble buffer has been modified.
1757         (setq mode-line-modified
1758               (if modified (car gnus-mode-line-modified)
1759                 (cdr gnus-mode-line-modified)))
1760         ;; If the line is too long, we chop it off.
1761         (when (> (length mode-string) max-len)
1762           (setq mode-string (substring mode-string 0 (- max-len 4))))
1763         (prog1
1764             (setq mode-line-buffer-identification
1765                   (gnus-mode-line-buffer-identification
1766                    (list mode-string)))
1767           (set-buffer-modified-p modified))))))
1768
1769 (defun gnus-group-group-name ()
1770   "Get the name of the newsgroup on the current line."
1771   (let ((group (get-text-property (point-at-bol) 'gnus-group)))
1772     (when group
1773       (symbol-name group))))
1774
1775 (defun gnus-group-group-level ()
1776   "Get the level of the newsgroup on the current line."
1777   (get-text-property (point-at-bol) 'gnus-level))
1778
1779 (defun gnus-group-group-indentation ()
1780   "Get the indentation of the newsgroup on the current line."
1781   (or (get-text-property (point-at-bol) 'gnus-indentation)
1782       (and gnus-group-indentation-function
1783            (funcall gnus-group-indentation-function))
1784       ""))
1785
1786 (defun gnus-group-group-unread ()
1787   "Get the number of unread articles of the newsgroup on the current line."
1788   (get-text-property (point-at-bol) 'gnus-unread))
1789
1790 (defun gnus-group-new-mail (group)
1791   (if (nnmail-new-mail-p (gnus-group-real-name group))
1792       gnus-new-mail-mark
1793     ? ))
1794
1795 (defun gnus-group-level (group)
1796   "Return the estimated level of GROUP."
1797   (or (gnus-info-level (gnus-get-info group))
1798       (and (member group gnus-zombie-list) gnus-level-zombie)
1799       gnus-level-killed))
1800
1801 (defun gnus-group-search-forward (&optional backward all level first-too)
1802   "Find the next newsgroup with unread articles.
1803 If BACKWARD is non-nil, find the previous newsgroup instead.
1804 If ALL is non-nil, just find any newsgroup.
1805 If LEVEL is non-nil, find group with level LEVEL, or higher if no such
1806 group exists.
1807 If FIRST-TOO, the current line is also eligible as a target."
1808   (let ((way (if backward -1 1))
1809         (low gnus-level-killed)
1810         (beg (point))
1811         pos found lev)
1812     (if (and backward (progn (beginning-of-line)) (bobp))
1813         nil
1814       (unless first-too
1815         (forward-line way))
1816       (while (and
1817               (not (eobp))
1818               (not (setq
1819                     found
1820                     (and
1821                      (get-text-property (point) 'gnus-group)
1822                      (or all
1823                          (and
1824                           (let ((unread
1825                                  (get-text-property (point) 'gnus-unread)))
1826                             (and (numberp unread) (> unread 0)))
1827                           (setq lev (get-text-property (point)
1828                                                        'gnus-level))
1829                           (<= lev gnus-level-subscribed)))
1830                      (or (not level)
1831                          (and (setq lev (get-text-property (point)
1832                                                            'gnus-level))
1833                               (or (= lev level)
1834                                   (and (< lev low)
1835                                        (< level lev)
1836                                        (progn
1837                                          (setq low lev)
1838                                          (setq pos (point))
1839                                          nil))))))))
1840               (zerop (forward-line way)))))
1841     (if found
1842         (progn (gnus-group-position-point) t)
1843       (goto-char (or pos beg))
1844       (and pos t))))
1845
1846 (defun gnus-total-fetched-for (group)
1847   (let* ((size-in-cache (or (gnus-cache-total-fetched-for group) 0))
1848          (size-in-agent (or (gnus-agent-total-fetched-for group) 0))
1849          (size (+ size-in-cache size-in-agent))
1850          (suffix '("B" "K" "M" "G"))
1851          (scale 1024.0)
1852          (cutoff scale))
1853     (while (> size cutoff)
1854       (setq size (/ size scale)
1855             suffix (cdr suffix)))
1856     (format "%5.1f%s" size (car suffix))))
1857
1858 ;;; Gnus group mode commands
1859
1860 ;; Group marking.
1861
1862 (defun gnus-group-mark-line-p ()
1863   (save-excursion
1864     (beginning-of-line)
1865     (forward-char (or (cdr (assq 'process gnus-group-mark-positions)) 2))
1866     (eq (char-after) gnus-process-mark)))
1867
1868 (defun gnus-group-mark-group (n &optional unmark no-advance)
1869   "Mark the current group."
1870   (interactive "p")
1871   (let ((buffer-read-only nil)
1872         group)
1873     (while (and (> n 0)
1874                 (not (eobp)))
1875       (when (setq group (gnus-group-group-name))
1876         ;; Go to the mark position.
1877         (beginning-of-line)
1878         (forward-char (or (cdr (assq 'process gnus-group-mark-positions)) 2))
1879         (delete-char 1)
1880         (if unmark
1881             (progn
1882               (setq gnus-group-marked (delete group gnus-group-marked))
1883               (insert-char ? 1 t))
1884            (setq gnus-group-marked
1885                  (cons group (delete group gnus-group-marked)))
1886            (insert-char gnus-process-mark 1 t)))
1887       (unless no-advance
1888         (gnus-group-next-group 1))
1889       (decf n))
1890     (gnus-group-position-point)
1891     n))
1892
1893 (defun gnus-group-unmark-group (n)
1894   "Remove the mark from the current group."
1895   (interactive "p")
1896   (gnus-group-mark-group n 'unmark)
1897   (gnus-group-position-point))
1898
1899 (defun gnus-group-unmark-all-groups ()
1900   "Unmark all groups."
1901   (interactive)
1902   (save-excursion
1903     (mapc 'gnus-group-remove-mark gnus-group-marked))
1904   (gnus-group-position-point))
1905
1906 (defun gnus-group-mark-region (unmark beg end)
1907   "Mark all groups between point and mark.
1908 If UNMARK, remove the mark instead."
1909   (interactive "P\nr")
1910   (let ((num (count-lines beg end)))
1911     (save-excursion
1912       (goto-char beg)
1913       (- num (gnus-group-mark-group num unmark)))))
1914
1915 (defun gnus-group-mark-buffer (&optional unmark)
1916   "Mark all groups in the buffer.
1917 If UNMARK, remove the mark instead."
1918   (interactive "P")
1919   (gnus-group-mark-region unmark (point-min) (point-max)))
1920
1921 (defun gnus-group-mark-regexp (regexp)
1922   "Mark all groups that match some regexp."
1923   (interactive "sMark (regexp): ")
1924   (let ((alist (cdr gnus-newsrc-alist))
1925         group)
1926     (save-excursion
1927       (while alist
1928         (when (string-match regexp (setq group (gnus-info-group (pop alist))))
1929           (gnus-group-jump-to-group group)
1930           (gnus-group-set-mark group)))))
1931   (gnus-group-position-point))
1932
1933 (defun gnus-group-remove-mark (group &optional test-marked)
1934   "Remove the process mark from GROUP and move point there.
1935 Return nil if the group isn't displayed."
1936   (if (gnus-group-goto-group group nil test-marked)
1937       (save-excursion
1938         (gnus-group-mark-group 1 'unmark t)
1939         t)
1940     (setq gnus-group-marked
1941           (delete group gnus-group-marked))
1942     nil))
1943
1944 (defun gnus-group-set-mark (group)
1945   "Set the process mark on GROUP."
1946   (if (gnus-group-goto-group group)
1947       (save-excursion
1948         (gnus-group-mark-group 1 nil t))
1949     (setq gnus-group-marked (cons group (delete group gnus-group-marked)))))
1950
1951 (defun gnus-group-universal-argument (arg &optional groups func)
1952   "Perform any command on all groups according to the process/prefix convention."
1953   (interactive "P")
1954   (if (eq (setq func (or func
1955                          (key-binding
1956                           (read-key-sequence
1957                            (substitute-command-keys
1958                             "\\<gnus-group-mode-map>\\[gnus-group-universal-argument]")))))
1959           'undefined)
1960       (gnus-error 1 "Undefined key")
1961     (gnus-group-iterate arg
1962       (lambda (group)
1963         (command-execute func))))
1964   (gnus-group-position-point))
1965
1966 (defun gnus-group-process-prefix (n)
1967   "Return a list of groups to work on.
1968 Take into consideration N (the prefix) and the list of marked groups."
1969   (cond
1970    (n
1971     (setq n (prefix-numeric-value n))
1972     ;; There is a prefix, so we return a list of the N next
1973     ;; groups.
1974     (let ((way (if (< n 0) -1 1))
1975           (n (abs n))
1976           group groups)
1977       (save-excursion
1978         (while (> n 0)
1979           (if (setq group (gnus-group-group-name))
1980               (push group groups))
1981           (setq n (1- n))
1982           (gnus-group-next-group way)))
1983       (nreverse groups)))
1984    ((and (gnus-region-active-p) (mark))
1985     ;; Work on the region between point and mark.
1986     (let ((max (max (point) (mark)))
1987           groups)
1988       (save-excursion
1989         (goto-char (min (point) (mark)))
1990         (while
1991             (and
1992              (push (gnus-group-group-name) groups)
1993              (zerop (gnus-group-next-group 1))
1994              (< (point) max)))
1995         (nreverse groups))))
1996    (gnus-group-marked
1997     ;; No prefix, but a list of marked articles.
1998     (reverse gnus-group-marked))
1999    (t
2000     ;; Neither marked articles or a prefix, so we return the
2001     ;; current group.
2002     (let ((group (gnus-group-group-name)))
2003       (and group (list group))))))
2004
2005 ;;; !!!Surely gnus-group-iterate should be a macro instead?  I can't
2006 ;;; imagine why I went through these contortions...
2007 (eval-and-compile
2008   (let ((function (make-symbol "gnus-group-iterate-function"))
2009         (window (make-symbol "gnus-group-iterate-window"))
2010         (groups (make-symbol "gnus-group-iterate-groups"))
2011         (group (make-symbol "gnus-group-iterate-group")))
2012     (eval
2013      `(defun gnus-group-iterate (arg ,function)
2014         "Iterate FUNCTION over all process/prefixed groups.
2015 FUNCTION will be called with the group name as the parameter
2016 and with point over the group in question."
2017         (let ((,groups (gnus-group-process-prefix arg))
2018               (,window (selected-window))
2019               ,group)
2020           (while ,groups
2021             (setq ,group (car ,groups)
2022                   ,groups (cdr ,groups))
2023             (select-window ,window)
2024             (gnus-group-remove-mark ,group)
2025             (save-selected-window
2026               (save-excursion
2027                 (funcall ,function ,group)))))))))
2028
2029 (put 'gnus-group-iterate 'lisp-indent-function 1)
2030
2031 ;; Selecting groups.
2032
2033 (defun gnus-group-read-group (&optional all no-article group select-articles)
2034   "Read news in this newsgroup.
2035 If the prefix argument ALL is non-nil, already read articles become
2036 readable.
2037
2038 If ALL is a positive number, fetch this number of the latest
2039 articles in the group.  If ALL is a negative number, fetch this
2040 number of the earliest articles in the group.
2041
2042 If the optional argument NO-ARTICLE is non-nil, no article will
2043 be auto-selected upon group entry.  If GROUP is non-nil, fetch
2044 that group."
2045   (interactive "P")
2046   (let ((no-display (eq all 0))
2047         (group (or group (gnus-group-group-name)))
2048         number active marked entry)
2049     (when (eq all 0)
2050       (setq all nil))
2051     (unless group
2052       (error "No group on current line"))
2053     (setq marked (gnus-info-marks
2054                   (nth 2 (setq entry (gnus-group-entry group)))))
2055     ;; This group might be a dead group.  In that case we have to get
2056     ;; the number of unread articles from `gnus-active-hashtb'.
2057     (setq number
2058           (cond ((numberp all) all)
2059                 (entry (car entry))
2060                 ((setq active (gnus-active group))
2061                  (- (1+ (cdr active)) (car active)))))
2062     (gnus-summary-read-group
2063      group (or all (and (numberp number)
2064                         (zerop (+ number (gnus-range-length
2065                                           (cdr (assq 'tick marked)))
2066                                   (gnus-range-length
2067                                    (cdr (assq 'dormant marked)))))))
2068      no-article nil no-display nil select-articles)))
2069
2070 (defun gnus-group-select-group (&optional all)
2071   "Select this newsgroup.
2072 No article is selected automatically.
2073 If the group is opened, just switch the summary buffer.
2074 If ALL is non-nil, already read articles become readable.
2075 If ALL is a positive number, fetch this number of the latest
2076 articles in the group.
2077 If ALL is a negative number, fetch this number of the earliest
2078 articles in the group."
2079   (interactive "P")
2080   (when (and (eobp) (not (gnus-group-group-name)))
2081     (forward-line -1))
2082   (gnus-group-read-group all t))
2083
2084 (defun gnus-group-quick-select-group (&optional all group)
2085   "Select the GROUP \"quickly\".
2086 This means that no highlighting or scoring will be performed.  If
2087 ALL (the prefix argument) is 0, don't even generate the summary
2088 buffer.  If GROUP is nil, use current group.
2089
2090 This might be useful if you want to toggle threading
2091 before entering the group."
2092   (interactive "P")
2093   (require 'gnus-score)
2094   (let (gnus-visual
2095         gnus-score-find-score-files-function
2096         gnus-home-score-file
2097         gnus-apply-kill-hook
2098         gnus-summary-expunge-below)
2099     (gnus-group-read-group all t group)))
2100
2101 (defun gnus-group-visible-select-group (&optional all)
2102   "Select the current group without hiding any articles."
2103   (interactive "P")
2104   (let ((gnus-inhibit-limiting t))
2105     (gnus-group-read-group all t)))
2106
2107 (defun gnus-group-select-group-ephemerally ()
2108   "Select the current group without doing any processing whatsoever.
2109 You will actually be entered into a group that's a copy of
2110 the current group; no changes you make while in this group will
2111 be permanent."
2112   (interactive)
2113   (require 'gnus-score)
2114   (let* (gnus-visual
2115          gnus-score-find-score-files-function gnus-apply-kill-hook
2116          gnus-summary-expunge-below gnus-show-threads gnus-suppress-duplicates
2117          gnus-summary-mode-hook gnus-select-group-hook
2118          (group (gnus-group-group-name))
2119          (method (gnus-find-method-for-group group)))
2120     (gnus-group-read-ephemeral-group
2121      (gnus-group-prefixed-name group method) method)))
2122
2123 (defun gnus-group-name-at-point ()
2124   "Return a group name from around point if it exists, or nil."
2125   (if (eq major-mode 'gnus-group-mode)
2126       (let ((group (gnus-group-group-name)))
2127         (when group
2128           (gnus-group-decoded-name group)))
2129     (let ((regexp "[][\C-@-\t\v-*,/:-@\\^`{-\C-?]*\
2130 \\(nn[a-z]+\\(?:\\+[^][\C-@-*,/:-@\\^`{-\C-?]+\\)?:\
2131 \[^][\C-@-*,./:-@\\^`{-\C-?]+\\(?:\\.[^][\C-@-*,./:-@\\^`{-\C-?]+\\)*\
2132 \\|[^][\C-@-*,./:-@\\^`{-\C-?]+\\(?:\\.[^][\C-@-*,./:-@\\^`{-\C-?]+\\)+\\)")
2133           (start (point))
2134           (case-fold-search nil))
2135       (prog1
2136           (if (or (and (not (or (eobp)
2137                                 (looking-at "[][\C-@-*,/;-@\\^`{-\C-?]")))
2138                        (prog1 t
2139                          (skip-chars-backward "^][\C-@-\t\v-*,/;-@\\^`{-\C-?"
2140                                               (point-at-bol))))
2141                   (and (looking-at "[][\C-@-\t\v-*,/;-@\\^`{-\C-?]*$")
2142                        (prog1 t
2143                          (skip-chars-backward "][\C-@-\t\v-*,/;-@\\^`{-\C-?")
2144                          (skip-chars-backward "^][\C-@-\t\v-*,/;-@\\^`{-\C-?"
2145                                               (point-at-bol))))
2146                   (string-match "\\`[][\C-@-\t\v-*,/;-@\\^`{-\C-?]*\\'"
2147                                 (buffer-substring (point-at-bol) (point))))
2148               (when (looking-at regexp)
2149                 (match-string 1))
2150             (let (group distance)
2151               (when (looking-at regexp)
2152                 (setq group (match-string 1)
2153                       distance (- (match-beginning 1) (match-beginning 0))))
2154               (skip-chars-backward "][\C-@-\t\v-*,/;-@\\^`{-\C-?")
2155               (skip-chars-backward "^][\C-@-\t\v-*,/;-@\\^`{-\C-?"
2156                                    (point-at-bol))
2157               (if (looking-at regexp)
2158                   (if (and group (<= distance (- start (match-end 0))))
2159                       group
2160                     (match-string 1))
2161                 group)))
2162         (goto-char start)))))
2163
2164 (defun gnus-group-completing-read (&optional prompt collection
2165                                              require-match initial-input hist
2166                                              def)
2167   "Read a group name with completion.  Non-ASCII group names are allowed.
2168 The arguments are the same as `completing-read' except that COLLECTION
2169 and HIST default to `gnus-active-hashtb' and `gnus-group-history'
2170 respectively if they are omitted.  Regards COLLECTION as a hash table
2171 if it is not a list."
2172   (or collection (setq collection gnus-active-hashtb))
2173   (let (choices group)
2174     (if (listp collection)
2175         (dolist (symbol collection)
2176           (setq group (symbol-name symbol))
2177           (push (if (string-match "[^\000-\177]" group)
2178                     (gnus-group-decoded-name group)
2179                   group)
2180                 choices))
2181       (mapatoms (lambda (symbol)
2182                   (setq group (symbol-name symbol))
2183                   (push (if (string-match "[^\000-\177]" group)
2184                             (gnus-group-decoded-name group)
2185                           group)
2186                         choices))
2187                 collection))
2188     (setq group (gnus-completing-read (or prompt "Group") (nreverse choices)
2189                                       require-match initial-input
2190                                       (or hist 'gnus-group-history)
2191                                       def))
2192     (if (if (listp collection)
2193             (member group (mapcar 'symbol-name collection))
2194           (symbol-value (intern-soft group collection)))
2195         group
2196       (mm-encode-coding-string group (gnus-group-name-charset nil group)))))
2197
2198 ;;;###autoload
2199 (defun gnus-fetch-group (group &optional articles)
2200   "Start Gnus if necessary and enter GROUP.
2201 If ARTICLES, display those articles.
2202 Returns whether the fetching was successful or not."
2203   (interactive (list (gnus-group-completing-read nil
2204                                                  nil nil
2205                                                  (gnus-group-name-at-point))))
2206   (unless (gnus-alive-p)
2207     (gnus-no-server))
2208   (gnus-group-read-group (if articles nil t) nil group articles))
2209
2210 ;;;###autoload
2211 (defun gnus-fetch-group-other-frame (group)
2212   "Pop up a frame and enter GROUP."
2213   (interactive "P")
2214   (let ((window (get-buffer-window gnus-group-buffer)))
2215     (cond (window
2216            (select-frame (window-frame window)))
2217           ((= (length (frame-list)) 1)
2218            (select-frame (make-frame)))
2219           (t
2220            (other-frame 1))))
2221   (gnus-fetch-group group))
2222
2223 (defcustom gnus-large-ephemeral-newsgroup 200
2224   "The number of articles which indicates a large ephemeral newsgroup.
2225 Same as `gnus-large-newsgroup', but only used for ephemeral newsgroups.
2226
2227 If the number of articles in a newsgroup is greater than this value,
2228 confirmation is required for selecting the newsgroup.  If it is nil, no
2229 confirmation is required."
2230   :version "22.1"
2231   :group 'gnus-group-select
2232   :type '(choice (const :tag "No limit" nil)
2233                  integer))
2234
2235 (defcustom gnus-fetch-old-ephemeral-headers nil
2236   "Same as `gnus-fetch-old-headers', but only used for ephemeral newsgroups."
2237   :version "22.1"
2238   :group 'gnus-thread
2239   :type '(choice (const :tag "off" nil)
2240                  (const some)
2241                  number
2242                  (sexp :menu-tag "other" t)))
2243
2244 ;; Enter a group that is not in the group buffer.  Non-nil is returned
2245 ;; if selection was successful.
2246 (defun gnus-group-read-ephemeral-group (group method &optional activate
2247                                               quit-config request-only
2248                                               select-articles
2249                                               parameters
2250                                               number)
2251   "Read GROUP from METHOD as an ephemeral group.
2252 If ACTIVATE, request the group first.
2253 If QUIT-CONFIG, use that window configuration when exiting from the
2254 ephemeral group.
2255 If REQUEST-ONLY, don't actually read the group; just request it.
2256 If SELECT-ARTICLES, only select those articles.
2257 If PARAMETERS, use those as the group parameters.
2258 If NUMBER, fetch this number of articles.
2259
2260 Return the name of the group if selection was successful."
2261   (interactive
2262    (list
2263     ;; (gnus-read-group "Group name: ")
2264     (gnus-group-completing-read)
2265     (gnus-read-method "From method: ")))
2266   ;; Transform the select method into a unique server.
2267   (when (stringp method)
2268     (setq method (gnus-server-to-method method)))
2269   (setq method
2270         `(,(car method) ,(concat (cadr method) "-ephemeral")
2271           (,(intern (format "%s-address" (car method))) ,(cadr method))
2272           ,@(cddr method)))
2273   (let ((group (if (gnus-group-foreign-p group) group
2274                  (gnus-group-prefixed-name (gnus-group-real-name group)
2275                                            method))))
2276     (gnus-sethash
2277      group
2278      `(-1 nil (,group
2279                ,gnus-level-default-subscribed nil nil ,method
2280                ,(cons
2281                  (if quit-config
2282                      (cons 'quit-config quit-config)
2283                    (cons 'quit-config
2284                          (cons gnus-summary-buffer
2285                                gnus-current-window-configuration)))
2286                  parameters)))
2287      gnus-newsrc-hashtb)
2288     (push method gnus-ephemeral-servers)
2289     (set-buffer gnus-group-buffer)
2290     (unless (gnus-check-server method)
2291       (error "Unable to contact server: %s" (gnus-status-message method)))
2292     (when activate
2293       (gnus-activate-group group 'scan)
2294       (unless (gnus-request-group group)
2295         (error "Couldn't request group: %s"
2296                (nnheader-get-report (car method)))))
2297     (if request-only
2298         group
2299       (condition-case ()
2300           (when (let ((gnus-large-newsgroup gnus-large-ephemeral-newsgroup)
2301                       (gnus-fetch-old-headers
2302                        gnus-fetch-old-ephemeral-headers))
2303                   (gnus-group-read-group (or number t) t group select-articles))
2304             group)
2305         ;;(error nil)
2306         (quit
2307          (message "Quit reading the ephemeral group")
2308          nil)))))
2309
2310 (defcustom gnus-gmane-group-download-format
2311   "http://download.gmane.org/%s/%s/%s"
2312   "URL for downloading mbox files.
2313 It must contain three \"%s\".  They correspond to the group, the
2314 minimal and maximal article numbers, respectively."
2315   :group 'gnus-group-foreign
2316   :version "23.1" ;; No Gnus
2317   :type 'string)
2318
2319 (autoload 'url-insert-file-contents "url-handlers")
2320 ;; FIXME:
2321 ;; - Add documentation, menu, key bindings, ...
2322
2323 (defun gnus-read-ephemeral-gmane-group (group start &optional range)
2324   "Read articles from Gmane group GROUP as an ephemeral group.
2325 START is the first article.  RANGE specifies how many articles
2326 are fetched.  The articles are downloaded via HTTP using the URL
2327 specified by `gnus-gmane-group-download-format'."
2328   ;; See <http://gmane.org/export.php> for more information.
2329   (interactive
2330    (list
2331     (gnus-group-completing-read "Gmane group")
2332     (read-number "Start article number: ")
2333     (read-number "How many articles: ")))
2334   (unless range (setq range 500))
2335   (when (< range 1)
2336     (error "Invalid range: %s" range))
2337   (let ((tmpfile (mm-make-temp-file
2338                   (format "%s.start-%s.range-%s." group start range)))
2339         (gnus-thread-sort-functions '(gnus-thread-sort-by-number)))
2340     (with-temp-file tmpfile
2341       (url-insert-file-contents
2342        (format gnus-gmane-group-download-format
2343                group start (+ start range)))
2344       (write-region (point-min) (point-max) tmpfile)
2345       (gnus-group-read-ephemeral-group
2346        (format "%s.start-%s.range-%s" group start range)
2347        `(nndoc ,tmpfile
2348                (nndoc-article-type mbox))))
2349     (delete-file tmpfile)))
2350
2351 (defun gnus-read-ephemeral-gmane-group-url (url)
2352   "Create an ephemeral Gmane group from URL.
2353
2354 Valid input formats include:
2355 \"http://thread.gmane.org/gmane.foo.bar/12300/focus=12399\",
2356 \"http://thread.gmane.org/gmane.foo.bar/12345/\",
2357 \"http://article.gmane.org/gmane.foo.bar/12345/\",
2358 \"http://news.gmane.org/group/gmane.foo.bar/thread=12345\""
2359   ;; - Feel free to add other useful Gmane URLs here!  Maybe the URLs should
2360   ;;   be customizable?
2361   ;; - The URLs should be added to `gnus-button-alist'.  Probably we should
2362   ;;   prompt the user to decide: "View via `browse-url' or in Gnus? "
2363   ;;   (`gnus-read-ephemeral-gmane-group-url')
2364   (interactive
2365    (list (gnus-group-completing-read "Gmane URL")))
2366   (let (group start range)
2367     (cond
2368      ;; URLs providing `group', `start' and `range':
2369      ((string-match
2370        ;; http://thread.gmane.org/gmane.emacs.devel/86326/focus=86525
2371        "^http://thread\.gmane\.org/\\([^/]+\\)/\\([0-9]+\\)/focus=\\([0-9]+\\)$"
2372        url)
2373       (setq group (match-string 1 url)
2374             start (string-to-number (match-string 2 url))
2375             ;; Ensure that `range' is large enough to ensure focus article is
2376             ;; included.
2377             range (- (string-to-number (match-string 3 url))
2378                      start -1)))
2379      ;; URLs providing `group' and `start':
2380      ((or (string-match
2381            ;; http://article.gmane.org/gmane.comp.gnu.make.bugs/3584
2382            "^http://\\(?:thread\\|article\\|permalink\\)\.gmane\.org/\\([^/]+\\)/\\([0-9]+\\)"
2383            url)
2384           (string-match
2385            ;; Don't advertise these in the doc string yet:
2386            "^\\(?:nntp\\|news\\)://news\.gmane\.org/\\([^/]+\\)/\\([0-9]+\\)"
2387            url)
2388           (string-match
2389            ;; http://news.gmane.org/group/gmane.emacs.gnus.general/thread=65099/force_load=t
2390            "^http://news\.gmane\.org/group/\\([^/]+\\)/thread=\\([0-9]+\\)"
2391            url))
2392       (setq group (match-string 1 url)
2393             start (string-to-number (match-string 2 url))))
2394      (t
2395       (error "Can't parse URL %s" url)))
2396     (gnus-read-ephemeral-gmane-group group start range)))
2397
2398 (defcustom gnus-bug-group-download-format-alist
2399   '((emacs . "http://debbugs.gnu.org/%s;mbox=yes")
2400     (debian
2401      . "http://bugs.debian.org/cgi-bin/bugreport.cgi?bug=%s&mbox=yes"))
2402   "Alist of symbols for bug trackers and the corresponding URL format string.
2403 The URL format string must contain a single \"%s\", specifying
2404 the bug number, and browsing the URL must return mbox output."
2405   :group 'gnus-group-foreign
2406   :version "23.2" ;; No Gnus
2407   :type '(repeat (cons (symbol) (string :tag "URL format string"))))
2408
2409 (defun gnus-read-ephemeral-bug-group (number mbox-url)
2410   "Browse bug NUMBER as ephemeral group."
2411   (interactive (list (read-string "Enter bug number: "
2412                                   (thing-at-point 'word) nil)
2413                      ;; FIXME: Add completing-read from
2414                      ;; `gnus-emacs-bug-group-download-format' ...
2415                      (cdr (assoc 'emacs gnus-bug-group-download-format-alist))))
2416   (when (stringp number)
2417     (setq number (string-to-number number)))
2418   (let ((tmpfile (mm-make-temp-file "gnus-temp-group-")))
2419     (with-temp-file tmpfile
2420       (url-insert-file-contents (format mbox-url number))
2421       (goto-char (point-min))
2422       ;; Add the debbugs address so that we can respond to reports easily.
2423       (while (re-search-forward "^To: " nil t)
2424         (end-of-line)
2425         (insert (format ", %s@%s" number
2426                         (replace-regexp-in-string
2427                          "/.*$" ""
2428                          (replace-regexp-in-string "^http://" "" mbox-url)))))
2429       (write-region (point-min) (point-max) tmpfile)
2430       (gnus-group-read-ephemeral-group
2431        "gnus-read-ephemeral-bug"
2432        `(nndoc ,tmpfile
2433                (nndoc-article-type mbox))))
2434     (delete-file tmpfile)))
2435
2436 (defun gnus-read-ephemeral-debian-bug-group (number)
2437   "Browse Debian bug NUMBER as ephemeral group."
2438   (interactive (list (read-string "Enter bug number: "
2439                                   (thing-at-point 'word) nil)))
2440   (gnus-read-ephemeral-bug-group
2441    number
2442    (cdr (assoc 'debian gnus-bug-group-download-format-alist))))
2443
2444 (defun gnus-read-ephemeral-emacs-bug-group (number)
2445   "Browse Emacs bug NUMBER as ephemeral group."
2446   (interactive (list (read-string "Enter bug number: "
2447                                   (thing-at-point 'word) nil)))
2448   (gnus-read-ephemeral-bug-group
2449    number
2450    (cdr (assoc 'emacs gnus-bug-group-download-format-alist))))
2451
2452 (defun gnus-group-jump-to-group (group &optional prompt)
2453   "Jump to newsgroup GROUP.
2454
2455 If PROMPT (the prefix) is a number, use the prompt specified in
2456 `gnus-group-jump-to-group-prompt'."
2457   (interactive
2458    (list (gnus-group-completing-read
2459           nil nil (gnus-read-active-file-p)
2460           (if current-prefix-arg
2461               (cdr (assq current-prefix-arg gnus-group-jump-to-group-prompt))
2462             (or (and (stringp gnus-group-jump-to-group-prompt)
2463                      gnus-group-jump-to-group-prompt)
2464                 (let ((p (cdr (assq 0 gnus-group-jump-to-group-prompt))))
2465                   (and (stringp p) p)))))))
2466
2467   (when (equal group "")
2468     (error "Empty group name"))
2469
2470   (unless (gnus-ephemeral-group-p group)
2471     ;; Either go to the line in the group buffer...
2472     (unless (gnus-group-goto-group group)
2473       ;; ... or insert the line.
2474       (gnus-group-update-group group)
2475       (gnus-group-goto-group group)))
2476   ;; Adjust cursor point.
2477   (gnus-group-position-point))
2478
2479 (defun gnus-group-goto-group (group &optional far test-marked)
2480   "Goto to newsgroup GROUP.
2481 If FAR, it is likely that the group is not on the current line.
2482 If TEST-MARKED, the line must be marked."
2483   (when group
2484     (beginning-of-line)
2485     (cond
2486      ;; It's quite likely that we are on the right line, so
2487      ;; we check the current line first.
2488      ((and (not far)
2489            (eq (get-text-property (point) 'gnus-group)
2490                (gnus-intern-safe group gnus-active-hashtb))
2491            (or (not test-marked) (gnus-group-mark-line-p)))
2492       (point))
2493      ;; Previous and next line are also likely, so we check them as well.
2494      ((and (not far)
2495            (save-excursion
2496              (forward-line -1)
2497              (and (eq (get-text-property (point) 'gnus-group)
2498                       (gnus-intern-safe group gnus-active-hashtb))
2499                   (or (not test-marked) (gnus-group-mark-line-p)))))
2500       (forward-line -1)
2501       (point))
2502      ((and (not far)
2503            (save-excursion
2504              (forward-line 1)
2505              (and (eq (get-text-property (point) 'gnus-group)
2506                       (gnus-intern-safe group gnus-active-hashtb))
2507                   (or (not test-marked) (gnus-group-mark-line-p)))))
2508       (forward-line 1)
2509       (point))
2510      (test-marked
2511       (goto-char (point-min))
2512       (let (found)
2513         (while (and (not found)
2514                     (gnus-goto-char
2515                      (text-property-any
2516                       (point) (point-max)
2517                       'gnus-group
2518                       (gnus-intern-safe group gnus-active-hashtb))))
2519           (if (gnus-group-mark-line-p)
2520               (setq found t)
2521             (forward-line 1)))
2522         found))
2523      (t
2524       ;; Search through the entire buffer.
2525       (gnus-goto-char
2526        (text-property-any
2527         (point-min) (point-max)
2528         'gnus-group (gnus-intern-safe group gnus-active-hashtb)))))))
2529
2530 (defun gnus-group-next-group (n &optional silent)
2531   "Go to next N'th newsgroup.
2532 If N is negative, search backward instead.
2533 Returns the difference between N and the number of skips actually
2534 done."
2535   (interactive "p")
2536   (gnus-group-next-unread-group n t nil silent))
2537
2538 (defun gnus-group-next-unread-group (n &optional all level silent)
2539   "Go to next N'th unread newsgroup.
2540 If N is negative, search backward instead.
2541 If ALL is non-nil, choose any newsgroup, unread or not.
2542 If LEVEL is non-nil, choose the next group with level LEVEL, or, if no
2543 such group can be found, the next group with a level higher than
2544 LEVEL.
2545 Returns the difference between N and the number of skips actually
2546 made."
2547   (interactive "p")
2548   (let ((backward (< n 0))
2549         (n (abs n)))
2550     (while (and (> n 0)
2551                 (gnus-group-search-forward
2552                  backward (or (not gnus-group-goto-unread) all) level))
2553       (setq n (1- n)))
2554     (when (and (/= 0 n)
2555                (not silent))
2556       (gnus-message 7 "No more%s newsgroups%s" (if all "" " unread")
2557                     (if level " on this level or higher" "")))
2558     n))
2559
2560 (defun gnus-group-prev-group (n)
2561   "Go to previous N'th newsgroup.
2562 Returns the difference between N and the number of skips actually
2563 done."
2564   (interactive "p")
2565   (gnus-group-next-unread-group (- n) t))
2566
2567 (defun gnus-group-prev-unread-group (n)
2568   "Go to previous N'th unread newsgroup.
2569 Returns the difference between N and the number of skips actually
2570 done."
2571   (interactive "p")
2572   (gnus-group-next-unread-group (- n)))
2573
2574 (defun gnus-group-next-unread-group-same-level (n)
2575   "Go to next N'th unread newsgroup on the same level.
2576 If N is negative, search backward instead.
2577 Returns the difference between N and the number of skips actually
2578 done."
2579   (interactive "p")
2580   (gnus-group-next-unread-group n t (gnus-group-group-level))
2581   (gnus-group-position-point))
2582
2583 (defun gnus-group-prev-unread-group-same-level (n)
2584   "Go to next N'th unread newsgroup on the same level.
2585 Returns the difference between N and the number of skips actually
2586 done."
2587   (interactive "p")
2588   (gnus-group-next-unread-group (- n) t (gnus-group-group-level))
2589   (gnus-group-position-point))
2590
2591 (defun gnus-group-best-unread-group (&optional exclude-group)
2592   "Go to the group with the highest level.
2593 If EXCLUDE-GROUP, do not go to that group."
2594   (interactive)
2595   (goto-char (point-min))
2596   (let ((best 100000)
2597         unread best-point)
2598     (while (not (eobp))
2599       (setq unread (get-text-property (point) 'gnus-unread))
2600       (when (and (numberp unread) (> unread 0))
2601         (when (and (get-text-property (point) 'gnus-level)
2602                    (< (get-text-property (point) 'gnus-level) best)
2603                    (or (not exclude-group)
2604                        (not (equal exclude-group (gnus-group-group-name)))))
2605           (setq best (get-text-property (point) 'gnus-level))
2606           (setq best-point (point))))
2607       (forward-line 1))
2608     (when best-point
2609       (goto-char best-point))
2610     (gnus-group-position-point)
2611     (and best-point (gnus-group-group-name))))
2612
2613 ;; Is there something like an after-point-motion-hook?
2614 ;; (inhibit-point-motion-hooks?).  Is there a tool-bar-update function?
2615
2616 ;; (defun gnus-group-menu-bar-update ()
2617 ;;   (let* ((buf (list (with-current-buffer gnus-group-buffer
2618 ;;                    (current-buffer))))
2619 ;;       (name (buffer-name (car buf))))
2620 ;;     (setcdr buf
2621 ;;          (if (> (length name) 27)
2622 ;;              (concat (substring name 0 12)
2623 ;;                      "..."
2624 ;;                      (substring name -12))
2625 ;;            name))
2626 ;;     (menu-bar-update-buffers-1 buf)))
2627
2628 ;; (defun gnus-group-position-point ()
2629 ;;   (gnus-goto-colon)
2630 ;;   (gnus-group-menu-bar-update))
2631
2632 (defun gnus-group-first-unread-group ()
2633   "Go to the first group with unread articles."
2634   (interactive)
2635   (prog1
2636       (let ((opoint (point))
2637             unread)
2638         (goto-char (point-min))
2639         (if (or (eq (setq unread (gnus-group-group-unread)) t) ; Not active.
2640                 (and (numberp unread)   ; Not a topic.
2641                      (not (zerop unread))) ; Has unread articles.
2642                 (zerop (gnus-group-next-unread-group 1))) ; Next unread group.
2643             (point)                     ; Success.
2644           (goto-char opoint)
2645           nil))                         ; Not success.
2646     (gnus-group-position-point)))
2647
2648 (defun gnus-group-enter-server-mode ()
2649   "Jump to the server buffer."
2650   (interactive)
2651   (gnus-enter-server-buffer))
2652
2653 (defun gnus-group-make-group-simple (&optional group)
2654   "Add a new newsgroup.
2655 The user will be prompted for GROUP."
2656   (interactive (list (gnus-group-completing-read)))
2657   (gnus-group-make-group (gnus-group-real-name group)
2658                          (gnus-group-server group)
2659                          nil nil t))
2660
2661 (defun gnus-group-make-group (name &optional method address args encoded)
2662   "Add a new newsgroup.
2663 The user will be prompted for a NAME, for a select METHOD, and an
2664 ADDRESS.  NAME should be a human-readable string (i.e., not be encoded
2665 even if it contains non-ASCII characters) unless ENCODED is non-nil.
2666
2667 If the backend supports it, the group will also be created on the
2668 server."
2669   (interactive
2670    (list
2671     (gnus-read-group "Group name: ")
2672     (gnus-read-method "From method: ")))
2673
2674   (when (stringp method)
2675     (setq method (or (gnus-server-to-method method) method)))
2676   (unless encoded
2677     (setq name (mm-encode-coding-string
2678                 name
2679                 (gnus-group-name-charset method name))))
2680   (let* ((meth (gnus-method-simplify
2681                 (when (and method
2682                            (not (gnus-server-equal method gnus-select-method)))
2683                   (if address (list (intern method) address)
2684                     method))))
2685          (nname (if method (gnus-group-prefixed-name name meth) name))
2686          backend info)
2687     (when (gnus-group-entry nname)
2688       (error "Group %s already exists" (gnus-group-decoded-name nname)))
2689     ;; Subscribe to the new group.
2690     (gnus-group-change-level
2691      (setq info (list t nname gnus-level-default-subscribed nil nil meth))
2692      gnus-level-default-subscribed gnus-level-killed
2693      (and (gnus-group-group-name)
2694           (gnus-group-entry (gnus-group-group-name)))
2695      t)
2696     ;; Make it active.
2697     (gnus-set-active nname (cons 1 0))
2698     (unless (gnus-ephemeral-group-p name)
2699       (gnus-dribble-enter
2700        (concat "(gnus-group-set-info '"
2701                (gnus-prin1-to-string (cdr info)) ")")))
2702     ;; Insert the line.
2703     (gnus-group-insert-group-line-info nname)
2704     (forward-line -1)
2705     (gnus-group-position-point)
2706
2707     ;; Load the back end and try to make the back end create
2708     ;; the group as well.
2709     (when (assoc (symbol-name (setq backend (car (gnus-server-get-method
2710                                                   nil meth))))
2711                  gnus-valid-select-methods)
2712       (require backend))
2713     (gnus-check-server meth)
2714     (when (gnus-check-backend-function 'request-create-group nname)
2715       (unless (gnus-request-create-group nname nil args)
2716         (error "Could not create group on server: %s"
2717                (nnheader-get-report backend))))
2718     t))
2719
2720 (defun gnus-group-delete-groups (&optional arg)
2721   "Delete the current group.  Only meaningful with editable groups."
2722   (interactive "P")
2723   (let ((n (length (gnus-group-process-prefix arg))))
2724     (when (gnus-yes-or-no-p
2725            (if (= n 1)
2726                "Delete this 1 group? "
2727              (format "Delete these %d groups? " n)))
2728       (gnus-group-iterate arg
2729         (lambda (group)
2730           (gnus-group-delete-group group nil t))))))
2731
2732 (defun gnus-group-delete-group (group &optional force no-prompt)
2733   "Delete the current group.  Only meaningful with editable groups.
2734 If FORCE (the prefix) is non-nil, all the articles in the group will
2735 be deleted.  This is \"deleted\" as in \"removed forever from the face
2736 of the Earth\".  There is no undo.  The user will be prompted before
2737 doing the deletion.
2738 Note that you also have to specify FORCE if you want the group to
2739 be removed from the server, even when it's empty."
2740   (interactive
2741    (list (gnus-group-group-name)
2742          current-prefix-arg))
2743   (unless group
2744     (error "No group to delete"))
2745   (unless (gnus-check-backend-function 'request-delete-group group)
2746     (error "This back end does not support group deletion"))
2747   (prog1
2748       (let ((group-decoded (gnus-group-decoded-name group)))
2749         (if (and (not no-prompt)
2750                  (not (gnus-yes-or-no-p
2751                        (format
2752                         "Do you really want to delete %s%s? "
2753                         group-decoded (if force " and all its contents" "")))))
2754             ()                          ; Whew!
2755           (gnus-message 6 "Deleting group %s..." group-decoded)
2756           (if (not (gnus-request-delete-group group force))
2757               (gnus-error 3 "Couldn't delete group %s" group-decoded)
2758             (gnus-message 6 "Deleting group %s...done" group-decoded)
2759             (gnus-group-goto-group group)
2760             (gnus-group-kill-group 1 t)
2761             (gnus-set-active group nil)
2762             t)))
2763     (gnus-group-position-point)))
2764
2765 (defun gnus-group-rename-group (group new-name)
2766   "Rename group from GROUP to NEW-NAME.
2767 When used interactively, GROUP is the group under point
2768 and NEW-NAME will be prompted for."
2769   (interactive
2770    (let ((group (gnus-group-group-name))
2771          method new-name)
2772      (unless (gnus-check-backend-function 'request-rename-group group)
2773        (error "This back end does not support renaming groups"))
2774      (setq new-name (gnus-read-group
2775                      "Rename group to: "
2776                      (gnus-group-real-name (gnus-group-decoded-name group)))
2777            method (gnus-info-method (gnus-get-info group)))
2778      (list group (mm-encode-coding-string
2779                   new-name
2780                   (gnus-group-name-charset
2781                    method
2782                    (gnus-group-prefixed-name new-name method))))))
2783
2784   (unless (gnus-check-backend-function 'request-rename-group group)
2785     (error "This back end does not support renaming groups"))
2786   (unless group
2787     (error "No group to rename"))
2788   (when (equal (gnus-group-real-name group) new-name)
2789     (error "Can't rename to the same name"))
2790
2791   ;; We find the proper prefixed name.
2792   (setq new-name
2793         (if (gnus-group-native-p group)
2794             ;; Native group.
2795             new-name
2796           ;; Foreign group.
2797           (gnus-group-prefixed-name
2798            (gnus-group-real-name new-name)
2799            (gnus-info-method (gnus-get-info group)))))
2800
2801   (let ((decoded-group (gnus-group-decoded-name group))
2802         (decoded-new-name (gnus-group-decoded-name new-name)))
2803     (when (gnus-active new-name)
2804       (error "The group %s already exists" decoded-new-name))
2805
2806     (gnus-message 6 "Renaming group %s to %s..."
2807                   decoded-group decoded-new-name)
2808     (prog1
2809         (if (progn
2810               (gnus-group-goto-group group)
2811               (not (when (< (gnus-group-group-level) gnus-level-zombie)
2812                      (gnus-request-rename-group group new-name))))
2813             (gnus-error 3 "Couldn't rename group %s to %s"
2814                         decoded-group decoded-new-name)
2815           ;; We rename the group internally by killing it...
2816           (gnus-group-kill-group)
2817           ;; ... changing its name ...
2818           (setcar (cdar gnus-list-of-killed-groups) new-name)
2819           ;; ... and then yanking it.  Magic!
2820           (gnus-group-yank-group)
2821           (gnus-set-active new-name (gnus-active group))
2822           (gnus-message 6 "Renaming group %s to %s...done"
2823                         decoded-group decoded-new-name)
2824           new-name)
2825       (setq gnus-killed-list (delete group gnus-killed-list))
2826       (gnus-set-active group nil)
2827       (gnus-dribble-touch)
2828       (gnus-group-position-point))))
2829
2830 (defun gnus-group-edit-group (group &optional part)
2831   "Edit the group on the current line."
2832   (interactive (list (gnus-group-group-name)))
2833   (let ((part (or part 'info))
2834         info)
2835     (unless group
2836       (error "No group on current line"))
2837     (unless (setq info (gnus-get-info group))
2838       (error "Killed group; can't be edited"))
2839     (ignore-errors
2840       (gnus-close-group group))
2841     (gnus-edit-form
2842      ;; Find the proper form to edit.
2843      (cond ((eq part 'method)
2844             (or (gnus-info-method info) "native"))
2845            ((eq part 'params)
2846             (gnus-info-params info))
2847            (t info))
2848      ;; The proper documentation.
2849      (format
2850       "Editing the %s for `%s'."
2851       (cond
2852        ((eq part 'method) "select method")
2853        ((eq part 'params) "group parameters")
2854        (t "group info"))
2855       (gnus-group-decoded-name group))
2856      `(lambda (form)
2857         (gnus-group-edit-group-done ',part ,group form)))
2858     (local-set-key
2859      "\C-c\C-i"
2860      (gnus-create-info-command
2861       (cond
2862        ((eq part 'method)
2863         "(gnus)Select Methods")
2864        ((eq part 'params)
2865         "(gnus)Group Parameters")
2866        (t
2867         "(gnus)Group Info"))))))
2868
2869 (defun gnus-group-edit-group-method (group)
2870   "Edit the select method of GROUP."
2871   (interactive (list (gnus-group-group-name)))
2872   (gnus-group-edit-group group 'method))
2873
2874 (defun gnus-group-edit-group-parameters (group)
2875   "Edit the group parameters of GROUP."
2876   (interactive (list (gnus-group-group-name)))
2877   (gnus-group-edit-group group 'params))
2878
2879 (defun gnus-group-edit-group-done (part group form)
2880   "Update variables."
2881   (let* ((method (cond ((eq part 'info) (nth 4 form))
2882                        ((eq part 'method) form)
2883                        (t nil)))
2884          (info (cond ((eq part 'info) form)
2885                      ((eq part 'method) (gnus-get-info group))
2886                      (t nil)))
2887          (new-group (if info
2888                         (if (or (not method)
2889                                 (gnus-server-equal
2890                                  gnus-select-method method))
2891                             (gnus-group-real-name (car info))
2892                           (gnus-group-prefixed-name
2893                            (gnus-group-real-name (car info)) method))
2894                       nil)))
2895     (when (and new-group
2896                (not (equal new-group group)))
2897       (when (gnus-group-goto-group group)
2898         (gnus-group-kill-group 1))
2899       (gnus-activate-group new-group))
2900     ;; Set the info.
2901     (if (not (and info new-group))
2902         (gnus-group-set-info form (or new-group group) part)
2903       (setq info (gnus-copy-sequence info))
2904       (setcar info new-group)
2905       (unless (gnus-server-equal method "native")
2906         (unless (nthcdr 3 info)
2907           (nconc info (list nil nil)))
2908         (unless (nthcdr 4 info)
2909           (nconc info (list nil)))
2910         (gnus-info-set-method info method))
2911       (gnus-group-set-info info))
2912     (gnus-group-update-group (or new-group group))
2913     (gnus-group-position-point)))
2914
2915 (defun gnus-group-make-useful-group (group method)
2916   "Create one of the groups described in `gnus-useful-groups'."
2917   (interactive
2918    (let ((entry (assoc (gnus-completing-read "Create group"
2919                                              (mapcar 'car gnus-useful-groups)
2920                                              t)
2921                        gnus-useful-groups)))
2922      (list (cadr entry)
2923            ;; Don't use `caddr' here since macros within the `interactive'
2924            ;; form won't be expanded.
2925            (car (cddr entry)))))
2926   (setq method (gnus-copy-sequence method))
2927   (let (entry)
2928     (while (setq entry (memq (assq 'eval method) method))
2929       (setcar entry (eval (cadar entry)))))
2930   (gnus-group-make-group group method))
2931
2932 (defun gnus-group-make-help-group (&optional noerror)
2933   "Create the Gnus documentation group.
2934 Optional argument NOERROR modifies the behavior of this function when the
2935 group already exists:
2936 - if not given, and error is signaled,
2937 - if t, stay silent,
2938 - if anything else, just print a message."
2939   (interactive)
2940   (let ((name (gnus-group-prefixed-name "gnus-help" '(nndoc "gnus-help")))
2941         (file (nnheader-find-etc-directory "gnus-tut.txt" t)))
2942     (if (gnus-group-entry name)
2943         (cond ((eq noerror nil)
2944                (error "Documentation group already exists"))
2945               ((eq noerror t)
2946                ;; stay silent
2947                )
2948               (t
2949                (gnus-message 1 "Documentation group already exists")))
2950       ;; else:
2951       (if (not file)
2952           (gnus-message 1 "Couldn't find doc group")
2953         (gnus-group-make-group
2954          (gnus-group-real-name name)
2955          (list 'nndoc "gnus-help"
2956                (list 'nndoc-address file)
2957                (list 'nndoc-article-type 'mbox))))
2958       ))
2959   (gnus-group-position-point))
2960
2961 (defun gnus-group-make-doc-group (file type)
2962   "Create a group that uses a single file as the source.
2963
2964 If called with a prefix argument, ask for the file type."
2965   (interactive
2966    (list (read-file-name "File name: ")
2967          (and current-prefix-arg 'ask)))
2968   (when (eq type 'ask)
2969     (let ((err "")
2970           char found)
2971       (while (not found)
2972         (message
2973          "%sFile type (mbox, babyl, digest, forward, mmdf, guess) [m, b, d, f, a, g]: "
2974          err)
2975         (setq found (cond ((= (setq char (read-char)) ?m) 'mbox)
2976                           ((= char ?b) 'babyl)
2977                           ((= char ?d) 'digest)
2978                           ((= char ?f) 'forward)
2979                           ((= char ?a) 'mmfd)
2980                           ((= char ?g) 'guess)
2981                           (t (setq err (format "%c unknown. " char))
2982                              nil))))
2983       (setq type found)))
2984   (setq file (expand-file-name file))
2985   (let* ((name (gnus-generate-new-group-name
2986                 (gnus-group-prefixed-name
2987                  (file-name-nondirectory file) '(nndoc ""))))
2988          (method (list 'nndoc file
2989                        (list 'nndoc-address file)
2990                        (list 'nndoc-article-type (or type 'guess))))
2991          (coding (gnus-group-name-charset method name)))
2992     (setcar (cdr method) (mm-encode-coding-string file coding))
2993     (gnus-group-make-group
2994      (mm-encode-coding-string (gnus-group-real-name name) coding)
2995      method nil nil t)))
2996
2997 (defvar nnweb-type-definition)
2998 (defvar gnus-group-web-type-history nil)
2999 (defvar gnus-group-web-search-history nil)
3000 (defun gnus-group-make-web-group (&optional solid)
3001   "Create an ephemeral nnweb group.
3002 If SOLID (the prefix), create a solid group."
3003   (interactive "P")
3004   (require 'nnweb)
3005   (let* ((group
3006           (if solid (gnus-read-group "Group name: ")
3007             (message-unique-id)))
3008          (default-type (or (car gnus-group-web-type-history)
3009                            (symbol-name (caar nnweb-type-definition))))
3010          (type
3011           (gnus-string-or
3012            (gnus-completing-read
3013             "Search engine type"
3014             (mapcar (lambda (elem) (symbol-name (car elem)))
3015                     nnweb-type-definition)
3016             t nil 'gnus-group-web-type-history)
3017            default-type))
3018          (search
3019           (read-string
3020            "Search string: "
3021            (cons (or (car gnus-group-web-search-history) "") 0)
3022            'gnus-group-web-search-history))
3023          (method
3024           `(nnweb ,group (nnweb-search ,search)
3025                   (nnweb-type ,(intern type))
3026                   (nnweb-ephemeral-p t))))
3027     (if solid
3028         (progn
3029           (gnus-alist-pull 'nnweb-ephemeral-p method)
3030           (gnus-group-make-group group method))
3031       (gnus-group-read-ephemeral-group
3032        group method t
3033        (cons (current-buffer)
3034              (if (eq major-mode 'gnus-summary-mode) 'summary 'group))))))
3035
3036 (defvar nnrss-group-alist)
3037 (eval-when-compile
3038   (defun nnrss-discover-feed (arg))
3039   (defun nnrss-save-server-data (arg)))
3040 (defun gnus-group-make-rss-group (&optional url)
3041   "Given a URL, discover if there is an RSS feed.
3042 If there is, use Gnus to create an nnrss group"
3043   (interactive)
3044   (require 'nnrss)
3045   (if (not url)
3046       (setq url (read-from-minibuffer "URL to Search for RSS: ")))
3047   (let ((feedinfo (nnrss-discover-feed url)))
3048     (if feedinfo
3049         (let* ((title (gnus-newsgroup-savable-name
3050                        (read-from-minibuffer "Title: "
3051                                              (gnus-newsgroup-savable-name
3052                                               (mapconcat
3053                                                'identity
3054                                                (split-string
3055                                                 (or (cdr (assoc 'title
3056                                                                 feedinfo))
3057                                                     ""))
3058                                                " ")))))
3059                (desc  (read-from-minibuffer "Description: "
3060                                             (mapconcat
3061                                              'identity
3062                                              (split-string
3063                                               (or (cdr (assoc 'description
3064                                                               feedinfo))
3065                                                   ""))
3066                                              " ")))
3067                (href (cdr (assoc 'href feedinfo)))
3068                (coding (gnus-group-name-charset '(nnrss "") title)))
3069           (when coding
3070             ;; Unify non-ASCII text.
3071             (setq title (mm-decode-coding-string
3072                          (mm-encode-coding-string title coding)
3073                          coding)))
3074           (gnus-group-make-group title '(nnrss ""))
3075           (push (list title href desc) nnrss-group-alist)
3076           (nnrss-save-server-data nil))
3077       (error "No feeds found for %s" url))))
3078
3079 (defun gnus-group-make-directory-group (dir)
3080   "Create an nndir group.
3081 The user will be prompted for a directory.  The contents of this
3082 directory will be used as a newsgroup.  The directory should contain
3083 mail messages or news articles in files that have numeric names."
3084   (interactive
3085    (list (read-file-name "Create group from directory: ")))
3086   (unless (file-exists-p dir)
3087     (error "No such directory"))
3088   (unless (file-directory-p dir)
3089     (error "Not a directory"))
3090   (let ((ext "")
3091         (i 0)
3092         group)
3093     (while (or (not group) (gnus-group-entry group))
3094       (setq group
3095             (gnus-group-prefixed-name
3096              (expand-file-name ext dir)
3097              '(nndir "")))
3098       (setq ext (format "<%d>" (setq i (1+ i)))))
3099     (gnus-group-make-group
3100      (gnus-group-real-name group)
3101      (list 'nndir (gnus-group-real-name group) (list 'nndir-directory dir)))))
3102
3103 (defun gnus-group-add-to-virtual (n vgroup)
3104   "Add the current group to a virtual group."
3105   (interactive
3106    (list current-prefix-arg
3107          (gnus-group-completing-read "Add to virtual group"
3108                                      nil t "nnvirtual:")))
3109   (unless (eq (car (gnus-find-method-for-group vgroup)) 'nnvirtual)
3110     (error "%s is not an nnvirtual group" vgroup))
3111   (gnus-close-group vgroup)
3112   (let* ((groups (gnus-group-process-prefix n))
3113          (method (gnus-info-method (gnus-get-info vgroup))))
3114     (setcar (cdr method)
3115             (concat
3116              (nth 1 method) "\\|"
3117              (mapconcat
3118               (lambda (s)
3119                 (gnus-group-remove-mark s)
3120                 (concat "\\(^" (regexp-quote s) "$\\)"))
3121               groups "\\|"))))
3122   (gnus-group-position-point))
3123
3124 (defun gnus-group-make-empty-virtual (group)
3125   "Create a new, fresh, empty virtual group."
3126   (interactive "sCreate new, empty virtual group: ")
3127   (let* ((method (list 'nnvirtual "^$"))
3128          (pgroup (gnus-group-prefixed-name group method)))
3129     ;; Check whether it exists already.
3130     (when (gnus-group-entry pgroup)
3131       (error "Group %s already exists" pgroup))
3132     ;; Subscribe the new group after the group on the current line.
3133     (gnus-subscribe-group pgroup (gnus-group-group-name) method)
3134     (gnus-group-update-group pgroup)
3135     (forward-line -1)
3136     (gnus-group-position-point)))
3137
3138 (defun gnus-group-enter-directory (dir)
3139   "Enter an ephemeral nneething group."
3140   (interactive "DDirectory to read: ")
3141   (let* ((method (list 'nneething dir '(nneething-read-only t)))
3142          (leaf (gnus-group-prefixed-name
3143                 (file-name-nondirectory (directory-file-name dir))
3144                 method))
3145          (name (gnus-generate-new-group-name leaf)))
3146     (unless (gnus-group-read-ephemeral-group
3147              name method t
3148              (cons (current-buffer)
3149                    (if (eq major-mode 'gnus-summary-mode)
3150                        'summary 'group)))
3151       (error "Couldn't enter %s" dir))))
3152
3153 (defun gnus-group-expunge-group (group)
3154   "Expunge deleted articles in current nnimap GROUP."
3155   (interactive (list (gnus-group-group-name)))
3156   (let ((method (gnus-find-method-for-group group)))
3157     (if (not (gnus-check-backend-function
3158               'request-expunge-group (car method)))
3159         (error "%s does not support expunging" (car method))
3160       (gnus-request-expunge-group group method))))
3161
3162 (autoload 'nnimap-acl-get "nnimap")
3163 (autoload 'nnimap-acl-edit "nnimap")
3164
3165 (defun gnus-group-nnimap-edit-acl (group)
3166   "Edit the Access Control List of current nnimap GROUP."
3167   (interactive (list (gnus-group-group-name)))
3168   (let ((mailbox (gnus-group-real-name group)) method acl)
3169     (unless group
3170       (error "No group on current line"))
3171     (unless (gnus-get-info group)
3172       (error "Killed group; can't be edited"))
3173     (unless (eq (car (setq method (gnus-find-method-for-group group))) 'nnimap)
3174       (error "%s is not an nnimap group" group))
3175     (unless (setq acl (nnimap-acl-get mailbox (cadr method)))
3176       (error "Server does not support ACL's"))
3177     (gnus-edit-form acl (format "Editing the access control list for `%s'.
3178
3179    An access control list is a list of (identifier . rights) elements.
3180
3181    The identifier string specifies the corresponding user.  The
3182    identifier \"anyone\" is reserved to refer to the universal identity.
3183
3184    Rights is a string listing a (possibly empty) set of alphanumeric
3185    characters, each character listing a set of operations which is being
3186    controlled.  Letters are reserved for ``standard'' rights, listed
3187    below.  Digits are reserved for implementation or site defined rights.
3188
3189    l - lookup (mailbox is visible to LIST/LSUB commands)
3190    r - read (SELECT the mailbox, perform CHECK, FETCH, PARTIAL,
3191        SEARCH, COPY from mailbox)
3192    s - keep seen/unseen information across sessions (STORE \\SEEN flag)
3193    w - write (STORE flags other than \\SEEN and \\DELETED)
3194    i - insert (perform APPEND, COPY into mailbox)
3195    p - post (send mail to submission address for mailbox,
3196        not enforced by IMAP4 itself)
3197    c - create and delete mailbox (CREATE new sub-mailboxes in any
3198        implementation-defined hierarchy, RENAME or DELETE mailbox)
3199    d - delete messages (STORE \\DELETED flag, perform EXPUNGE)
3200    a - administer (perform SETACL)" group)
3201                     `(lambda (form)
3202                        (nnimap-acl-edit
3203                         ,mailbox ',method ',acl form)))))
3204
3205 ;; Group sorting commands
3206 ;; Suggested by Joe Hildebrand <hildjj@idaho.fuentez.com>.
3207
3208 (defun gnus-group-sort-groups (func &optional reverse)
3209   "Sort the group buffer according to FUNC.
3210 When used interactively, the sorting function used will be
3211 determined by the `gnus-group-sort-function' variable.
3212 If REVERSE (the prefix), reverse the sorting order."
3213   (interactive (list gnus-group-sort-function current-prefix-arg))
3214   (funcall gnus-group-sort-alist-function
3215            (gnus-make-sort-function func) reverse)
3216   (gnus-group-unmark-all-groups)
3217   (gnus-group-list-groups)
3218   (gnus-dribble-touch))
3219
3220 (defun gnus-group-sort-flat (func reverse)
3221   ;; We peel off the dummy group from the alist.
3222   (when func
3223     (when (equal (gnus-info-group (car gnus-newsrc-alist)) "dummy.group")
3224       (pop gnus-newsrc-alist))
3225     ;; Do the sorting.
3226     (setq gnus-newsrc-alist
3227           (sort gnus-newsrc-alist func))
3228     (when reverse
3229       (setq gnus-newsrc-alist (nreverse gnus-newsrc-alist)))
3230     ;; Regenerate the hash table.
3231     (gnus-make-hashtable-from-newsrc-alist)))
3232
3233 (defun gnus-group-sort-groups-by-alphabet (&optional reverse)
3234   "Sort the group buffer alphabetically by group name.
3235 If REVERSE, sort in reverse order."
3236   (interactive "P")
3237   (gnus-group-sort-groups 'gnus-group-sort-by-alphabet reverse))
3238
3239 (defun gnus-group-sort-groups-by-real-name (&optional reverse)
3240   "Sort the group buffer alphabetically by real (unprefixed) group name.
3241 If REVERSE, sort in reverse order."
3242   (interactive "P")
3243   (gnus-group-sort-groups 'gnus-group-sort-by-real-name reverse))
3244
3245 (defun gnus-group-sort-groups-by-unread (&optional reverse)
3246   "Sort the group buffer by number of unread articles.
3247 If REVERSE, sort in reverse order."
3248   (interactive "P")
3249   (gnus-group-sort-groups 'gnus-group-sort-by-unread reverse))
3250
3251 (defun gnus-group-sort-groups-by-level (&optional reverse)
3252   "Sort the group buffer by group level.
3253 If REVERSE, sort in reverse order."
3254   (interactive "P")
3255   (gnus-group-sort-groups 'gnus-group-sort-by-level reverse))
3256
3257 (defun gnus-group-sort-groups-by-score (&optional reverse)
3258   "Sort the group buffer by group score.
3259 If REVERSE, sort in reverse order."
3260   (interactive "P")
3261   (gnus-group-sort-groups 'gnus-group-sort-by-score reverse))
3262
3263 (defun gnus-group-sort-groups-by-rank (&optional reverse)
3264   "Sort the group buffer by group rank.
3265 If REVERSE, sort in reverse order."
3266   (interactive "P")
3267   (gnus-group-sort-groups 'gnus-group-sort-by-rank reverse))
3268
3269 (defun gnus-group-sort-groups-by-method (&optional reverse)
3270   "Sort the group buffer alphabetically by back end name.
3271 If REVERSE, sort in reverse order."
3272   (interactive "P")
3273   (gnus-group-sort-groups 'gnus-group-sort-by-method reverse))
3274
3275 (defun gnus-group-sort-groups-by-server (&optional reverse)
3276   "Sort the group buffer alphabetically by server name.
3277 If REVERSE, sort in reverse order."
3278   (interactive "P")
3279   (gnus-group-sort-groups 'gnus-group-sort-by-server reverse))
3280
3281 ;;; Selected group sorting.
3282
3283 (defun gnus-group-sort-selected-groups (n func &optional reverse)
3284   "Sort the process/prefixed groups."
3285   (interactive (list current-prefix-arg gnus-group-sort-function))
3286   (let ((groups (gnus-group-process-prefix n)))
3287     (funcall gnus-group-sort-selected-function
3288              groups (gnus-make-sort-function func) reverse)
3289     (gnus-group-unmark-all-groups)
3290     (gnus-group-list-groups)
3291     (gnus-dribble-touch)))
3292
3293 (defun gnus-group-sort-selected-flat (groups func reverse)
3294   (let (entries infos)
3295     ;; First find all the group entries for these groups.
3296     (while groups
3297       (push (nthcdr 2 (gnus-group-entry (pop groups)))
3298             entries))
3299     ;; Then sort the infos.
3300     (setq infos
3301           (sort
3302            (mapcar
3303             (lambda (entry) (car entry))
3304             (setq entries (nreverse entries)))
3305            func))
3306     (when reverse
3307       (setq infos (nreverse infos)))
3308     ;; Go through all the infos and replace the old entries
3309     ;; with the new infos.
3310     (while infos
3311       (setcar (car entries) (pop infos))
3312       (pop entries))
3313     ;; Update the hashtable.
3314     (gnus-make-hashtable-from-newsrc-alist)))
3315
3316 (defun gnus-group-sort-selected-groups-by-alphabet (&optional n reverse)
3317   "Sort the group buffer alphabetically by group name.
3318 Obeys the process/prefix convention.  If REVERSE (the symbolic prefix),
3319 sort in reverse order."
3320   (interactive (gnus-interactive "P\ny"))
3321   (gnus-group-sort-selected-groups n 'gnus-group-sort-by-alphabet reverse))
3322
3323 (defun gnus-group-sort-selected-groups-by-real-name (&optional n reverse)
3324   "Sort the group buffer alphabetically by real group name.
3325 Obeys the process/prefix convention.  If REVERSE (the symbolic prefix),
3326 sort in reverse order."
3327   (interactive (gnus-interactive "P\ny"))
3328   (gnus-group-sort-selected-groups n 'gnus-group-sort-by-real-name reverse))
3329
3330 (defun gnus-group-sort-selected-groups-by-unread (&optional n reverse)
3331   "Sort the group buffer by number of unread articles.
3332 Obeys the process/prefix convention.  If REVERSE (the symbolic prefix),
3333 sort in reverse order."
3334   (interactive (gnus-interactive "P\ny"))
3335   (gnus-group-sort-selected-groups n 'gnus-group-sort-by-unread reverse))
3336
3337 (defun gnus-group-sort-selected-groups-by-level (&optional n reverse)
3338   "Sort the group buffer by group level.
3339 Obeys the process/prefix convention.  If REVERSE (the symbolic prefix),
3340 sort in reverse order."
3341   (interactive (gnus-interactive "P\ny"))
3342   (gnus-group-sort-selected-groups n 'gnus-group-sort-by-level reverse))
3343
3344 (defun gnus-group-sort-selected-groups-by-score (&optional n reverse)
3345   "Sort the group buffer by group score.
3346 Obeys the process/prefix convention.  If REVERSE (the symbolic prefix),
3347 sort in reverse order."
3348   (interactive (gnus-interactive "P\ny"))
3349   (gnus-group-sort-selected-groups n 'gnus-group-sort-by-score reverse))
3350
3351 (defun gnus-group-sort-selected-groups-by-rank (&optional n reverse)
3352   "Sort the group buffer by group rank.
3353 Obeys the process/prefix convention.  If REVERSE (the symbolic prefix),
3354 sort in reverse order."
3355   (interactive (gnus-interactive "P\ny"))
3356   (gnus-group-sort-selected-groups n 'gnus-group-sort-by-rank reverse))
3357
3358 (defun gnus-group-sort-selected-groups-by-method (&optional n reverse)
3359   "Sort the group buffer alphabetically by back end name.
3360 Obeys the process/prefix convention.  If REVERSE (the symbolic prefix),
3361 sort in reverse order."
3362   (interactive (gnus-interactive "P\ny"))
3363   (gnus-group-sort-selected-groups n 'gnus-group-sort-by-method reverse))
3364
3365 ;;; Sorting predicates.
3366
3367 (defun gnus-group-sort-by-alphabet (info1 info2)
3368   "Sort alphabetically."
3369   (string< (gnus-info-group info1) (gnus-info-group info2)))
3370
3371 (defun gnus-group-sort-by-real-name (info1 info2)
3372   "Sort alphabetically on real (unprefixed) names."
3373   (string< (gnus-group-real-name (gnus-info-group info1))
3374            (gnus-group-real-name (gnus-info-group info2))))
3375
3376 (defun gnus-group-sort-by-unread (info1 info2)
3377   "Sort by number of unread articles."
3378   (let ((n1 (gnus-group-unread (gnus-info-group info1)))
3379         (n2 (gnus-group-unread (gnus-info-group info2))))
3380     (< (or (and (numberp n1) n1) 0)
3381        (or (and (numberp n2) n2) 0))))
3382
3383 (defun gnus-group-sort-by-level (info1 info2)
3384   "Sort by level."
3385   (< (gnus-info-level info1) (gnus-info-level info2)))
3386
3387 (defun gnus-group-sort-by-method (info1 info2)
3388   "Sort alphabetically by back end name."
3389   (string< (car (gnus-find-method-for-group
3390                  (gnus-info-group info1) info1))
3391            (car (gnus-find-method-for-group
3392                  (gnus-info-group info2) info2))))
3393
3394 (defun gnus-group-sort-by-server (info1 info2)
3395   "Sort alphabetically by server name."
3396   (string< (gnus-method-to-full-server-name
3397             (gnus-find-method-for-group
3398              (gnus-info-group info1) info1))
3399            (gnus-method-to-full-server-name
3400             (gnus-find-method-for-group
3401              (gnus-info-group info2) info2))))
3402
3403 (defun gnus-group-sort-by-score (info1 info2)
3404   "Sort by group score."
3405   (> (gnus-info-score info1) (gnus-info-score info2)))
3406
3407 (defun gnus-group-sort-by-rank (info1 info2)
3408   "Sort by level and score."
3409   (let ((level1 (gnus-info-level info1))
3410         (level2 (gnus-info-level info2)))
3411     (or (< level1 level2)
3412         (and (= level1 level2)
3413              (> (gnus-info-score info1) (gnus-info-score info2))))))
3414
3415 ;;; Clearing data
3416
3417 (defun gnus-group-clear-data (&optional arg)
3418   "Clear all marks and read ranges from the current group.
3419 Obeys the process/prefix convention."
3420   (interactive "P")
3421   (gnus-group-iterate arg
3422     (lambda (group)
3423       (let (info)
3424         (gnus-info-clear-data (setq info (gnus-get-info group)))
3425         (gnus-get-unread-articles-in-group info (gnus-active group) t)
3426         (when (gnus-group-goto-group group)
3427           (gnus-group-update-group-line))))))
3428
3429 (defun gnus-group-clear-data-on-native-groups ()
3430   "Clear all marks and read ranges from all native groups."
3431   (interactive)
3432   (when (gnus-yes-or-no-p "Really clear all data from almost all groups? ")
3433     (let ((alist (cdr gnus-newsrc-alist))
3434           info)
3435       (while (setq info (pop alist))
3436         (when (gnus-group-native-p (gnus-info-group info))
3437           (gnus-info-clear-data info)))
3438       (gnus-get-unread-articles)
3439       (gnus-dribble-touch)
3440       (when (gnus-y-or-n-p
3441              "Move the cache away to avoid problems in the future? ")
3442         (call-interactively 'gnus-cache-move-cache)))))
3443
3444 (defun gnus-info-clear-data (info)
3445   "Clear all marks and read ranges from INFO."
3446   (let ((group (gnus-info-group info))
3447         action)
3448     (dolist (el (gnus-info-marks info))
3449       (push `(,(cdr el) add (,(car el))) action))
3450     (push `(,(gnus-info-read info) add (read)) action)
3451     (gnus-undo-register
3452       `(progn
3453          (gnus-request-set-mark ,group ',action)
3454          (gnus-info-set-marks ',info ',(gnus-info-marks info) t)
3455          (gnus-info-set-read ',info ',(gnus-info-read info))
3456          (when (gnus-group-goto-group ,group)
3457            (gnus-get-unread-articles-in-group ',info ',(gnus-active group) t)
3458            (gnus-group-update-group-line))))
3459     (setq action (mapcar (lambda (el) (list (nth 0 el) 'del (nth 2 el)))
3460                          action))
3461     (gnus-request-set-mark group action)
3462     (gnus-info-set-read info nil)
3463     (when (gnus-info-marks info)
3464       (gnus-info-set-marks info nil))))
3465
3466 ;; Group catching up.
3467
3468 (defun gnus-group-catchup-current (&optional n all)
3469   "Mark all unread articles in the current newsgroup as read.
3470 If prefix argument N is numeric, the next N newsgroups will be
3471 caught up.  If ALL is non-nil, marked articles will also be marked as
3472 read.  Cross references (Xref: header) of articles are ignored.
3473 The number of newsgroups that this function was unable to catch
3474 up is returned."
3475   (interactive "P")
3476   (let ((groups (gnus-group-process-prefix n))
3477         (ret 0)
3478         group)
3479     (unless groups (error "No groups selected"))
3480     (if (not
3481          (or (not gnus-interactive-catchup) ;Without confirmation?
3482              gnus-expert-user
3483              (gnus-y-or-n-p
3484               (format
3485                (if all
3486                    "Do you really want to mark all articles in %s as read? "
3487                  "Mark all unread articles in %s as read? ")
3488                (if (= (length groups) 1)
3489                    (gnus-group-decoded-name (car groups))
3490                  (format "these %d groups" (length groups)))))))
3491         n
3492       (while (setq group (pop groups))
3493         (gnus-group-remove-mark group)
3494         ;; Virtual groups have to be given special treatment.
3495         (let ((method (gnus-find-method-for-group group)))
3496           (when (eq 'nnvirtual (car method))
3497             (nnvirtual-catchup-group
3498              (gnus-group-real-name group) (nth 1 method) all)))
3499         (cond
3500          ((>= (gnus-group-level group) gnus-level-zombie)
3501           (gnus-message 2 "Dead groups can't be caught up"))
3502          ((prog1
3503               (gnus-group-goto-group group)
3504             (gnus-group-catchup group all))
3505           (gnus-group-update-group-line))
3506          (t
3507           (setq ret (1+ ret)))))
3508       (gnus-group-next-unread-group 1)
3509       ret)))
3510
3511 (defun gnus-group-catchup-current-all (&optional n)
3512   "Mark all articles in current newsgroup as read.
3513 Cross references (Xref: header) of articles are ignored."
3514   (interactive "P")
3515   (gnus-group-catchup-current n 'all))
3516
3517 (defun gnus-group-catchup (group &optional all)
3518   "Mark all articles in GROUP as read.
3519 If ALL is non-nil, all articles are marked as read.
3520 The return value is the number of articles that were marked as read,
3521 or nil if no action could be taken."
3522   (let* ((entry (gnus-group-entry group))
3523          (num (car entry))
3524          (marks (gnus-info-marks (nth 2 entry)))
3525          (unread (gnus-sequence-of-unread-articles group)))
3526     ;; Remove entries for this group.
3527     (nnmail-purge-split-history (gnus-group-real-name group))
3528     ;; Do the updating only if the newsgroup isn't killed.
3529     (if (not (numberp (car entry)))
3530         (gnus-message 1 "Can't catch up %s; non-active group" group)
3531       (gnus-update-read-articles group nil)
3532       (when all
3533         ;; Nix out the lists of marks and dormants.
3534         (gnus-request-set-mark group (list (list (cdr (assq 'tick marks))
3535                                                  'del '(tick))
3536                                            (list (cdr (assq 'dormant marks))
3537                                                  'del '(dormant))))
3538         (setq unread (gnus-range-add (gnus-range-add
3539                                       unread (cdr (assq 'dormant marks)))
3540                                      (cdr (assq 'tick marks))))
3541         (gnus-add-marked-articles group 'tick nil nil 'force)
3542         (gnus-add-marked-articles group 'dormant nil nil 'force))
3543       ;; Do auto-expirable marks if that's required.
3544       (when (gnus-group-auto-expirable-p group)
3545         (gnus-range-map
3546          (lambda (article)
3547            (gnus-add-marked-articles group 'expire (list article))
3548            (gnus-request-set-mark group (list (list (list article)
3549                                                     'add '(expire)))))
3550          unread))
3551       (let ((gnus-newsgroup-name group))
3552         (gnus-run-hooks 'gnus-group-catchup-group-hook))
3553       num)))
3554
3555 (defun gnus-group-expire-articles (&optional n)
3556   "Expire all expirable articles in the current newsgroup.
3557 Uses the process/prefix convention."
3558   (interactive "P")
3559   (let ((groups (gnus-group-process-prefix n))
3560         group)
3561     (unless groups
3562       (error "No groups to expire"))
3563     (while (setq group (pop groups))
3564       (gnus-group-remove-mark group)
3565       (gnus-group-expire-articles-1 group)
3566       (gnus-dribble-touch)
3567       (gnus-group-position-point))))
3568
3569 (defun gnus-group-expire-articles-1 (group)
3570   (when (gnus-check-backend-function 'request-expire-articles group)
3571     (gnus-message 6 "Expiring articles in %s..."
3572                   (gnus-group-decoded-name group))
3573     (let* ((info (gnus-get-info group))
3574            (expirable (if (gnus-group-total-expirable-p group)
3575                           (cons nil (gnus-list-of-read-articles group))
3576                         (assq 'expire (gnus-info-marks info))))
3577            (expiry-wait (gnus-group-find-parameter group 'expiry-wait))
3578            (nnmail-expiry-target
3579             (or (gnus-group-find-parameter group 'expiry-target)
3580                 nnmail-expiry-target)))
3581       (when expirable
3582         (gnus-check-group group)
3583         (setcdr
3584          expirable
3585          (gnus-compress-sequence
3586           (if expiry-wait
3587               ;; We set the expiry variables to the group
3588               ;; parameter.
3589               (let ((nnmail-expiry-wait-function nil)
3590                     (nnmail-expiry-wait expiry-wait))
3591                 (gnus-request-expire-articles
3592                  (gnus-uncompress-sequence (cdr expirable)) group))
3593             ;; Just expire using the normal expiry values.
3594             (gnus-request-expire-articles
3595              (gnus-uncompress-sequence (cdr expirable)) group))))
3596         (gnus-close-group group))
3597       (gnus-message 6 "Expiring articles in %s...done"
3598                     (gnus-group-decoded-name group))
3599       ;; Return the list of un-expired articles.
3600       (cdr expirable))))
3601
3602 (defun gnus-group-expire-all-groups ()
3603   "Expire all expirable articles in all newsgroups."
3604   (interactive)
3605   (save-excursion
3606     (gnus-message 5 "Expiring...")
3607     (let ((gnus-group-marked (mapcar (lambda (info) (gnus-info-group info))
3608                                      (cdr gnus-newsrc-alist))))
3609       (gnus-group-expire-articles nil)))
3610   (gnus-group-position-point)
3611   (gnus-message 5 "Expiring...done"))
3612
3613 (defun gnus-group-set-current-level (n level)
3614   "Set the level of the next N groups to LEVEL."
3615   (interactive
3616    (list
3617     current-prefix-arg
3618     (progn
3619       (unless (gnus-group-process-prefix current-prefix-arg)
3620         (error "No group on the current line"))
3621       (string-to-number
3622        (let ((s (read-string
3623                  (format "Level (default %s): "
3624                          (or (gnus-group-group-level)
3625                              gnus-level-default-subscribed)))))
3626          (if (string-match "^\\s-*$" s)
3627              (int-to-string (or (gnus-group-group-level)
3628                                 gnus-level-default-subscribed))
3629            s))))))
3630   (unless (and (>= level 1) (<= level gnus-level-killed))
3631     (error "Invalid level: %d" level))
3632   (dolist (group (gnus-group-process-prefix n))
3633     (gnus-group-remove-mark group)
3634     (gnus-message 6 "Changed level of %s from %d to %d"
3635                   (gnus-group-decoded-name group)
3636                   (or (gnus-group-group-level) gnus-level-killed)
3637                   level)
3638     (gnus-group-change-level
3639      group level (or (gnus-group-group-level) gnus-level-killed))
3640     (gnus-group-update-group-line))
3641   (gnus-group-position-point))
3642
3643 (defun gnus-group-unsubscribe (&optional n)
3644   "Unsubscribe the current group."
3645   (interactive "P")
3646   (gnus-group-unsubscribe-current-group n 'unsubscribe))
3647
3648 (defun gnus-group-subscribe (&optional n)
3649   "Subscribe the current group."
3650   (interactive "P")
3651   (gnus-group-unsubscribe-current-group n 'subscribe))
3652
3653 (defun gnus-group-unsubscribe-current-group (&optional n do-sub)
3654   "Toggle subscription of the current group.
3655 If given numerical prefix, toggle the N next groups."
3656   (interactive "P")
3657   (dolist (group (gnus-group-process-prefix n))
3658     (gnus-group-remove-mark group)
3659     (gnus-group-unsubscribe-group
3660      group
3661      (cond
3662       ((eq do-sub 'unsubscribe)
3663        gnus-level-default-unsubscribed)
3664       ((eq do-sub 'subscribe)
3665        gnus-level-default-subscribed)
3666       ((<= (gnus-group-group-level) gnus-level-subscribed)
3667        gnus-level-default-unsubscribed)
3668       (t
3669        gnus-level-default-subscribed))
3670      t)
3671     (gnus-group-update-group-line))
3672   (gnus-group-next-group 1))
3673
3674 (defun gnus-group-unsubscribe-group (group &optional level silent)
3675   "Toggle subscription to GROUP.
3676 Killed newsgroups are subscribed.  If SILENT, don't try to update the
3677 group line."
3678   (interactive (list (gnus-group-completing-read
3679                       nil nil (gnus-read-active-file-p))))
3680   (let ((newsrc (gnus-group-entry group)))
3681     (cond
3682      ((string-match "^[ \t]*$" group)
3683       (error "Empty group name"))
3684      (newsrc
3685       ;; Toggle subscription flag.
3686       (gnus-group-change-level
3687        newsrc (if level level (if (<= (gnus-info-level (nth 2 newsrc))
3688                                       gnus-level-subscribed)
3689                                   (1+ gnus-level-subscribed)
3690                                 gnus-level-default-subscribed)))
3691       (unless silent
3692         (gnus-group-update-group group)))
3693      ((and (stringp group)
3694            (or (not (gnus-read-active-file-p))
3695                (gnus-active group)))
3696       ;; Add new newsgroup.
3697       (gnus-group-change-level
3698        group
3699        (if level level gnus-level-default-subscribed)
3700        (or (and (member group gnus-zombie-list)
3701                 gnus-level-zombie)
3702            gnus-level-killed)
3703        (when (gnus-group-group-name)
3704          (gnus-group-entry (gnus-group-group-name))))
3705       (unless silent
3706         (gnus-group-update-group group)))
3707      (t (error "No such newsgroup: %s" group)))
3708     (gnus-group-position-point)))
3709
3710 (defun gnus-group-transpose-groups (n)
3711   "Move the current newsgroup up N places.
3712 If given a negative prefix, move down instead.  The difference between
3713 N and the number of steps taken is returned."
3714   (interactive "p")
3715   (unless (gnus-group-group-name)
3716     (error "No group on current line"))
3717   (gnus-group-kill-group 1)
3718   (prog1
3719       (forward-line (- n))
3720     (gnus-group-yank-group)
3721     (gnus-group-position-point)))
3722
3723 (defun gnus-group-kill-all-zombies (&optional dummy)
3724   "Kill all zombie newsgroups.
3725 The optional DUMMY should always be nil."
3726   (interactive (list (not (gnus-yes-or-no-p "Really kill all zombies? "))))
3727   (unless dummy
3728     (setq gnus-killed-list (nconc gnus-zombie-list gnus-killed-list))
3729     (setq gnus-zombie-list nil)
3730     (gnus-dribble-touch)
3731     (gnus-group-list-groups)))
3732
3733 (defun gnus-group-kill-region (begin end)
3734   "Kill newsgroups in current region (excluding current point).
3735 The killed newsgroups can be yanked by using \\[gnus-group-yank-group]."
3736   (interactive "r")
3737   (let ((lines
3738          ;; Count lines.
3739          (save-excursion
3740            (count-lines
3741             (progn
3742               (goto-char begin)
3743               (point-at-bol))
3744             (progn
3745               (goto-char end)
3746               (point-at-bol))))))
3747     (goto-char begin)
3748     (beginning-of-line)                 ;Important when LINES < 1
3749     (gnus-group-kill-group lines)))
3750
3751 (defun gnus-group-kill-group (&optional n discard)
3752   "Kill the next N groups.
3753 The killed newsgroups can be yanked by using \\[gnus-group-yank-group].
3754 However, only groups that were alive can be yanked; already killed
3755 groups or zombie groups can't be yanked.
3756 The return value is the name of the group that was killed, or a list
3757 of groups killed."
3758   (interactive "P")
3759   (let ((buffer-read-only nil)
3760         (groups (gnus-group-process-prefix n))
3761         group entry level out)
3762     (if (< (length groups) 10)
3763         ;; This is faster when there are few groups.
3764         (while groups
3765           (push (setq group (pop groups)) out)
3766           (gnus-group-remove-mark group)
3767           (setq level (gnus-group-group-level))
3768           (gnus-delete-line)
3769           (when (and (not discard)
3770                      (setq entry (gnus-group-entry group)))
3771             (gnus-undo-register
3772               `(progn
3773                  (gnus-group-goto-group ,(gnus-group-group-name))
3774                  (gnus-group-yank-group)))
3775             (push (cons (car entry) (nth 2 entry))
3776                   gnus-list-of-killed-groups))
3777           (gnus-group-change-level
3778            (if entry entry group) gnus-level-killed (if entry nil level))
3779           (message "Killed group %s" (gnus-group-decoded-name group)))
3780       ;; If there are lots and lots of groups to be killed, we use
3781       ;; this thing instead.
3782       (dolist (group (nreverse groups))
3783         (gnus-group-remove-mark group)
3784         (gnus-delete-line)
3785         (push group gnus-killed-list)
3786         (setq gnus-newsrc-alist
3787               (delq (assoc group gnus-newsrc-alist)
3788                     gnus-newsrc-alist))
3789         (when gnus-group-change-level-function
3790           (funcall gnus-group-change-level-function
3791                    group gnus-level-killed 3))
3792         (cond
3793          ((setq entry (gnus-group-entry group))
3794           (push (cons (car entry) (nth 2 entry))
3795                 gnus-list-of-killed-groups)
3796           (setcdr (cdr entry) (cdddr entry)))
3797          ((member group gnus-zombie-list)
3798           (setq gnus-zombie-list (delete group gnus-zombie-list))))
3799         ;; There may be more than one instance displayed.
3800         (while (gnus-group-goto-group group)
3801           (gnus-delete-line)))
3802       (gnus-make-hashtable-from-newsrc-alist))
3803
3804     (gnus-group-position-point)
3805     (if (< (length out) 2) (car out) (nreverse out))))
3806
3807 (defun gnus-group-yank-group (&optional arg)
3808   "Yank the last newsgroups killed with \\[gnus-group-kill-group], inserting it before the current newsgroup.
3809 The numeric ARG specifies how many newsgroups are to be yanked.  The
3810 name of the newsgroup yanked is returned, or (if several groups are
3811 yanked) a list of yanked groups is returned."
3812   (interactive "p")
3813   (setq arg (or arg 1))
3814   (let (info group prev out)
3815     (while (>= (decf arg) 0)
3816       (when (not (setq info (pop gnus-list-of-killed-groups)))
3817         (error "No more newsgroups to yank"))
3818       (push (setq group (nth 1 info)) out)
3819       ;; Find which newsgroup to insert this one before - search
3820       ;; backward until something suitable is found.  If there are no
3821       ;; other newsgroups in this buffer, just make this newsgroup the
3822       ;; first newsgroup.
3823       (setq prev (gnus-group-group-name))
3824       (gnus-group-change-level
3825        info (gnus-info-level (cdr info)) gnus-level-killed
3826        (and prev (gnus-group-entry prev))
3827        t)
3828       (gnus-group-insert-group-line-info group)
3829       (gnus-undo-register
3830         `(when (gnus-group-goto-group ,group)
3831            (gnus-group-kill-group 1))))
3832     (forward-line -1)
3833     (gnus-group-position-point)
3834     (if (< (length out) 2) (car out) (nreverse out))))
3835
3836 (defun gnus-group-kill-level (level)
3837   "Kill all groups that is on a certain LEVEL."
3838   (interactive "nKill all groups on level: ")
3839   (cond
3840    ((= level gnus-level-zombie)
3841     (setq gnus-killed-list
3842           (nconc gnus-zombie-list gnus-killed-list))
3843     (setq gnus-zombie-list nil))
3844    ((and (< level gnus-level-zombie)
3845          (> level 0)
3846          (or gnus-expert-user
3847              (gnus-yes-or-no-p
3848               (format
3849                "Do you really want to kill all groups on level %d? "
3850                level))))
3851     (let* ((prev gnus-newsrc-alist)
3852            (alist (cdr prev)))
3853       (while alist
3854         (if (= (gnus-info-level (car alist)) level)
3855             (progn
3856               (push (gnus-info-group (car alist)) gnus-killed-list)
3857               (setcdr prev (cdr alist)))
3858           (setq prev alist))
3859         (setq alist (cdr alist)))
3860       (gnus-make-hashtable-from-newsrc-alist)
3861       (gnus-group-list-groups)))
3862    (t
3863     (error "Can't kill; invalid level: %d" level))))
3864
3865 (defun gnus-group-list-all-groups (&optional arg)
3866   "List all newsgroups with level ARG or lower.
3867 Default is `gnus-level-unsubscribed', which lists all subscribed and most
3868 unsubscribed groups."
3869   (interactive "P")
3870   (gnus-group-list-groups (or arg gnus-level-unsubscribed) t))
3871
3872 ;; Redefine this to list ALL killed groups if prefix arg used.
3873 ;; Rewritten by engstrom@src.honeywell.com (Eric Engstrom).
3874 (defun gnus-group-list-killed (&optional arg)
3875   "List all killed newsgroups in the group buffer.
3876 If ARG is non-nil, list ALL killed groups known to Gnus.  This may
3877 entail asking the server for the groups."
3878   (interactive "P")
3879   ;; Find all possible killed newsgroups if arg.
3880   (when arg
3881     (gnus-get-killed-groups))
3882   (if (not gnus-killed-list)
3883       (gnus-message 6 "No killed groups")
3884     (let (gnus-group-list-mode)
3885       (funcall gnus-group-prepare-function
3886                gnus-level-killed t gnus-level-killed))
3887     (goto-char (point-min)))
3888   (gnus-group-position-point))
3889
3890 (defun gnus-group-list-zombies ()
3891   "List all zombie newsgroups in the group buffer."
3892   (interactive)
3893   (if (not gnus-zombie-list)
3894       (gnus-message 6 "No zombie groups")
3895     (let (gnus-group-list-mode)
3896       (funcall gnus-group-prepare-function
3897                gnus-level-zombie t gnus-level-zombie))
3898     (goto-char (point-min)))
3899   (gnus-group-position-point))
3900
3901 (defun gnus-group-list-active ()
3902   "List all groups that are available from the server(s)."
3903   (interactive)
3904   ;; First we make sure that we have really read the active file.
3905   (unless (gnus-read-active-file-p)
3906     (let ((gnus-read-active-file t)
3907           (gnus-agent gnus-plugged)); If we're actually plugged, store the active file in the agent.
3908       (gnus-read-active-file)))
3909   ;; Find all groups and sort them.
3910   (let ((groups
3911          (sort
3912           (let (list)
3913             (mapatoms
3914              (lambda (sym)
3915                (and (boundp sym)
3916                     (symbol-value sym)
3917                     (push (symbol-name sym) list)))
3918              gnus-active-hashtb)
3919             list)
3920           'string<))
3921         (buffer-read-only nil)
3922         group)
3923     (erase-buffer)
3924     (while groups
3925       (setq group (pop groups))
3926       (gnus-add-text-properties
3927        (point) (prog1 (1+ (point))
3928                  (insert "       *: "
3929                          (gnus-group-decoded-name group)
3930                          "\n"))
3931        (list 'gnus-group (gnus-intern-safe group gnus-active-hashtb)
3932              'gnus-unread t
3933              'gnus-level (inline (gnus-group-level group)))))
3934     (goto-char (point-min))))
3935
3936 (defun gnus-activate-all-groups (level)
3937   "Activate absolutely all groups."
3938   (interactive (list gnus-level-unsubscribed))
3939   (let ((gnus-activate-level level)
3940         (gnus-activate-foreign-newsgroups level))
3941     (gnus-group-get-new-news)))
3942
3943 (defun gnus-group-get-new-news (&optional arg)
3944   "Get newly arrived articles.
3945 If ARG is a number, it specifies which levels you are interested in
3946 re-scanning.  If ARG is non-nil and not a number, this will force
3947 \"hard\" re-reading of the active files from all servers."
3948   (interactive "P")
3949   (require 'nnmail)
3950   (let ((gnus-inhibit-demon t)
3951         ;; Binding this variable will inhibit multiple fetchings
3952         ;; of the same mail source.
3953         (nnmail-fetched-sources (list t)))
3954     (gnus-run-hooks 'gnus-get-top-new-news-hook)
3955     (gnus-run-hooks 'gnus-get-new-news-hook)
3956
3957     ;; Read any slave files.
3958     (unless gnus-slave
3959       (gnus-master-read-slave-newsrc))
3960
3961     (gnus-get-unread-articles arg)
3962
3963     ;; If the user wants it, we scan for new groups.
3964     (when (eq gnus-check-new-newsgroups 'always)
3965       (gnus-find-new-newsgroups))
3966
3967     (gnus-check-reasonable-setup)
3968     (gnus-run-hooks 'gnus-after-getting-new-news-hook)
3969     (gnus-group-list-groups (and (numberp arg)
3970                                  (max (car gnus-group-list-mode) arg)))))
3971
3972 (defun gnus-group-get-new-news-this-group (&optional n dont-scan)
3973   "Check for newly arrived news in the current group (and the N-1 next groups).
3974 The difference between N and the number of newsgroup checked is returned.
3975 If N is negative, this group and the N-1 previous groups will be checked.
3976 If DONT-SCAN is non-nil, scan non-activated groups as well."
3977   (interactive "P")
3978   (let* ((groups (gnus-group-process-prefix n))
3979          (ret (if (numberp n) (- n (length groups)) 0))
3980          (beg (unless n
3981                 (point)))
3982          group method
3983          (gnus-inhibit-demon t)
3984          ;; Binding this variable will inhibit multiple fetchings
3985          ;; of the same mail source.
3986          (nnmail-fetched-sources (list t)))
3987     (gnus-run-hooks 'gnus-get-new-news-hook)
3988     (while (setq group (pop groups))
3989       (gnus-group-remove-mark group)
3990       ;; Bypass any previous denials from the server.
3991       (gnus-remove-denial (setq method (gnus-find-method-for-group group)))
3992       (if (gnus-activate-group group (if dont-scan nil 'scan) nil method)
3993           (let ((info (gnus-get-info group))
3994                 (active (gnus-active group)))
3995             (when info
3996               (gnus-request-update-info info method))
3997             (gnus-get-unread-articles-in-group info active)
3998             (unless (gnus-virtual-group-p group)
3999               (gnus-close-group group))
4000             (when gnus-agent
4001               (gnus-agent-save-group-info
4002                method (gnus-group-real-name group) active))
4003             (gnus-group-update-group group))
4004         (if (eq (gnus-server-status (gnus-find-method-for-group group))
4005                 'denied)
4006             (gnus-error 3 "Server denied access")
4007           (gnus-error 3 "%s error: %s" group (gnus-status-message group)))))
4008     (when beg
4009       (goto-char beg))
4010     (when gnus-goto-next-group-when-activating
4011       (gnus-group-next-unread-group 1 t))
4012     (gnus-group-position-point)
4013     ret))
4014
4015 (defun gnus-group-fetch-control (group)
4016   "Fetch the archived control messages for the current group.
4017 If given a prefix argument, prompt for a group."
4018   (interactive
4019    (list (or (when current-prefix-arg
4020                (gnus-group-completing-read))
4021              (gnus-group-group-name)
4022              gnus-newsgroup-name)))
4023   (unless group
4024     (error "No group name given"))
4025   (let ((name (gnus-group-real-name group))
4026         hierarchy)
4027     (when (string-match "\\(^[^\\.]+\\)\\..*" name)
4028       (setq hierarchy (match-string 1 name))
4029       (if gnus-group-fetch-control-use-browse-url
4030           (browse-url (concat "ftp://ftp.isc.org/usenet/control/"
4031                               hierarchy "/" name ".gz"))
4032         (let ((enable-local-variables nil))
4033           (gnus-group-read-ephemeral-group
4034            group
4035            `(nndoc ,group (nndoc-address
4036                            ,(find-file-noselect
4037                              (concat "/ftp@ftp.isc.org:/usenet/control/"
4038                                      hierarchy "/" name ".gz")))
4039                    (nndoc-article-type mbox)) t nil nil))))))
4040
4041 (defun gnus-group-describe-group (force &optional group)
4042   "Display a description of the current newsgroup."
4043   (interactive (list current-prefix-arg (gnus-group-group-name)))
4044   (let* ((method (gnus-find-method-for-group group))
4045          (mname (gnus-group-prefixed-name "" method))
4046          desc)
4047     (when (and force
4048                gnus-description-hashtb)
4049       (gnus-sethash mname nil gnus-description-hashtb))
4050     (unless group
4051       (error "No group name given"))
4052     (when (or (and gnus-description-hashtb
4053                    ;; We check whether this group's method has been
4054                    ;; queried for a description file.
4055                    (gnus-gethash mname gnus-description-hashtb))
4056               (setq desc (gnus-group-get-description group))
4057               (gnus-read-descriptions-file method))
4058       (gnus-message 1 "%s"
4059                     (or desc (gnus-gethash group gnus-description-hashtb)
4060                         "No description available")))))
4061
4062 ;; Suggested by Per Abrahamsen <amanda@iesd.auc.dk>.
4063 (defun gnus-group-describe-all-groups (&optional force)
4064   "Pop up a buffer with descriptions of all newsgroups."
4065   (interactive "P")
4066   (when force
4067     (setq gnus-description-hashtb nil))
4068   (when (not (or gnus-description-hashtb
4069                  (gnus-read-all-descriptions-files)))
4070     (error "Couldn't request descriptions file"))
4071   (let ((buffer-read-only nil)
4072         b)
4073     (erase-buffer)
4074     (mapatoms
4075      (lambda (group)
4076        (setq b (point))
4077        (let ((charset (gnus-group-name-charset nil (symbol-name group))))
4078          (insert (format "      *: %-20s %s\n"
4079                          (gnus-group-name-decode
4080                           (symbol-name group) charset)
4081                          (gnus-group-name-decode
4082                           (symbol-value group) charset))))
4083        (gnus-add-text-properties
4084         b (1+ b) (list 'gnus-group group
4085                        'gnus-unread t 'gnus-marked nil
4086                        'gnus-level (1+ gnus-level-subscribed))))
4087      gnus-description-hashtb)
4088     (goto-char (point-min))
4089     (gnus-group-position-point)))
4090
4091 ;; Suggested by Daniel Quinlan <quinlan@best.com>.
4092 (defun gnus-group-apropos (regexp &optional search-description)
4093   "List all newsgroups that have names that match a regexp."
4094   (interactive "sGnus apropos (regexp): ")
4095   (let ((prev "")
4096         (obuf (current-buffer))
4097         groups des)
4098     ;; Go through all newsgroups that are known to Gnus.
4099     (mapatoms
4100      (lambda (group)
4101        (and (symbol-name group)
4102             (string-match regexp (symbol-name group))
4103             (symbol-value group)
4104             (push (symbol-name group) groups)))
4105      gnus-active-hashtb)
4106     ;; Also go through all descriptions that are known to Gnus.
4107     (when search-description
4108       (mapatoms
4109        (lambda (group)
4110          (and (string-match regexp (symbol-value group))
4111               (push (symbol-name group) groups)))
4112        gnus-description-hashtb))
4113     (if (not groups)
4114         (gnus-message 3 "No groups matched \"%s\"." regexp)
4115       ;; Print out all the groups.
4116       (save-excursion
4117         (pop-to-buffer "*Gnus Help*")
4118         (buffer-disable-undo)
4119         (erase-buffer)
4120         (setq groups (sort groups 'string<))
4121         (while groups
4122           ;; Groups may be entered twice into the list of groups.
4123           (when (not (string= (car groups) prev))
4124             (setq prev (car groups))
4125             (let ((charset (gnus-group-name-charset nil prev)))
4126               (insert (gnus-group-name-decode prev charset) "\n")
4127               (when (and gnus-description-hashtb
4128                          (setq des (gnus-gethash (car groups)
4129                                                  gnus-description-hashtb)))
4130                 (insert "  " (gnus-group-name-decode des charset) "\n"))))
4131           (setq groups (cdr groups)))
4132         (goto-char (point-min))))
4133     (pop-to-buffer obuf)))
4134
4135 (defun gnus-group-description-apropos (regexp)
4136   "List all newsgroups that have names or descriptions that match REGEXP."
4137   (interactive "sGnus description apropos (regexp): ")
4138   (when (not (or gnus-description-hashtb
4139                  (gnus-read-all-descriptions-files)))
4140     (error "Couldn't request descriptions file"))
4141   (gnus-group-apropos regexp t))
4142
4143 ;; Suggested by Per Abrahamsen <amanda@iesd.auc.dk>.
4144 (defun gnus-group-list-matching (level regexp &optional all lowest)
4145   "List all groups with unread articles that match REGEXP.
4146 If the prefix LEVEL is non-nil, it should be a number that says which
4147 level to cut off listing groups.
4148 If ALL, also list groups with no unread articles.
4149 If LOWEST, don't list groups with level lower than LOWEST.
4150
4151 This command may read the active file."
4152   (interactive "P\nsList newsgroups matching: ")
4153   ;; First make sure active file has been read.
4154   (when (and level
4155              (> (prefix-numeric-value level) gnus-level-killed))
4156     (gnus-get-killed-groups))
4157   (funcall gnus-group-prepare-function
4158    (or level gnus-level-subscribed) (and all t) (or lowest 1) regexp)
4159   (goto-char (point-min))
4160   (gnus-group-position-point))
4161
4162 (defun gnus-group-list-all-matching (level regexp &optional lowest)
4163   "List all groups that match REGEXP.
4164 If the prefix LEVEL is non-nil, it should be a number that says which
4165 level to cut off listing groups.
4166 If LOWEST, don't list groups with level lower than LOWEST."
4167   (interactive "P\nsList newsgroups matching: ")
4168   (when level
4169     (setq level (prefix-numeric-value level)))
4170   (gnus-group-list-matching (or level gnus-level-killed) regexp t lowest))
4171
4172 ;; Suggested by Jack Vinson <vinson@unagi.cis.upenn.edu>.
4173 (defun gnus-group-save-newsrc (&optional force)
4174   "Save the Gnus startup files.
4175 If FORCE, force saving whether it is necessary or not."
4176   (interactive "P")
4177   (gnus-save-newsrc-file force))
4178
4179 (defun gnus-group-restart (&optional arg)
4180   "Force Gnus to read the .newsrc file."
4181   (interactive "P")
4182   (when (gnus-yes-or-no-p
4183          (format "Are you sure you want to restart Gnus? "))
4184     (gnus-save-newsrc-file)
4185     (gnus-clear-system)
4186     (gnus)))
4187
4188 (defun gnus-group-read-init-file ()
4189   "Read the Gnus elisp init file."
4190   (interactive)
4191   (gnus-read-init-file)
4192   (gnus-message 5 "Read %s" gnus-init-file))
4193
4194 (defun gnus-group-check-bogus-groups (&optional silent)
4195   "Check bogus newsgroups.
4196 If given a prefix, don't ask for confirmation before removing a bogus
4197 group."
4198   (interactive "P")
4199   (gnus-check-bogus-newsgroups (and (not silent) (not gnus-expert-user)))
4200   (gnus-group-list-groups))
4201
4202 (defun gnus-group-find-new-groups (&optional arg)
4203   "Search for new groups and add them.
4204 Each new group will be treated with `gnus-subscribe-newsgroup-method'.
4205 With 1 C-u, use the `ask-server' method to query the server for new
4206 groups.
4207 With 2 C-u's, use most complete method possible to query the server
4208 for new groups, and subscribe the new groups as zombies."
4209   (interactive "p")
4210   (gnus-find-new-newsgroups (or arg 1))
4211   (gnus-group-list-groups))
4212
4213 (defun gnus-group-edit-global-kill (&optional article group)
4214   "Edit the global kill file.
4215 If GROUP, edit that local kill file instead."
4216   (interactive "P")
4217   (setq gnus-current-kill-article article)
4218   (gnus-kill-file-edit-file group)
4219   (gnus-message 6 "Editing a %s kill file (Type %s to exit)"
4220                 (if group "local" "global")
4221                 (substitute-command-keys "\\[gnus-kill-file-exit]")))
4222
4223 (defun gnus-group-edit-local-kill (article group)
4224   "Edit a local kill file."
4225   (interactive (list nil (gnus-group-group-name)))
4226   (gnus-group-edit-global-kill article group))
4227
4228 (defun gnus-group-force-update ()
4229   "Update `.newsrc' file."
4230   (interactive)
4231   (gnus-save-newsrc-file))
4232
4233 (defvar gnus-backlog-articles)
4234
4235 (defun gnus-group-suspend ()
4236   "Suspend the current Gnus session.
4237 In fact, cleanup buffers except for group mode buffer.
4238 The hook `gnus-suspend-gnus-hook' is called before actually suspending."
4239   (interactive)
4240   (gnus-run-hooks 'gnus-suspend-gnus-hook)
4241   (gnus-offer-save-summaries)
4242   ;; Kill Gnus buffers except for group mode buffer.
4243   (let ((group-buf (get-buffer gnus-group-buffer)))
4244     (dolist (buf (gnus-buffers))
4245       (unless (or (eq buf group-buf)
4246                   (eq buf gnus-dribble-buffer)
4247                   (with-current-buffer buf
4248                     (eq major-mode 'message-mode)))
4249         (gnus-kill-buffer buf)))
4250     (setq gnus-backlog-articles nil)
4251     (gnus-kill-gnus-frames)
4252     (when group-buf
4253       (bury-buffer group-buf)
4254       (delete-windows-on group-buf t))))
4255
4256 (defun gnus-group-clear-dribble ()
4257   "Clear all information from the dribble buffer."
4258   (interactive)
4259   (gnus-dribble-clear)
4260   (gnus-message 7 "Cleared dribble buffer"))
4261
4262 (defun gnus-group-exit ()
4263   "Quit reading news after updating .newsrc.eld and .newsrc.
4264 The hook `gnus-exit-gnus-hook' is called before actually exiting."
4265   (interactive)
4266   (when
4267       (or noninteractive                ;For gnus-batch-kill
4268           (not gnus-interactive-exit)   ;Without confirmation
4269           gnus-expert-user
4270           (gnus-y-or-n-p "Are you sure you want to quit reading news? "))
4271     (gnus-run-hooks 'gnus-exit-gnus-hook)
4272     ;; Offer to save data from non-quitted summary buffers.
4273     (gnus-offer-save-summaries)
4274     ;; Save the newsrc file(s).
4275     (gnus-save-newsrc-file)
4276     ;; Kill-em-all.
4277     (gnus-close-backends)
4278     ;; Reset everything.
4279     (gnus-clear-system)
4280     ;; Allow the user to do things after cleaning up.
4281     (gnus-run-hooks 'gnus-after-exiting-gnus-hook)))
4282
4283 (defun gnus-group-quit ()
4284   "Quit reading news without updating .newsrc.eld or .newsrc.
4285 The hook `gnus-exit-gnus-hook' is called before actually exiting."
4286   (interactive)
4287   (when (or noninteractive              ;For gnus-batch-kill
4288             (zerop (buffer-size))
4289             (not (gnus-server-opened gnus-select-method))
4290             gnus-expert-user
4291             (not gnus-current-startup-file)
4292             (gnus-yes-or-no-p