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