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