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