cgit.sxemacs.org Git - gnus/blob - lisp/gnus-group.el

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