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

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