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