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