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

   1 ;;; gnus-group.el --- group mode commands for Gnus
   2 ;; Copyright (C) 1996 Free Software Foundation, Inc.
   3
   4 ;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
   5 ;; Keywords: news
   6
   7 ;; This file is part of GNU Emacs.
   8
   9 ;; GNU Emacs is free software; you can redistribute it and/or modify
  10 ;; it under the terms of the GNU General Public License as published by
  11 ;; the Free Software Foundation; either version 2, or (at your option)
  12 ;; any later version.
  13
  14 ;; GNU Emacs is distributed in the hope that it will be useful,
  15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17 ;; GNU General Public License for more details.
  18
  19 ;; You should have received a copy of the GNU General Public License
  20 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  21 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  22 ;; Boston, MA 02111-1307, USA.
  23
  24 ;;; Commentary:
  25
  26 ;;; Code:
  27
  28 (require 'gnus-load)
  29 (require 'gnus-start)
  30 (require 'nnmail)
  31 (require 'gnus-spec)
  32 (require 'gnus-int)
  33 (require 'gnus-range)
  34 (require 'gnus-win)
  35 (require 'gnus-undo)
  36
  37 (defvar gnus-group-archive-directory
  38   "/ftp@ftp.hpc.uh.edu:/pub/emacs/ding-list/"
  39   "*The address of the (ding) archives.")
  40
  41 (defvar gnus-group-recent-archive-directory
  42   "/ftp@ftp.hpc.uh.edu:/pub/emacs/ding-list-recent/"
  43   "*The address of the most recent (ding) articles.")
  44
  45 ;; Suggested by Andrew Eskilsson <pi92ae@lelle.pt.hk-r.se>.
  46 (defvar gnus-no-groups-message "No news is horrible news"
  47   "*Message displayed by Gnus when no groups are available.")
  48
  49 (defvar gnus-keep-same-level nil
  50   "*Non-nil means that the next newsgroup after the current will be on the same level.
  51 When you type, for instance, `n' after reading the last article in the
  52 current newsgroup, you will go to the next newsgroup.  If this variable
  53 is nil, the next newsgroup will be the next from the group
  54 buffer.
  55 If this variable is non-nil, Gnus will either put you in the
  56 next newsgroup with the same level, or, if no such newsgroup is
  57 available, the next newsgroup with the lowest possible level higher
  58 than the current level.
  59 If this variable is `best', Gnus will make the next newsgroup the one
  60 with the best level.")
  61
  62 (defvar gnus-group-goto-unread t
  63   "*If non-nil, movement commands will go to the next unread and subscribed group.")
  64
  65 (defvar gnus-goto-next-group-when-activating t
  66   "*If non-nil, the \\<gnus-group-mode-map>\\[gnus-group-get-new-news-this-group] command will advance point to the next group.")
  67
  68 (defvar gnus-permanently-visible-groups nil
  69   "*Regexp to match groups that should always be listed in the group buffer.
  70 This means that they will still be listed when there are no unread
  71 articles in the groups.")
  72
  73 (defvar gnus-list-groups-with-ticked-articles t
  74   "*If non-nil, list groups that have only ticked articles.
  75 If nil, only list groups that have unread articles.")
  76
  77 (defvar gnus-group-default-list-level gnus-level-subscribed
  78   "*Default listing level.
  79 Ignored if `gnus-group-use-permanent-levels' is non-nil.")
  80
  81 (defvar gnus-group-list-inactive-groups t
  82   "*If non-nil, inactive groups will be listed.")
  83
  84 (defvar gnus-group-sort-function 'gnus-group-sort-by-alphabet
  85   "*Function used for sorting the group buffer.
  86 This function will be called with group info entries as the arguments
  87 for the groups to be sorted.  Pre-made functions include
  88 `gnus-group-sort-by-alphabet', `gnus-group-sort-by-unread',
  89 `gnus-group-sort-by-level', `gnus-group-sort-by-score',
  90 `gnus-group-sort-by-method', and `gnus-group-sort-by-rank'.
  91
  92 This variable can also be a list of sorting functions.  In that case,
  93 the most significant sort function should be the last function in the
  94 list.")
  95
  96 (defvar gnus-group-line-format "%M\%S\%p\%P\%5y: %(%g%)%l\n"
  97   "*Format of group lines.
  98 It works along the same lines as a normal formatting string,
  99 with some simple extensions.
 100
 101 %M    Only marked articles (character, \"*\" or \" \")
 102 %S    Whether the group is subscribed (character, \"U\", \"K\", \"Z\" or \" \")
 103 %L    Level of subscribedness (integer)
 104 %N    Number of unread articles (integer)
 105 %I    Number of dormant articles (integer)
 106 %i    Number of ticked and dormant (integer)
 107 %T    Number of ticked articles (integer)
 108 %R    Number of read articles (integer)
 109 %t    Estimated total number of articles (integer)
 110 %y    Number of unread, unticked articles (integer)
 111 %G    Group name (string)
 112 %g    Qualified group name (string)
 113 %D    Group description (string)
 114 %s    Select method (string)
 115 %o    Moderated group (char, \"m\")
 116 %p    Process mark (char)
 117 %O    Moderated group (string, \"(m)\" or \"\")
 118 %P    Topic indentation (string)
 119 %l    Whether there are GroupLens predictions for this group (string)
 120 %n    Select from where (string)
 121 %z    A string that look like `<%s:%n>' if a foreign select method is used
 122 %u    User defined specifier.  The next character in the format string should
 123       be a letter.  Gnus will call the function gnus-user-format-function-X,
 124       where X is the letter following %u.  The function will be passed the
 125       current header as argument.  The function should return a string, which
 126       will be inserted into the buffer just like information from any other
 127       group specifier.
 128
 129 Text between %( and %) will be highlighted with `gnus-mouse-face' when
 130 the mouse point move inside the area.  There can only be one such area.
 131
 132 Note that this format specification is not always respected.  For
 133 reasons of efficiency, when listing killed groups, this specification
 134 is ignored altogether.  If the spec is changed considerably, your
 135 output may end up looking strange when listing both alive and killed
 136 groups.
 137
 138 If you use %o or %O, reading the active file will be slower and quite
 139 a bit of extra memory will be used. %D will also worsen performance.
 140 Also note that if you change the format specification to include any
 141 of these specs, you must probably re-start Gnus to see them go into
 142 effect.")
 143
 144 (defvar gnus-group-mode-line-format "Gnus: %%b {%M\%:%S}"
 145   "*The format specification for the group mode line.
 146 It works along the same lines as a normal formatting string,
 147 with some simple extensions:
 148
 149 %S   The native news server.
 150 %M   The native select method.
 151 %:   \":\" if %S isn't \"\".")
 152
 153 (defvar gnus-group-mode-hook nil
 154   "*A hook for Gnus group mode.")
 155
 156 (defvar gnus-group-catchup-group-hook nil
 157   "*A hook run when catching up a group from the group buffer.")
 158
 159 (defvar gnus-group-update-group-hook nil
 160   "*A hook called when updating group lines.")
 161
 162 (defvar gnus-group-prepare-function 'gnus-group-prepare-flat
 163   "*A function that is called to generate the group buffer.
 164 The function is called with three arguments: The first is a number;
 165 all group with a level less or equal to that number should be listed,
 166 if the second is non-nil, empty groups should also be displayed.  If
 167 the third is non-nil, it is a number.  No groups with a level lower
 168 than this number should be displayed.
 169
 170 The only current function implemented is `gnus-group-prepare-flat'.")
 171
 172 (defvar gnus-group-prepare-hook nil
 173   "*A hook called after the group buffer has been generated.
 174 If you want to modify the group buffer, you can use this hook.")
 175
 176 (defvar gnus-suspend-gnus-hook nil
 177   "*A hook called when suspending (not exiting) Gnus.")
 178
 179 (defvar gnus-exit-gnus-hook nil
 180   "*A hook called when exiting Gnus.")
 181
 182 (defvar gnus-after-exiting-gnus-hook nil
 183   "*A hook called after exiting Gnus.")
 184
 185 (defvar gnus-group-update-hook '(gnus-group-highlight-line)
 186   "*A hook called when a group line is changed.
 187 The hook will not be called if `gnus-visual' is nil.
 188
 189 The default function `gnus-group-highlight-line' will
 190 highlight the line according to the `gnus-group-highlight'
 191 variable.")
 192
 193 ;;; Internal variables
 194
 195 (defvar gnus-group-indentation-function nil)
 196 (defvar gnus-goto-missing-group-function nil)
 197 (defvar gnus-group-get-parameter-function 'gnus-group-get-parameter)
 198 (defvar gnus-group-goto-next-group-function nil
 199   "Function to override finding the next group after listing groups.")
 200
 201 (defvar gnus-group-edit-buffer nil)
 202
 203 (defvar gnus-group-line-format-alist
 204   `((?M gnus-tmp-marked-mark ?c)
 205     (?S gnus-tmp-subscribed ?c)
 206     (?L gnus-tmp-level ?d)
 207     (?N (cond ((eq number t) "*" )
 208               ((numberp number)
 209                (int-to-string
 210                 (+ number
 211                    (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked)))
 212                    (gnus-range-length (cdr (assq 'tick gnus-tmp-marked))))))
 213               (t number)) ?s)
 214     (?R gnus-tmp-number-of-read ?s)
 215     (?t gnus-tmp-number-total ?d)
 216     (?y gnus-tmp-number-of-unread ?s)
 217     (?I (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked))) ?d)
 218     (?T (gnus-range-length (cdr (assq 'tick gnus-tmp-marked))) ?d)
 219     (?i (+ (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked)))
 220            (gnus-range-length (cdr (assq 'tick gnus-tmp-marked)))) ?d)
 221     (?g gnus-tmp-group ?s)
 222     (?G gnus-tmp-qualified-group ?s)
 223     (?c (gnus-short-group-name gnus-tmp-group) ?s)
 224     (?D gnus-tmp-newsgroup-description ?s)
 225     (?o gnus-tmp-moderated ?c)
 226     (?O gnus-tmp-moderated-string ?s)
 227     (?p gnus-tmp-process-marked ?c)
 228     (?s gnus-tmp-news-server ?s)
 229     (?n gnus-tmp-news-method ?s)
 230     (?P gnus-group-indentation ?s)
 231     (?l gnus-tmp-grouplens ?s)
 232     (?z gnus-tmp-news-method-string ?s)
 233     (?u gnus-tmp-user-defined ?s)))
 234
 235 (defvar gnus-group-mode-line-format-alist
 236   `((?S gnus-tmp-news-server ?s)
 237     (?M gnus-tmp-news-method ?s)
 238     (?u gnus-tmp-user-defined ?s)
 239     (?: gnus-tmp-colon ?s)))
 240
 241 (defvar gnus-topic-topology nil
 242   "The complete topic hierarchy.")
 243
 244 (defvar gnus-topic-alist nil
 245   "The complete topic-group alist.")
 246
 247 (defvar gnus-group-marked nil)
 248
 249 (defvar gnus-group-list-mode nil)
 250
 251 ;;;
 252 ;;; Gnus group mode
 253 ;;;
 254
 255 (put 'gnus-group-mode 'mode-class 'special)
 256
 257 (when t
 258   (gnus-define-keys gnus-group-mode-map
 259     " " gnus-group-read-group
 260     "=" gnus-group-select-group
 261     "\r" gnus-group-select-group
 262     "\M-\r" gnus-group-quick-select-group
 263     "j" gnus-group-jump-to-group
 264     "n" gnus-group-next-unread-group
 265     "p" gnus-group-prev-unread-group
 266     "\177" gnus-group-prev-unread-group
 267     [delete] gnus-group-prev-unread-group
 268     "N" gnus-group-next-group
 269     "P" gnus-group-prev-group
 270     "\M-n" gnus-group-next-unread-group-same-level
 271     "\M-p" gnus-group-prev-unread-group-same-level
 272     "," gnus-group-best-unread-group
 273     "." gnus-group-first-unread-group
 274     "u" gnus-group-unsubscribe-current-group
 275     "U" gnus-group-unsubscribe-group
 276     "c" gnus-group-catchup-current
 277     "C" gnus-group-catchup-current-all
 278     "\M-c" gnus-group-clear-data
 279     "l" gnus-group-list-groups
 280     "L" gnus-group-list-all-groups
 281     "m" gnus-group-mail
 282     "g" gnus-group-get-new-news
 283     "\M-g" gnus-group-get-new-news-this-group
 284     "R" gnus-group-restart
 285     "r" gnus-group-read-init-file
 286     "B" gnus-group-browse-foreign-server
 287     "b" gnus-group-check-bogus-groups
 288     "F" gnus-find-new-newsgroups
 289     "\C-c\C-d" gnus-group-describe-group
 290     "\M-d" gnus-group-describe-all-groups
 291     "\C-c\C-a" gnus-group-apropos
 292     "\C-c\M-\C-a" gnus-group-description-apropos
 293     "a" gnus-group-post-news
 294     "\ek" gnus-group-edit-local-kill
 295     "\eK" gnus-group-edit-global-kill
 296     "\C-k" gnus-group-kill-group
 297     "\C-y" gnus-group-yank-group
 298     "\C-w" gnus-group-kill-region
 299     "\C-x\C-t" gnus-group-transpose-groups
 300     "\C-c\C-l" gnus-group-list-killed
 301     "\C-c\C-x" gnus-group-expire-articles
 302     "\C-c\M-\C-x" gnus-group-expire-all-groups
 303     "V" gnus-version
 304     "s" gnus-group-save-newsrc
 305     "z" gnus-group-suspend
 306                                         ;    "Z" gnus-group-clear-dribble
 307     "q" gnus-group-exit
 308     "Q" gnus-group-quit
 309     "?" gnus-group-describe-briefly
 310     "\C-c\C-i" gnus-info-find-node
 311     "\M-e" gnus-group-edit-group-method
 312     "^" gnus-group-enter-server-mode
 313     gnus-mouse-2 gnus-mouse-pick-group
 314     "<" beginning-of-buffer
 315     ">" end-of-buffer
 316     "\C-c\C-b" gnus-bug
 317     "\C-c\C-s" gnus-group-sort-groups
 318     "t" gnus-topic-mode
 319     "\C-c\M-g" gnus-activate-all-groups
 320     "\M-&" gnus-group-universal-argument
 321     "#" gnus-group-mark-group
 322     "\M-#" gnus-group-unmark-group)
 323
 324   (gnus-define-keys (gnus-group-mark-map "M" gnus-group-mode-map)
 325     "m" gnus-group-mark-group
 326     "u" gnus-group-unmark-group
 327     "w" gnus-group-mark-region
 328     "m" gnus-group-mark-buffer
 329     "r" gnus-group-mark-regexp
 330     "U" gnus-group-unmark-all-groups)
 331
 332   (gnus-define-keys (gnus-group-group-map "G" gnus-group-mode-map)
 333     "d" gnus-group-make-directory-group
 334     "h" gnus-group-make-help-group
 335     "a" gnus-group-make-archive-group
 336     "k" gnus-group-make-kiboze-group
 337     "m" gnus-group-make-group
 338     "E" gnus-group-edit-group
 339     "e" gnus-group-edit-group-method
 340     "p" gnus-group-edit-group-parameters
 341     "v" gnus-group-add-to-virtual
 342     "V" gnus-group-make-empty-virtual
 343     "D" gnus-group-enter-directory
 344     "f" gnus-group-make-doc-group
 345     "r" gnus-group-rename-group
 346     "\177" gnus-group-delete-group
 347     [delete] gnus-group-delete-group)
 348
 349   (gnus-define-keys (gnus-group-soup-map "s" gnus-group-group-map)
 350     "b" gnus-group-brew-soup
 351     "w" gnus-soup-save-areas
 352     "s" gnus-soup-send-replies
 353     "p" gnus-soup-pack-packet
 354     "r" nnsoup-pack-replies)
 355
 356   (gnus-define-keys (gnus-group-sort-map "S" gnus-group-group-map)
 357     "s" gnus-group-sort-groups
 358     "a" gnus-group-sort-groups-by-alphabet
 359     "u" gnus-group-sort-groups-by-unread
 360     "l" gnus-group-sort-groups-by-level
 361     "v" gnus-group-sort-groups-by-score
 362     "r" gnus-group-sort-groups-by-rank
 363     "m" gnus-group-sort-groups-by-method)
 364
 365   (gnus-define-keys (gnus-group-list-map "A" gnus-group-mode-map)
 366     "k" gnus-group-list-killed
 367     "z" gnus-group-list-zombies
 368     "s" gnus-group-list-groups
 369     "u" gnus-group-list-all-groups
 370     "A" gnus-group-list-active
 371     "a" gnus-group-apropos
 372     "d" gnus-group-description-apropos
 373     "m" gnus-group-list-matching
 374     "M" gnus-group-list-all-matching
 375     "l" gnus-group-list-level)
 376
 377   (gnus-define-keys (gnus-group-score-map "W" gnus-group-mode-map)
 378     "f" gnus-score-flush-cache)
 379
 380   (gnus-define-keys (gnus-group-help-map "H" gnus-group-mode-map)
 381     "f" gnus-group-fetch-faq)
 382
 383   (gnus-define-keys (gnus-group-sub-map "S" gnus-group-mode-map)
 384     "l" gnus-group-set-current-level
 385     "t" gnus-group-unsubscribe-current-group
 386     "s" gnus-group-unsubscribe-group
 387     "k" gnus-group-kill-group
 388     "y" gnus-group-yank-group
 389     "w" gnus-group-kill-region
 390     "\C-k" gnus-group-kill-level
 391     "z" gnus-group-kill-all-zombies))
 392
 393 (defun gnus-group-mode ()
 394   "Major mode for reading news.
 395
 396 All normal editing commands are switched off.
 397 \\<gnus-group-mode-map>
 398 The group buffer lists (some of) the groups available.  For instance,
 399 `\\[gnus-group-list-groups]' will list all subscribed groups with unread articles, while `\\[gnus-group-list-zombies]'
 400 lists all zombie groups.
 401
 402 Groups that are displayed can be entered with `\\[gnus-group-read-group]'.  To subscribe
 403 to a group not displayed, type `\\[gnus-group-unsubscribe-group]'.
 404
 405 For more in-depth information on this mode, read the manual (`\\[gnus-info-find-node]').
 406
 407 The following commands are available:
 408
 409 \\{gnus-group-mode-map}"
 410   (interactive)
 411   (when (and menu-bar-mode
 412              (gnus-visual-p 'group-menu 'menu))
 413     (gnus-group-make-menu-bar))
 414   (kill-all-local-variables)
 415   (gnus-simplify-mode-line)
 416   (setq major-mode 'gnus-group-mode)
 417   (setq mode-name "Group")
 418   (gnus-group-set-mode-line)
 419   (setq mode-line-process nil)
 420   (use-local-map gnus-group-mode-map)
 421   (buffer-disable-undo (current-buffer))
 422   (setq truncate-lines t)
 423   (setq buffer-read-only t)
 424   (gnus-update-format-specifications nil 'group 'group-mode)
 425   (gnus-update-group-mark-positions)
 426   (gnus-make-local-hook 'post-command-hook)
 427   (gnus-add-hook 'post-command-hook 'gnus-clear-inboxes-moved nil t)
 428   (when gnus-use-undo
 429     (gnus-undo-mode 1))
 430   (run-hooks 'gnus-group-mode-hook))
 431
 432 (defun gnus-update-group-mark-positions ()
 433   (save-excursion
 434     (let ((gnus-process-mark 128)
 435           (gnus-group-marked '("dummy.group"))
 436           (gnus-active-hashtb (make-vector 10 0)))
 437       (gnus-set-active "dummy.group" '(0 . 0))
 438       (gnus-set-work-buffer)
 439       (gnus-group-insert-group-line "dummy.group" 0 nil 0 nil)
 440       (goto-char (point-min))
 441       (setq gnus-group-mark-positions
 442             (list (cons 'process (and (search-forward "\200" nil t)
 443                                       (- (point) 2))))))))
 444
 445 (defun gnus-clear-inboxes-moved ()
 446   (setq nnmail-moved-inboxes nil))
 447
 448 (defun gnus-mouse-pick-group (e)
 449   "Enter the group under the mouse pointer."
 450   (interactive "e")
 451   (mouse-set-point e)
 452   (gnus-group-read-group nil))
 453
 454 ;; Look at LEVEL and find out what the level is really supposed to be.
 455 ;; If LEVEL is non-nil, LEVEL will be returned, if not, what happens
 456 ;; will depend on whether `gnus-group-use-permanent-levels' is used.
 457 (defun gnus-group-default-level (&optional level number-or-nil)
 458   (cond
 459    (gnus-group-use-permanent-levels
 460     (or (setq gnus-group-use-permanent-levels
 461               (or level (if (numberp gnus-group-use-permanent-levels)
 462                             gnus-group-use-permanent-levels
 463                           (or gnus-group-default-list-level
 464                               gnus-level-subscribed))))
 465         gnus-group-default-list-level gnus-level-subscribed))
 466    (number-or-nil
 467     level)
 468    (t
 469     (or level gnus-group-default-list-level gnus-level-subscribed))))
 470
 471 (defun gnus-group-setup-buffer ()
 472   (switch-to-buffer gnus-group-buffer)
 473   (unless (eq major-mode 'gnus-group-mode)
 474     (gnus-add-current-to-buffer-list)
 475     (gnus-group-mode)
 476     (when gnus-carpal
 477       (gnus-carpal-setup-buffer 'group))))
 478
 479 (defun gnus-group-list-groups (&optional level unread lowest)
 480   "List newsgroups with level LEVEL or lower that have unread articles.
 481 Default is all subscribed groups.
 482 If argument UNREAD is non-nil, groups with no unread articles are also
 483 listed."
 484   (interactive (list (if current-prefix-arg
 485                          (prefix-numeric-value current-prefix-arg)
 486                        (or
 487                         (gnus-group-default-level nil t)
 488                         gnus-group-default-list-level
 489                         gnus-level-subscribed))))
 490   (or level
 491       (setq level (car gnus-group-list-mode)
 492             unread (cdr gnus-group-list-mode)))
 493   (setq level (gnus-group-default-level level))
 494   (gnus-group-setup-buffer)             ;May call from out of group buffer
 495   (gnus-update-format-specifications)
 496   (let ((case-fold-search nil)
 497         (props (text-properties-at (gnus-point-at-bol)))
 498         (group (gnus-group-group-name)))
 499     (set-buffer gnus-group-buffer)
 500     (funcall gnus-group-prepare-function level unread lowest)
 501     (if (zerop (buffer-size))
 502         (gnus-message 5 gnus-no-groups-message)
 503       (goto-char (point-max))
 504       (when (or (not gnus-group-goto-next-group-function)
 505                 (not (funcall gnus-group-goto-next-group-function
 506                               group props)))
 507         (if (not group)
 508             ;; Go to the first group with unread articles.
 509             (gnus-group-search-forward t)
 510           ;; Find the right group to put point on.  If the current group
 511           ;; has disappeared in the new listing, try to find the next
 512           ;; one.        If no next one can be found, just leave point at the
 513           ;; first newsgroup in the buffer.
 514           (if (not (gnus-goto-char
 515                     (text-property-any
 516                      (point-min) (point-max)
 517                      'gnus-group (gnus-intern-safe group gnus-active-hashtb))))
 518               (let ((newsrc (cdddr (gnus-gethash group gnus-newsrc-hashtb))))
 519                 (while (and newsrc
 520                             (not (gnus-goto-char
 521                                   (text-property-any
 522                                    (point-min) (point-max) 'gnus-group
 523                                    (gnus-intern-safe
 524                                     (caar newsrc) gnus-active-hashtb)))))
 525                   (setq newsrc (cdr newsrc)))
 526                 (or newsrc (progn (goto-char (point-max))
 527                                   (forward-line -1)))))))
 528       ;; Adjust cursor point.
 529       (gnus-group-position-point))))
 530
 531 (defun gnus-group-list-level (level &optional all)
 532   "List groups on LEVEL.
 533 If ALL (the prefix), also list groups that have no unread articles."
 534   (interactive "nList groups on level: \nP")
 535   (gnus-group-list-groups level all level))
 536
 537 (defun gnus-group-prepare-flat (level &optional all lowest regexp)
 538   "List all newsgroups with unread articles of level LEVEL or lower.
 539 If ALL is non-nil, list groups that have no unread articles.
 540 If LOWEST is non-nil, list all newsgroups of level LOWEST or higher.
 541 If REGEXP, only list groups matching REGEXP."
 542   (set-buffer gnus-group-buffer)
 543   (let ((buffer-read-only nil)
 544         (newsrc (cdr gnus-newsrc-alist))
 545         (lowest (or lowest 1))
 546         info clevel unread group params)
 547     (erase-buffer)
 548     (if (< lowest gnus-level-zombie)
 549         ;; List living groups.
 550         (while newsrc
 551           (setq info (car newsrc)
 552                 group (gnus-info-group info)
 553                 params (gnus-info-params info)
 554                 newsrc (cdr newsrc)
 555                 unread (car (gnus-gethash group gnus-newsrc-hashtb)))
 556           (and unread                   ; This group might be bogus
 557                (or (not regexp)
 558                    (string-match regexp group))
 559                (<= (setq clevel (gnus-info-level info)) level)
 560                (>= clevel lowest)
 561                (or all                  ; We list all groups?
 562                    (if (eq unread t)    ; Unactivated?
 563                        gnus-group-list-inactive-groups ; We list unactivated
 564                      (> unread 0))      ; We list groups with unread articles
 565                    (and gnus-list-groups-with-ticked-articles
 566                         (cdr (assq 'tick (gnus-info-marks info))))
 567                                         ; And groups with tickeds
 568                    ;; Check for permanent visibility.
 569                    (and gnus-permanently-visible-groups
 570                         (string-match gnus-permanently-visible-groups
 571                                       group))
 572                    (memq 'visible params)
 573                    (cdr (assq 'visible params)))
 574                (gnus-group-insert-group-line
 575                 group (gnus-info-level info)
 576                 (gnus-info-marks info) unread (gnus-info-method info)))))
 577
 578     ;; List dead groups.
 579     (and (>= level gnus-level-zombie) (<= lowest gnus-level-zombie)
 580          (gnus-group-prepare-flat-list-dead
 581           (setq gnus-zombie-list (sort gnus-zombie-list 'string<))
 582           gnus-level-zombie ?Z
 583           regexp))
 584     (and (>= level gnus-level-killed) (<= lowest gnus-level-killed)
 585          (gnus-group-prepare-flat-list-dead
 586           (setq gnus-killed-list (sort gnus-killed-list 'string<))
 587           gnus-level-killed ?K regexp))
 588
 589     (gnus-group-set-mode-line)
 590     (setq gnus-group-list-mode (cons level all))
 591     (run-hooks 'gnus-group-prepare-hook)))
 592
 593 (defun gnus-group-prepare-flat-list-dead (groups level mark regexp)
 594   ;; List zombies and killed lists somewhat faster, which was
 595   ;; suggested by Jack Vinson <vinson@unagi.cis.upenn.edu>.  It does
 596   ;; this by ignoring the group format specification altogether.
 597   (let (group)
 598     (if regexp
 599         ;; This loop is used when listing groups that match some
 600         ;; regexp.
 601         (while groups
 602           (setq group (pop groups))
 603           (when (string-match regexp group)
 604             (gnus-add-text-properties
 605              (point) (prog1 (1+ (point))
 606                        (insert " " mark "     *: " group "\n"))
 607              (list 'gnus-group (gnus-intern-safe group gnus-active-hashtb)
 608                    'gnus-unread t
 609                    'gnus-level level))))
 610       ;; This loop is used when listing all groups.
 611       (while groups
 612         (gnus-add-text-properties
 613          (point) (prog1 (1+ (point))
 614                    (insert " " mark "     *: "
 615                            (setq group (pop groups)) "\n"))
 616          (list 'gnus-group (gnus-intern-safe group gnus-active-hashtb)
 617                'gnus-unread t
 618                'gnus-level level))))))
 619
 620 (defun gnus-group-update-group-line ()
 621   "Update the current line in the group buffer."
 622   (let* ((buffer-read-only nil)
 623          (group (gnus-group-group-name))
 624          (entry (and group (gnus-gethash group gnus-newsrc-hashtb)))
 625          gnus-group-indentation)
 626     (when group
 627       (and entry
 628            (not (gnus-ephemeral-group-p group))
 629            (gnus-dribble-enter
 630             (concat "(gnus-group-set-info '"
 631                     (prin1-to-string (nth 2 entry)) ")")))
 632       (setq gnus-group-indentation (gnus-group-group-indentation))
 633       (gnus-delete-line)
 634       (gnus-group-insert-group-line-info group)
 635       (forward-line -1)
 636       (gnus-group-position-point))))
 637
 638 (defun gnus-group-insert-group-line-info (group)
 639   "Insert GROUP on the current line."
 640   (let ((entry (gnus-gethash group gnus-newsrc-hashtb))
 641         active info)
 642     (if entry
 643         (progn
 644           ;; (Un)subscribed group.
 645           (setq info (nth 2 entry))
 646           (gnus-group-insert-group-line
 647            group (gnus-info-level info) (gnus-info-marks info)
 648            (or (car entry) t) (gnus-info-method info)))
 649       ;; This group is dead.
 650       (gnus-group-insert-group-line
 651        group
 652        (if (member group gnus-zombie-list) gnus-level-zombie gnus-level-killed)
 653        nil
 654        (if (setq active (gnus-active group))
 655            (- (1+ (cdr active)) (car active)) 0)
 656        nil))))
 657
 658 (defun gnus-group-insert-group-line (gnus-tmp-group gnus-tmp-level
 659                                                     gnus-tmp-marked number
 660                                                     gnus-tmp-method)
 661   "Insert a group line in the group buffer."
 662   (let* ((gnus-tmp-active (gnus-active gnus-tmp-group))
 663          (gnus-tmp-number-total
 664           (if gnus-tmp-active
 665               (1+ (- (cdr gnus-tmp-active) (car gnus-tmp-active)))
 666             0))
 667          (gnus-tmp-number-of-unread
 668           (if (numberp number) (int-to-string (max 0 number))
 669             "*"))
 670          (gnus-tmp-number-of-read
 671           (if (numberp number)
 672               (int-to-string (max 0 (- gnus-tmp-number-total number)))
 673             "*"))
 674          (gnus-tmp-subscribed
 675           (cond ((<= gnus-tmp-level gnus-level-subscribed) ? )
 676                 ((<= gnus-tmp-level gnus-level-unsubscribed) ?U)
 677                 ((= gnus-tmp-level gnus-level-zombie) ?Z)
 678                 (t ?K)))
 679          (gnus-tmp-qualified-group (gnus-group-real-name gnus-tmp-group))
 680          (gnus-tmp-newsgroup-description
 681           (if gnus-description-hashtb
 682               (or (gnus-gethash gnus-tmp-group gnus-description-hashtb) "")
 683             ""))
 684          (gnus-tmp-moderated
 685           (if (member gnus-tmp-group gnus-moderated-list) ?m ? ))
 686          (gnus-tmp-moderated-string
 687           (if (eq gnus-tmp-moderated ?m) "(m)" ""))
 688          (gnus-tmp-method
 689           (gnus-server-get-method gnus-tmp-group gnus-tmp-method))
 690          (gnus-tmp-news-server (or (cadr gnus-tmp-method) ""))
 691          (gnus-tmp-news-method (or (car gnus-tmp-method) ""))
 692          (gnus-tmp-news-method-string
 693           (if gnus-tmp-method
 694               (format "(%s:%s)" (car gnus-tmp-method)
 695                       (cadr gnus-tmp-method)) ""))
 696          (gnus-tmp-marked-mark
 697           (if (and (numberp number)
 698                    (zerop number)
 699                    (cdr (assq 'tick gnus-tmp-marked)))
 700               ?* ? ))
 701          (gnus-tmp-process-marked
 702           (if (member gnus-tmp-group gnus-group-marked)
 703               gnus-process-mark ? ))
 704          (gnus-tmp-grouplens
 705           (or (and gnus-use-grouplens
 706                    (bbb-grouplens-group-p gnus-tmp-group))
 707               ""))
 708          (buffer-read-only nil)
 709          header gnus-tmp-header)        ; passed as parameter to user-funcs.
 710     (beginning-of-line)
 711     (gnus-add-text-properties
 712      (point)
 713      (prog1 (1+ (point))
 714        ;; Insert the text.
 715        (eval gnus-group-line-format-spec))
 716      `(gnus-group ,(gnus-intern-safe gnus-tmp-group gnus-active-hashtb)
 717        gnus-unread ,(if (numberp number)
 718                         (string-to-int gnus-tmp-number-of-unread)
 719                       t)
 720        gnus-marked ,gnus-tmp-marked-mark
 721        gnus-indentation ,gnus-group-indentation
 722        gnus-level ,gnus-tmp-level))
 723     (when (inline (gnus-visual-p 'group-highlight 'highlight))
 724       (forward-line -1)
 725       (run-hooks 'gnus-group-update-hook)
 726       (forward-line))
 727     ;; Allow XEmacs to remove front-sticky text properties.
 728     (gnus-group-remove-excess-properties)))
 729
 730 (defun gnus-group-update-group (group &optional visible-only)
 731   "Update all lines where GROUP appear.
 732 If VISIBLE-ONLY is non-nil, the group won't be displayed if it isn't
 733 already."
 734   (save-excursion
 735     (set-buffer gnus-group-buffer)
 736     ;; The buffer may be narrowed.
 737     (save-restriction
 738       (widen)
 739       (let ((ident (gnus-intern-safe group gnus-active-hashtb))
 740             (loc (point-min))
 741             found buffer-read-only)
 742         ;; Enter the current status into the dribble buffer.
 743         (let ((entry (gnus-gethash group gnus-newsrc-hashtb)))
 744           (if (and entry (not (gnus-ephemeral-group-p group)))
 745               (gnus-dribble-enter
 746                (concat "(gnus-group-set-info '" (prin1-to-string (nth 2 entry))
 747                        ")"))))
 748         ;; Find all group instances.  If topics are in use, each group
 749         ;; may be listed in more than once.
 750         (while (setq loc (text-property-any
 751                           loc (point-max) 'gnus-group ident))
 752           (setq found t)
 753           (goto-char loc)
 754           (let ((gnus-group-indentation (gnus-group-group-indentation)))
 755             (gnus-delete-line)
 756             (gnus-group-insert-group-line-info group)
 757             (save-excursion
 758               (forward-line -1)
 759               (run-hooks 'gnus-group-update-group-hook)))
 760           (setq loc (1+ loc)))
 761         (unless (or found visible-only)
 762           ;; No such line in the buffer, find out where it's supposed to
 763           ;; go, and insert it there (or at the end of the buffer).
 764           (if gnus-goto-missing-group-function
 765               (funcall gnus-goto-missing-group-function group)
 766             (let ((entry (cddr (gnus-gethash group gnus-newsrc-hashtb))))
 767               (while (and entry (car entry)
 768                           (not
 769                            (gnus-goto-char
 770                             (text-property-any
 771                              (point-min) (point-max)
 772                              'gnus-group (gnus-intern-safe
 773                                           (caar entry) gnus-active-hashtb)))))
 774                 (setq entry (cdr entry)))
 775               (or entry (goto-char (point-max)))))
 776           ;; Finally insert the line.
 777           (let ((gnus-group-indentation (gnus-group-group-indentation)))
 778             (gnus-group-insert-group-line-info group)
 779             (save-excursion
 780               (forward-line -1)
 781               (run-hooks 'gnus-group-update-group-hook))))
 782         (gnus-group-set-mode-line)))))
 783
 784 (defun gnus-group-set-mode-line ()
 785   "Update the mode line in the group buffer."
 786   (when (memq 'group gnus-updated-mode-lines)
 787     ;; Yes, we want to keep this mode line updated.
 788     (save-excursion
 789       (set-buffer gnus-group-buffer)
 790       (let* ((gformat (or gnus-group-mode-line-format-spec
 791                           (setq gnus-group-mode-line-format-spec
 792                                 (gnus-parse-format
 793                                  gnus-group-mode-line-format
 794                                  gnus-group-mode-line-format-alist))))
 795              (gnus-tmp-news-server (cadr gnus-select-method))
 796              (gnus-tmp-news-method (car gnus-select-method))
 797              (gnus-tmp-colon (if (equal gnus-tmp-news-server "") "" ":"))
 798              (max-len 60)
 799              gnus-tmp-header            ;Dummy binding for user-defined formats
 800              ;; Get the resulting string.
 801              (modified
 802               (and gnus-dribble-buffer
 803                    (buffer-name gnus-dribble-buffer)
 804                    (buffer-modified-p gnus-dribble-buffer)
 805                    (save-excursion
 806                      (set-buffer gnus-dribble-buffer)
 807                      (not (zerop (buffer-size))))))
 808              (mode-string (eval gformat)))
 809         ;; Say whether the dribble buffer has been modified.
 810         (setq mode-line-modified
 811               (if modified "---*- " "----- "))
 812         ;; If the line is too long, we chop it off.
 813         (when (> (length mode-string) max-len)
 814           (setq mode-string (substring mode-string 0 (- max-len 4))))
 815         (prog1
 816             (setq mode-line-buffer-identification
 817                   (gnus-mode-line-buffer-identification
 818                    (list mode-string)))
 819           (set-buffer-modified-p modified))))))
 820
 821 (defun gnus-group-group-name ()
 822   "Get the name of the newsgroup on the current line."
 823   (let ((group (get-text-property (gnus-point-at-bol) 'gnus-group)))
 824     (and group (symbol-name group))))
 825
 826 (defun gnus-group-group-level ()
 827   "Get the level of the newsgroup on the current line."
 828   (get-text-property (gnus-point-at-bol) 'gnus-level))
 829
 830 (defun gnus-group-group-indentation ()
 831   "Get the indentation of the newsgroup on the current line."
 832   (or (get-text-property (gnus-point-at-bol) 'gnus-indentation)
 833       (and gnus-group-indentation-function
 834            (funcall gnus-group-indentation-function))
 835       ""))
 836
 837 (defun gnus-group-group-unread ()
 838   "Get the number of unread articles of the newsgroup on the current line."
 839   (get-text-property (gnus-point-at-bol) 'gnus-unread))
 840
 841 (defun gnus-group-search-forward (&optional backward all level first-too)
 842   "Find the next newsgroup with unread articles.
 843 If BACKWARD is non-nil, find the previous newsgroup instead.
 844 If ALL is non-nil, just find any newsgroup.
 845 If LEVEL is non-nil, find group with level LEVEL, or higher if no such
 846 group exists.
 847 If FIRST-TOO, the current line is also eligible as a target."
 848   (let ((way (if backward -1 1))
 849         (low gnus-level-killed)
 850         (beg (point))
 851         pos found lev)
 852     (if (and backward (progn (beginning-of-line)) (bobp))
 853         nil
 854       (or first-too (forward-line way))
 855       (while (and
 856               (not (eobp))
 857               (not (setq
 858                     found
 859                     (and (or all
 860                              (and
 861                               (let ((unread
 862                                      (get-text-property (point) 'gnus-unread)))
 863                                 (and (numberp unread) (> unread 0)))
 864                               (setq lev (get-text-property (point)
 865                                                            'gnus-level))
 866                               (<= lev gnus-level-subscribed)))
 867                          (or (not level)
 868                              (and (setq lev (get-text-property (point)
 869                                                                'gnus-level))
 870                                   (or (= lev level)
 871                                       (and (< lev low)
 872                                            (< level lev)
 873                                            (progn
 874                                              (setq low lev)
 875                                              (setq pos (point))
 876                                              nil))))))))
 877               (zerop (forward-line way)))))
 878     (if found
 879         (progn (gnus-group-position-point) t)
 880       (goto-char (or pos beg))
 881       (and pos t))))
 882
 883 ;;; Gnus group mode commands
 884
 885 ;; Group marking.
 886
 887 (defun gnus-group-mark-group (n &optional unmark no-advance)
 888   "Mark the current group."
 889   (interactive "p")
 890   (let ((buffer-read-only nil)
 891         group)
 892     (while (and (> n 0)
 893                 (not (eobp)))
 894       (when (setq group (gnus-group-group-name))
 895         ;; Go to the mark position.
 896         (beginning-of-line)
 897         (forward-char (or (cdr (assq 'process gnus-group-mark-positions)) 2))
 898         (subst-char-in-region
 899          (point) (1+ (point)) (following-char)
 900          (if unmark
 901              (progn
 902                (setq gnus-group-marked (delete group gnus-group-marked))
 903                ? )
 904            (setq gnus-group-marked
 905                  (cons group (delete group gnus-group-marked)))
 906            gnus-process-mark)))
 907       (unless no-advance
 908         (gnus-group-next-group 1))
 909       (decf n))
 910     (gnus-summary-position-point)
 911     n))
 912
 913 (defun gnus-group-unmark-group (n)
 914   "Remove the mark from the current group."
 915   (interactive "p")
 916   (gnus-group-mark-group n 'unmark)
 917   (gnus-group-position-point))
 918
 919 (defun gnus-group-unmark-all-groups ()
 920   "Unmark all groups."
 921   (interactive)
 922   (let ((groups gnus-group-marked))
 923     (save-excursion
 924       (while groups
 925         (gnus-group-remove-mark (pop groups)))))
 926   (gnus-group-position-point))
 927
 928 (defun gnus-group-mark-region (unmark beg end)
 929   "Mark all groups between point and mark.
 930 If UNMARK, remove the mark instead."
 931   (interactive "P\nr")
 932   (let ((num (count-lines beg end)))
 933     (save-excursion
 934       (goto-char beg)
 935       (- num (gnus-group-mark-group num unmark)))))
 936
 937 (defun gnus-group-mark-buffer (&optional unmark)
 938   "Mark all groups in the buffer.
 939 If UNMARK, remove the mark instead."
 940   (interactive "P")
 941   (gnus-group-mark-region unmark (point-min) (point-max)))
 942
 943 (defun gnus-group-mark-regexp (regexp)
 944   "Mark all groups that match some regexp."
 945   (interactive "sMark (regexp): ")
 946   (let ((alist (cdr gnus-newsrc-alist))
 947         group)
 948     (while alist
 949       (when (string-match regexp (setq group (gnus-info-group (pop alist))))
 950         (gnus-group-set-mark group))))
 951   (gnus-group-position-point))
 952
 953 (defun gnus-group-remove-mark (group)
 954   "Remove the process mark from GROUP and move point there.
 955 Return nil if the group isn't displayed."
 956   (if (gnus-group-goto-group group)
 957       (save-excursion
 958         (gnus-group-mark-group 1 'unmark t)
 959         t)
 960     (setq gnus-group-marked
 961           (delete group gnus-group-marked))
 962     nil))
 963
 964 (defun gnus-group-set-mark (group)
 965   "Set the process mark on GROUP."
 966   (if (gnus-group-goto-group group)
 967       (save-excursion
 968         (gnus-group-mark-group 1 nil t))
 969     (setq gnus-group-marked (cons group (delete group gnus-group-marked)))))
 970
 971 (defun gnus-group-universal-argument (arg &optional groups func)
 972   "Perform any command on all groups accoring to the process/prefix convention."
 973   (interactive "P")
 974   (let ((groups (or groups (gnus-group-process-prefix arg)))
 975         group func)
 976     (if (eq (setq func (or func
 977                            (key-binding
 978                             (read-key-sequence
 979                              (substitute-command-keys
 980                               "\\<gnus-group-mode-map>\\[gnus-group-universal-argument]")))))
 981             'undefined)
 982         (gnus-error 1 "Undefined key")
 983       (while groups
 984         (gnus-group-remove-mark (setq group (pop groups)))
 985         (command-execute func))))
 986   (gnus-group-position-point))
 987
 988 (defun gnus-group-process-prefix (n)
 989   "Return a list of groups to work on.
 990 Take into consideration N (the prefix) and the list of marked groups."
 991   (cond
 992    (n
 993     (setq n (prefix-numeric-value n))
 994     ;; There is a prefix, so we return a list of the N next
 995     ;; groups.
 996     (let ((way (if (< n 0) -1 1))
 997           (n (abs n))
 998           group groups)
 999       (save-excursion
1000         (while (and (> n 0)
1001                     (setq group (gnus-group-group-name)))
1002           (setq groups (cons group groups))
1003           (setq n (1- n))
1004           (gnus-group-next-group way)))
1005       (nreverse groups)))
1006    ((and (boundp 'transient-mark-mode)
1007          transient-mark-mode
1008          (boundp 'mark-active)
1009          mark-active)
1010     ;; Work on the region between point and mark.
1011     (let ((max (max (point) (mark)))
1012           groups)
1013       (save-excursion
1014         (goto-char (min (point) (mark)))
1015         (while
1016             (and
1017              (push (gnus-group-group-name) groups)
1018              (zerop (gnus-group-next-group 1))
1019              (< (point) max)))
1020         (nreverse groups))))
1021    (gnus-group-marked
1022     ;; No prefix, but a list of marked articles.
1023     (reverse gnus-group-marked))
1024    (t
1025     ;; Neither marked articles or a prefix, so we return the
1026     ;; current group.
1027     (let ((group (gnus-group-group-name)))
1028       (and group (list group))))))
1029
1030 ;; Selecting groups.
1031
1032 (defun gnus-group-read-group (&optional all no-article group)
1033   "Read news in this newsgroup.
1034 If the prefix argument ALL is non-nil, already read articles become
1035 readable.  IF ALL is a number, fetch this number of articles.  If the
1036 optional argument NO-ARTICLE is non-nil, no article will be
1037 auto-selected upon group entry.  If GROUP is non-nil, fetch that
1038 group."
1039   (interactive "P")
1040   (let ((group (or group (gnus-group-group-name)))
1041         number active marked entry)
1042     (or group (error "No group on current line"))
1043     (setq marked (nth 3 (nth 2 (setq entry (gnus-gethash
1044                                             group gnus-newsrc-hashtb)))))
1045     ;; This group might be a dead group.  In that case we have to get
1046     ;; the number of unread articles from `gnus-active-hashtb'.
1047     (setq number
1048           (cond ((numberp all) all)
1049                 (entry (car entry))
1050                 ((setq active (gnus-active group))
1051                  (- (1+ (cdr active)) (car active)))))
1052     (gnus-summary-read-group
1053      group (or all (and (numberp number)
1054                         (zerop (+ number (gnus-range-length
1055                                           (cdr (assq 'tick marked)))
1056                                   (gnus-range-length
1057                                    (cdr (assq 'dormant marked)))))))
1058      no-article)))
1059
1060 (defun gnus-group-select-group (&optional all)
1061   "Select this newsgroup.
1062 No article is selected automatically.
1063 If ALL is non-nil, already read articles become readable.
1064 If ALL is a number, fetch this number of articles."
1065   (interactive "P")
1066   (gnus-group-read-group all t))
1067
1068 (defun gnus-group-quick-select-group (&optional all)
1069   "Select the current group \"quickly\".
1070 This means that no highlighting or scoring will be performed."
1071   (interactive "P")
1072   (let (gnus-visual
1073         gnus-score-find-score-files-function
1074         gnus-apply-kill-hook
1075         gnus-summary-expunge-below)
1076     (gnus-group-read-group all t)))
1077
1078 (defun gnus-group-visible-select-group (&optional all)
1079   "Select the current group without hiding any articles."
1080   (interactive "P")
1081   (let ((gnus-inhibit-limiting t))
1082     (gnus-group-read-group all t)))
1083
1084 ;;;###autoload
1085 (defun gnus-fetch-group (group)
1086   "Start Gnus if necessary and enter GROUP.
1087 Returns whether the fetching was successful or not."
1088   (interactive "sGroup name: ")
1089   (or (get-buffer gnus-group-buffer)
1090       (gnus))
1091   (gnus-group-read-group nil nil group))
1092
1093 ;; Enter a group that is not in the group buffer.  Non-nil is returned
1094 ;; if selection was successful.
1095 (defun gnus-group-read-ephemeral-group
1096   (group method &optional activate quit-config request-only)
1097   "Read GROUP from METHOD as an ephemeral group.
1098 If ACTIVATE, request the group first.
1099 If QUIT-CONFIG, use that window configuration when
1100 exiting from the ephemeral group.
1101 If REQUEST-ONLY, don't actually read the group; just
1102 request it.
1103
1104 Return the name of the group is selection was successful."
1105   (let ((group (if (gnus-group-foreign-p group) group
1106                  (gnus-group-prefixed-name group method))))
1107     (gnus-sethash
1108      group
1109      `(t nil (,group ,gnus-level-default-subscribed nil nil ,method
1110                      ((quit-config . ,(if quit-config quit-config
1111                                         (cons (current-buffer) 'summary))))))
1112      gnus-newsrc-hashtb)
1113     (set-buffer gnus-group-buffer)
1114     (unless (gnus-check-server method)
1115       (error "Unable to contact server: %s" (gnus-status-message method)))
1116     (when activate
1117       (unless (gnus-request-group group)
1118         (error "Couldn't request group")))
1119     (if request-only
1120         group
1121       (condition-case ()
1122           (when (gnus-group-read-group t t group)
1123             group)
1124         ;;(error nil)
1125         (quit nil)))))
1126
1127 (defun gnus-group-jump-to-group (group)
1128   "Jump to newsgroup GROUP."
1129   (interactive
1130    (list (completing-read
1131           "Group: " gnus-active-hashtb nil
1132           (gnus-read-active-file-p)
1133           nil
1134           'gnus-group-history)))
1135
1136   (when (equal group "")
1137     (error "Empty group name"))
1138
1139   (when (string-match "[\000-\032]" group)
1140     (error "Control characters in group: %s" group))
1141
1142   (let ((b (text-property-any
1143             (point-min) (point-max)
1144             'gnus-group (gnus-intern-safe group gnus-active-hashtb))))
1145     (unless (gnus-ephemeral-group-p group)
1146       (if b
1147           ;; Either go to the line in the group buffer...
1148           (goto-char b)
1149         ;; ... or insert the line.
1150         (or
1151          t ;; Don't activate group.
1152          (gnus-active group)
1153          (gnus-activate-group group)
1154          (error "%s error: %s" group (gnus-status-message group)))
1155
1156         (gnus-group-update-group group)
1157         (goto-char (text-property-any
1158                     (point-min) (point-max)
1159                     'gnus-group (gnus-intern-safe group gnus-active-hashtb)))))
1160     ;; Adjust cursor point.
1161     (gnus-group-position-point)))
1162
1163 (defun gnus-group-goto-group (group &optional far)
1164   "Goto to newsgroup GROUP.
1165 If FAR, it is likely that the group is not on the current line."
1166   (when group
1167     (if far
1168         (gnus-goto-char
1169          (text-property-any
1170           (point-min) (point-max)
1171           'gnus-group (gnus-intern-safe group gnus-active-hashtb)))
1172       (beginning-of-line)
1173       (cond
1174        ;; It's quite likely that we are on the right line, so
1175        ;; we check the current line first.
1176        ((eq (get-text-property (point) 'gnus-group)
1177             (gnus-intern-safe group gnus-active-hashtb))
1178         (point))
1179        ;; Previous and next line are also likely, so we check them as well.
1180        ((save-excursion
1181           (forward-line -1)
1182           (eq (get-text-property (point) 'gnus-group)
1183               (gnus-intern-safe group gnus-active-hashtb)))
1184         (forward-line -1)
1185         (point))
1186        ((save-excursion
1187           (forward-line 1)
1188           (eq (get-text-property (point) 'gnus-group)
1189               (gnus-intern-safe group gnus-active-hashtb)))
1190         (forward-line 1)
1191         (point))
1192        (t
1193         ;; Search through the entire buffer.
1194         (gnus-goto-char
1195          (text-property-any
1196           (point-min) (point-max)
1197           'gnus-group (gnus-intern-safe group gnus-active-hashtb))))))))
1198
1199 (defun gnus-group-next-group (n &optional silent)
1200   "Go to next N'th newsgroup.
1201 If N is negative, search backward instead.
1202 Returns the difference between N and the number of skips actually
1203 done."
1204   (interactive "p")
1205   (gnus-group-next-unread-group n t nil silent))
1206
1207 (defun gnus-group-next-unread-group (n &optional all level silent)
1208   "Go to next N'th unread newsgroup.
1209 If N is negative, search backward instead.
1210 If ALL is non-nil, choose any newsgroup, unread or not.
1211 If LEVEL is non-nil, choose the next group with level LEVEL, or, if no
1212 such group can be found, the next group with a level higher than
1213 LEVEL.
1214 Returns the difference between N and the number of skips actually
1215 made."
1216   (interactive "p")
1217   (let ((backward (< n 0))
1218         (n (abs n)))
1219     (while (and (> n 0)
1220                 (gnus-group-search-forward
1221                  backward (or (not gnus-group-goto-unread) all) level))
1222       (setq n (1- n)))
1223     (when (and (/= 0 n)
1224                (not silent))
1225       (gnus-message 7 "No more%s newsgroups%s" (if all "" " unread")
1226                     (if level " on this level or higher" "")))
1227     n))
1228
1229 (defun gnus-group-prev-group (n)
1230   "Go to previous N'th newsgroup.
1231 Returns the difference between N and the number of skips actually
1232 done."
1233   (interactive "p")
1234   (gnus-group-next-unread-group (- n) t))
1235
1236 (defun gnus-group-prev-unread-group (n)
1237   "Go to previous N'th unread newsgroup.
1238 Returns the difference between N and the number of skips actually
1239 done."
1240   (interactive "p")
1241   (gnus-group-next-unread-group (- n)))
1242
1243 (defun gnus-group-next-unread-group-same-level (n)
1244   "Go to next N'th unread newsgroup on the same level.
1245 If N is negative, search backward instead.
1246 Returns the difference between N and the number of skips actually
1247 done."
1248   (interactive "p")
1249   (gnus-group-next-unread-group n t (gnus-group-group-level))
1250   (gnus-group-position-point))
1251
1252 (defun gnus-group-prev-unread-group-same-level (n)
1253   "Go to next N'th unread newsgroup on the same level.
1254 Returns the difference between N and the number of skips actually
1255 done."
1256   (interactive "p")
1257   (gnus-group-next-unread-group (- n) t (gnus-group-group-level))
1258   (gnus-group-position-point))
1259
1260 (defun gnus-group-best-unread-group (&optional exclude-group)
1261   "Go to the group with the highest level.
1262 If EXCLUDE-GROUP, do not go to that group."
1263   (interactive)
1264   (goto-char (point-min))
1265   (let ((best 100000)
1266         unread best-point)
1267     (while (not (eobp))
1268       (setq unread (get-text-property (point) 'gnus-unread))
1269       (if (and (numberp unread) (> unread 0))
1270           (progn
1271             (if (and (get-text-property (point) 'gnus-level)
1272                      (< (get-text-property (point) 'gnus-level) best)
1273                      (or (not exclude-group)
1274                          (not (equal exclude-group (gnus-group-group-name)))))
1275                 (progn
1276                   (setq best (get-text-property (point) 'gnus-level))
1277                   (setq best-point (point))))))
1278       (forward-line 1))
1279     (if best-point (goto-char best-point))
1280     (gnus-summary-position-point)
1281     (and best-point (gnus-group-group-name))))
1282
1283 (defun gnus-group-first-unread-group ()
1284   "Go to the first group with unread articles."
1285   (interactive)
1286   (prog1
1287       (let ((opoint (point))
1288             unread)
1289         (goto-char (point-min))
1290         (if (or (eq (setq unread (gnus-group-group-unread)) t) ; Not active.
1291                 (and (numberp unread)   ; Not a topic.
1292                      (not (zerop unread))) ; Has unread articles.
1293                 (zerop (gnus-group-next-unread-group 1))) ; Next unread group.
1294             (point)                     ; Success.
1295           (goto-char opoint)
1296           nil))                         ; Not success.
1297     (gnus-group-position-point)))
1298
1299 (defun gnus-group-enter-server-mode ()
1300   "Jump to the server buffer."
1301   (interactive)
1302   (gnus-enter-server-buffer))
1303
1304 (defun gnus-group-make-group (name &optional method address)
1305   "Add a new newsgroup.
1306 The user will be prompted for a NAME, for a select METHOD, and an
1307 ADDRESS."
1308   (interactive
1309    (list
1310     (read-string "Group name: ")
1311     (gnus-read-method "From method: ")))
1312
1313   (let* ((meth (when (and method
1314                           (not (gnus-server-equal method gnus-select-method)))
1315                  (if address (list (intern method) address)
1316                    method)))
1317          (nname (if method (gnus-group-prefixed-name name meth) name))
1318          backend info)
1319     (when (gnus-gethash nname gnus-newsrc-hashtb)
1320       (error "Group %s already exists" nname))
1321     ;; Subscribe to the new group.
1322     (gnus-group-change-level
1323      (setq info (list t nname gnus-level-default-subscribed nil nil meth))
1324      gnus-level-default-subscribed gnus-level-killed
1325      (and (gnus-group-group-name)
1326           (gnus-gethash (gnus-group-group-name)
1327                         gnus-newsrc-hashtb))
1328      t)
1329     ;; Make it active.
1330     (gnus-set-active nname (cons 1 0))
1331     (or (gnus-ephemeral-group-p name)
1332         (gnus-dribble-enter
1333          (concat "(gnus-group-set-info '" (prin1-to-string (cdr info)) ")")))
1334     ;; Insert the line.
1335     (gnus-group-insert-group-line-info nname)
1336     (forward-line -1)
1337     (gnus-group-position-point)
1338
1339     ;; Load the backend and try to make the backend create
1340     ;; the group as well.
1341     (when (assoc (symbol-name (setq backend (car (gnus-server-get-method
1342                                                   nil meth))))
1343                  gnus-valid-select-methods)
1344       (require backend))
1345     (gnus-check-server meth)
1346     (and (gnus-check-backend-function 'request-create-group nname)
1347          (gnus-request-create-group nname))
1348     t))
1349
1350 (defun gnus-group-delete-group (group &optional force)
1351   "Delete the current group.  Only meaningful with mail groups.
1352 If FORCE (the prefix) is non-nil, all the articles in the group will
1353 be deleted.  This is \"deleted\" as in \"removed forever from the face
1354 of the Earth\".  There is no undo.  The user will be prompted before
1355 doing the deletion."
1356   (interactive
1357    (list (gnus-group-group-name)
1358          current-prefix-arg))
1359   (or group (error "No group to rename"))
1360   (or (gnus-check-backend-function 'request-delete-group group)
1361       (error "This backend does not support group deletion"))
1362   (prog1
1363       (if (not (gnus-yes-or-no-p
1364                 (format
1365                  "Do you really want to delete %s%s? "
1366                  group (if force " and all its contents" ""))))
1367           () ; Whew!
1368         (gnus-message 6 "Deleting group %s..." group)
1369         (if (not (gnus-request-delete-group group force))
1370             (gnus-error 3 "Couldn't delete group %s" group)
1371           (gnus-message 6 "Deleting group %s...done" group)
1372           (gnus-group-goto-group group)
1373           (gnus-group-kill-group 1 t)
1374           (gnus-sethash group nil gnus-active-hashtb)
1375           t))
1376     (gnus-group-position-point)))
1377
1378 (defun gnus-group-rename-group (group new-name)
1379   "Rename group from GROUP to NEW-NAME.
1380 When used interactively, GROUP is the group under point
1381 and NEW-NAME will be prompted for."
1382   (interactive
1383    (list
1384     (gnus-group-group-name)
1385     (progn
1386       (unless (gnus-check-backend-function
1387                'request-rename-group (gnus-group-group-name))
1388         (error "This backend does not support renaming groups"))
1389       (read-string "New group name: " (gnus-group-group-name)))))
1390
1391   (unless (gnus-check-backend-function 'request-rename-group group)
1392     (error "This backend does not support renaming groups"))
1393   (unless group
1394     (error "No group to rename"))
1395   (when (string-match "^[ \t]*$" new-name)
1396     (error "Not a valid group name"))
1397   (when (equal group new-name)
1398     (error "Can't rename to the same name"))
1399
1400   ;; We find the proper prefixed name.
1401   (setq new-name
1402         (if (equal (gnus-group-real-name new-name) new-name)
1403             ;; Native group.
1404             new-name
1405           ;; Foreign group.
1406           (gnus-group-prefixed-name
1407            (gnus-group-real-name new-name)
1408            (gnus-info-method (gnus-get-info group)))))
1409
1410   (gnus-message 6 "Renaming group %s to %s..." group new-name)
1411   (prog1
1412       (if (not (gnus-request-rename-group group new-name))
1413           (gnus-error 3 "Couldn't rename group %s to %s" group new-name)
1414         ;; We rename the group internally by killing it...
1415         (gnus-group-goto-group group)
1416         (gnus-group-kill-group)
1417         ;; ... changing its name ...
1418         (setcar (cdar gnus-list-of-killed-groups) new-name)
1419         ;; ... and then yanking it.  Magic!
1420         (gnus-group-yank-group)
1421         (gnus-set-active new-name (gnus-active group))
1422         (gnus-message 6 "Renaming group %s to %s...done" group new-name)
1423         new-name)
1424     (gnus-group-position-point)))
1425
1426 (defun gnus-group-edit-group (group &optional part)
1427   "Edit the group on the current line."
1428   (interactive (list (gnus-group-group-name)))
1429   (let ((part (or part 'info))
1430         info)
1431     (unless group
1432       (error "No group on current line"))
1433     (unless (setq info (gnus-get-info group))
1434       (error "Killed group; can't be edited"))
1435     (gnus-edit-form
1436      ;; Find the proper form to edit.
1437      (cond ((eq part 'method)
1438             (or (gnus-info-method info) "native"))
1439            ((eq part 'params)
1440             (gnus-info-params info))
1441            (t info))
1442      ;; The proper documentation.
1443      (format
1444       "Editing the %s."
1445       (cond
1446        ((eq part 'method) "select method")
1447        ((eq part 'params) "group parameters")
1448        (t "group info")))
1449      `(lambda (form)
1450         (gnus-group-edit-group-done ',part ,group form)))))
1451
1452 (defun gnus-group-edit-group-method (group)
1453   "Edit the select method of GROUP."
1454   (interactive (list (gnus-group-group-name)))
1455   (gnus-group-edit-group group 'method))
1456
1457 (defun gnus-group-edit-group-parameters (group)
1458   "Edit the group parameters of GROUP."
1459   (interactive (list (gnus-group-group-name)))
1460   (gnus-group-edit-group group 'params))
1461
1462 (defun gnus-group-edit-group-done (part group form)
1463   "Update variables."
1464   (let* ((method (cond ((eq part 'info) (nth 4 form))
1465                        ((eq part 'method) form)
1466                        (t nil)))
1467          (info (cond ((eq part 'info) form)
1468                      ((eq part 'method) (gnus-get-info group))
1469                      (t nil)))
1470          (new-group (if info
1471                         (if (or (not method)
1472                                 (gnus-server-equal
1473                                  gnus-select-method method))
1474                             (gnus-group-real-name (car info))
1475                           (gnus-group-prefixed-name
1476                            (gnus-group-real-name (car info)) method))
1477                       nil)))
1478     (when (and new-group
1479                (not (equal new-group group)))
1480       (when (gnus-group-goto-group group)
1481         (gnus-group-kill-group 1))
1482       (gnus-activate-group new-group))
1483     ;; Set the info.
1484     (if (not (and info new-group))
1485         (gnus-group-set-info form (or new-group group) part)
1486       (setq info (gnus-copy-sequence info))
1487       (setcar info new-group)
1488       (unless (gnus-server-equal method "native")
1489         (unless (nthcdr 3 info)
1490           (nconc info (list nil nil)))
1491         (unless (nthcdr 4 info)
1492           (nconc info (list nil)))
1493         (gnus-info-set-method info method))
1494       (gnus-group-set-info info))
1495     (gnus-group-update-group (or new-group group))
1496     (gnus-group-position-point)))
1497
1498 (defun gnus-group-make-help-group ()
1499   "Create the Gnus documentation group."
1500   (interactive)
1501   (let ((path load-path)
1502         (name (gnus-group-prefixed-name "gnus-help" '(nndoc "gnus-help")))
1503         file dir)
1504     (and (gnus-gethash name gnus-newsrc-hashtb)
1505          (error "Documentation group already exists"))
1506     (while path
1507       (setq dir (file-name-as-directory (expand-file-name (pop path)))
1508             file nil)
1509       (when (or (file-exists-p (setq file (concat dir "gnus-tut.txt")))
1510                 (file-exists-p
1511                  (setq file (concat (file-name-directory
1512                                      (directory-file-name dir))
1513                                     "etc/gnus-tut.txt"))))
1514         (setq path nil)))
1515     (if (not file)
1516         (gnus-message 1 "Couldn't find doc group")
1517       (gnus-group-make-group
1518        (gnus-group-real-name name)
1519        (list 'nndoc "gnus-help"
1520              (list 'nndoc-address file)
1521              (list 'nndoc-article-type 'mbox)))))
1522   (gnus-group-position-point))
1523
1524 (defun gnus-group-make-doc-group (file type)
1525   "Create a group that uses a single file as the source."
1526   (interactive
1527    (list (read-file-name "File name: ")
1528          (and current-prefix-arg 'ask)))
1529   (when (eq type 'ask)
1530     (let ((err "")
1531           char found)
1532       (while (not found)
1533         (message
1534          "%sFile type (mbox, babyl, digest, forward, mmfd, guess) [mbdfag]: "
1535          err)
1536         (setq found (cond ((= (setq char (read-char)) ?m) 'mbox)
1537                           ((= char ?b) 'babyl)
1538                           ((= char ?d) 'digest)
1539                           ((= char ?f) 'forward)
1540                           ((= char ?a) 'mmfd)
1541                           (t (setq err (format "%c unknown. " char))
1542                              nil))))
1543       (setq type found)))
1544   (let* ((file (expand-file-name file))
1545          (name (gnus-generate-new-group-name
1546                 (gnus-group-prefixed-name
1547                  (file-name-nondirectory file) '(nndoc "")))))
1548     (gnus-group-make-group
1549      (gnus-group-real-name name)
1550      (list 'nndoc file
1551            (list 'nndoc-address file)
1552            (list 'nndoc-article-type (or type 'guess))))))
1553
1554 (defun gnus-group-make-archive-group (&optional all)
1555   "Create the (ding) Gnus archive group of the most recent articles.
1556 Given a prefix, create a full group."
1557   (interactive "P")
1558   (let ((group (gnus-group-prefixed-name
1559                 (if all "ding.archives" "ding.recent") '(nndir ""))))
1560     (when (gnus-gethash group gnus-newsrc-hashtb)
1561       (error "Archive group already exists"))
1562     (gnus-group-make-group
1563      (gnus-group-real-name group)
1564      (list 'nndir (if all "hpc" "edu")
1565            (list 'nndir-directory
1566                  (if all gnus-group-archive-directory
1567                    gnus-group-recent-archive-directory))))
1568     (gnus-group-add-parameter group (cons 'to-address "ding@ifi.uio.no"))))
1569
1570 (defun gnus-group-make-directory-group (dir)
1571   "Create an nndir group.
1572 The user will be prompted for a directory.  The contents of this
1573 directory will be used as a newsgroup.  The directory should contain
1574 mail messages or news articles in files that have numeric names."
1575   (interactive
1576    (list (read-file-name "Create group from directory: ")))
1577   (or (file-exists-p dir) (error "No such directory"))
1578   (or (file-directory-p dir) (error "Not a directory"))
1579   (let ((ext "")
1580         (i 0)
1581         group)
1582     (while (or (not group) (gnus-gethash group gnus-newsrc-hashtb))
1583       (setq group
1584             (gnus-group-prefixed-name
1585              (concat (file-name-as-directory (directory-file-name dir))
1586                      ext)
1587              '(nndir "")))
1588       (setq ext (format "<%d>" (setq i (1+ i)))))
1589     (gnus-group-make-group
1590      (gnus-group-real-name group)
1591      (list 'nndir (gnus-group-real-name group) (list 'nndir-directory dir)))))
1592
1593 (defun gnus-group-make-kiboze-group (group address scores)
1594   "Create an nnkiboze group.
1595 The user will be prompted for a name, a regexp to match groups, and
1596 score file entries for articles to include in the group."
1597   (interactive
1598    (list
1599     (read-string "nnkiboze group name: ")
1600     (read-string "Source groups (regexp): ")
1601     (let ((headers (mapcar (lambda (group) (list group))
1602                            '("subject" "from" "number" "date" "message-id"
1603                              "references" "chars" "lines" "xref"
1604                              "followup" "all" "body" "head")))
1605           scores header regexp regexps)
1606       (while (not (equal "" (setq header (completing-read
1607                                           "Match on header: " headers nil t))))
1608         (setq regexps nil)
1609         (while (not (equal "" (setq regexp (read-string
1610                                             (format "Match on %s (string): "
1611                                                     header)))))
1612           (setq regexps (cons (list regexp nil nil 'r) regexps)))
1613         (setq scores (cons (cons header regexps) scores)))
1614       scores)))
1615   (gnus-group-make-group group "nnkiboze" address)
1616   (nnheader-temp-write (gnus-score-file-name (concat "nnkiboze:" group))
1617     (let (emacs-lisp-mode-hook)
1618       (pp scores (current-buffer)))))
1619
1620 (defun gnus-group-add-to-virtual (n vgroup)
1621   "Add the current group to a virtual group."
1622   (interactive
1623    (list current-prefix-arg
1624          (completing-read "Add to virtual group: " gnus-newsrc-hashtb nil t
1625                           "nnvirtual:")))
1626   (or (eq (car (gnus-find-method-for-group vgroup)) 'nnvirtual)
1627       (error "%s is not an nnvirtual group" vgroup))
1628   (let* ((groups (gnus-group-process-prefix n))
1629          (method (gnus-info-method (gnus-get-info vgroup))))
1630     (setcar (cdr method)
1631             (concat
1632              (nth 1 method) "\\|"
1633              (mapconcat
1634               (lambda (s)
1635                 (gnus-group-remove-mark s)
1636                 (concat "\\(^" (regexp-quote s) "$\\)"))
1637               groups "\\|"))))
1638   (gnus-group-position-point))
1639
1640 (defun gnus-group-make-empty-virtual (group)
1641   "Create a new, fresh, empty virtual group."
1642   (interactive "sCreate new, empty virtual group: ")
1643   (let* ((method (list 'nnvirtual "^$"))
1644          (pgroup (gnus-group-prefixed-name group method)))
1645     ;; Check whether it exists already.
1646     (and (gnus-gethash pgroup gnus-newsrc-hashtb)
1647          (error "Group %s already exists." pgroup))
1648     ;; Subscribe the new group after the group on the current line.
1649     (gnus-subscribe-group pgroup (gnus-group-group-name) method)
1650     (gnus-group-update-group pgroup)
1651     (forward-line -1)
1652     (gnus-group-position-point)))
1653
1654 (defun gnus-group-enter-directory (dir)
1655   "Enter an ephemeral nneething group."
1656   (interactive "DDirectory to read: ")
1657   (let* ((method (list 'nneething dir))
1658          (leaf (gnus-group-prefixed-name
1659                 (file-name-nondirectory (directory-file-name dir))
1660                 method))
1661          (name (gnus-generate-new-group-name leaf)))
1662     (let ((nneething-read-only t))
1663       (or (gnus-group-read-ephemeral-group
1664            name method t
1665            (cons (current-buffer) (if (eq major-mode 'gnus-summary-mode)
1666                                       'summary 'group)))
1667           (error "Couldn't enter %s" dir)))))
1668
1669 ;; Group sorting commands
1670 ;; Suggested by Joe Hildebrand <hildjj@idaho.fuentez.com>.
1671
1672 (defun gnus-group-sort-groups (func &optional reverse)
1673   "Sort the group buffer according to FUNC.
1674 If REVERSE, reverse the sorting order."
1675   (interactive (list gnus-group-sort-function
1676                      current-prefix-arg))
1677   (let ((func (cond
1678                ((not (listp func)) func)
1679                ((null func) func)
1680                ((= 1 (length func)) (car func))
1681                (t `(lambda (t1 t2)
1682                      ,(gnus-make-sort-function
1683                        (reverse func)))))))
1684     ;; We peel off the dummy group from the alist.
1685     (when func
1686       (when (equal (car (gnus-info-group gnus-newsrc-alist)) "dummy.group")
1687         (pop gnus-newsrc-alist))
1688       ;; Do the sorting.
1689       (setq gnus-newsrc-alist
1690             (sort gnus-newsrc-alist func))
1691       (when reverse
1692         (setq gnus-newsrc-alist (nreverse gnus-newsrc-alist)))
1693       ;; Regenerate the hash table.
1694       (gnus-make-hashtable-from-newsrc-alist)
1695       (gnus-group-list-groups))))
1696
1697 (defun gnus-group-sort-groups-by-alphabet (&optional reverse)
1698   "Sort the group buffer alphabetically by group name.
1699 If REVERSE, sort in reverse order."
1700   (interactive "P")
1701   (gnus-group-sort-groups 'gnus-group-sort-by-alphabet reverse))
1702
1703 (defun gnus-group-sort-groups-by-unread (&optional reverse)
1704   "Sort the group buffer by number of unread articles.
1705 If REVERSE, sort in reverse order."
1706   (interactive "P")
1707   (gnus-group-sort-groups 'gnus-group-sort-by-unread reverse))
1708
1709 (defun gnus-group-sort-groups-by-level (&optional reverse)
1710   "Sort the group buffer by group level.
1711 If REVERSE, sort in reverse order."
1712   (interactive "P")
1713   (gnus-group-sort-groups 'gnus-group-sort-by-level reverse))
1714
1715 (defun gnus-group-sort-groups-by-score (&optional reverse)
1716   "Sort the group buffer by group score.
1717 If REVERSE, sort in reverse order."
1718   (interactive "P")
1719   (gnus-group-sort-groups 'gnus-group-sort-by-score reverse))
1720
1721 (defun gnus-group-sort-groups-by-rank (&optional reverse)
1722   "Sort the group buffer by group rank.
1723 If REVERSE, sort in reverse order."
1724   (interactive "P")
1725   (gnus-group-sort-groups 'gnus-group-sort-by-rank reverse))
1726
1727 (defun gnus-group-sort-groups-by-method (&optional reverse)
1728   "Sort the group buffer alphabetically by backend name.
1729 If REVERSE, sort in reverse order."
1730   (interactive "P")
1731   (gnus-group-sort-groups 'gnus-group-sort-by-method reverse))
1732
1733 (defun gnus-group-sort-by-alphabet (info1 info2)
1734   "Sort alphabetically."
1735   (string< (gnus-info-group info1) (gnus-info-group info2)))
1736
1737 (defun gnus-group-sort-by-unread (info1 info2)
1738   "Sort by number of unread articles."
1739   (let ((n1 (car (gnus-gethash (gnus-info-group info1) gnus-newsrc-hashtb)))
1740         (n2 (car (gnus-gethash (gnus-info-group info2) gnus-newsrc-hashtb))))
1741     (< (or (and (numberp n1) n1) 0)
1742        (or (and (numberp n2) n2) 0))))
1743
1744 (defun gnus-group-sort-by-level (info1 info2)
1745   "Sort by level."
1746   (< (gnus-info-level info1) (gnus-info-level info2)))
1747
1748 (defun gnus-group-sort-by-method (info1 info2)
1749   "Sort alphabetically by backend name."
1750   (string< (symbol-name (car (gnus-find-method-for-group
1751                               (gnus-info-group info1) info1)))
1752            (symbol-name (car (gnus-find-method-for-group
1753                               (gnus-info-group info2) info2)))))
1754
1755 (defun gnus-group-sort-by-score (info1 info2)
1756   "Sort by group score."
1757   (< (gnus-info-score info1) (gnus-info-score info2)))
1758
1759 (defun gnus-group-sort-by-rank (info1 info2)
1760   "Sort by level and score."
1761   (let ((level1 (gnus-info-level info1))
1762         (level2 (gnus-info-level info2)))
1763     (or (< level1 level2)
1764         (and (= level1 level2)
1765              (> (gnus-info-score info1) (gnus-info-score info2))))))
1766
1767 ;;; Clearing data
1768
1769 (defun gnus-group-clear-data (n)
1770   "Clear all marks and read ranges from the current group."
1771   (interactive "P")
1772   (let ((groups (gnus-group-process-prefix n))
1773         group info)
1774     (while (setq group (pop groups))
1775       (gnus-info-clear-data (setq info (gnus-get-info group)))
1776       (gnus-get-unread-articles-in-group info (gnus-active group) t)
1777       (when (gnus-group-goto-group group)
1778         (gnus-group-remove-mark group)
1779         (gnus-group-update-group-line)))))
1780
1781 (defun gnus-group-clear-data-on-native-groups ()
1782   "Clear all marks and read ranges from all native groups."
1783   (interactive)
1784   (when (gnus-yes-or-no-p "Really clear all data from almost all groups? ")
1785     (let ((alist (cdr gnus-newsrc-alist))
1786           info)
1787       (while (setq info (pop alist))
1788         (gnus-info-clear-data info))
1789       (gnus-get-unread-articles))))
1790
1791 (defun gnus-info-clear-data (info)
1792   "Clear all marks and read ranges from INFO."
1793   (let ((group (gnus-info-group info)))
1794     (gnus-undo-register
1795       `(progn
1796          (gnus-info-set-marks ,info ,(gnus-info-marks info))
1797          (gnus-info-set-read ,info ,(gnus-info-read info))
1798          (when (gnus-group-goto-group ,group)
1799            (gnus-group-update-group-line))))
1800     (gnus-info-set-read info nil)
1801     (when (gnus-info-marks info)
1802       (gnus-info-set-marks info nil))))
1803
1804 ;; Group catching up.
1805
1806 (defun gnus-group-catchup-current (&optional n all)
1807   "Mark all articles not marked as unread in current newsgroup as read.
1808 If prefix argument N is numeric, the ARG next newsgroups will be
1809 caught up.  If ALL is non-nil, marked articles will also be marked as
1810 read.  Cross references (Xref: header) of articles are ignored.
1811 The difference between N and actual number of newsgroups that were
1812 caught up is returned."
1813   (interactive "P")
1814   (unless (gnus-group-group-name)
1815     (error "No group on the current line"))
1816   (if (not (or (not gnus-interactive-catchup) ;Without confirmation?
1817                gnus-expert-user
1818                (gnus-y-or-n-p
1819                 (if all
1820                     "Do you really want to mark all articles as read? "
1821                   "Mark all unread articles as read? "))))
1822       n
1823     (let ((groups (gnus-group-process-prefix n))
1824           (ret 0))
1825       (while groups
1826         ;; Virtual groups have to be given special treatment.
1827         (let ((method (gnus-find-method-for-group (car groups))))
1828           (if (eq 'nnvirtual (car method))
1829               (nnvirtual-catchup-group
1830                (gnus-group-real-name (car groups)) (nth 1 method) all)))
1831         (gnus-group-remove-mark (car groups))
1832         (if (>= (gnus-group-group-level) gnus-level-zombie)
1833             (gnus-message 2 "Dead groups can't be caught up")
1834           (if (prog1
1835                   (gnus-group-goto-group (car groups))
1836                 (gnus-group-catchup (car groups) all))
1837               (gnus-group-update-group-line)
1838             (setq ret (1+ ret))))
1839         (setq groups (cdr groups)))
1840       (gnus-group-next-unread-group 1)
1841       ret)))
1842
1843 (defun gnus-group-catchup-current-all (&optional n)
1844   "Mark all articles in current newsgroup as read.
1845 Cross references (Xref: header) of articles are ignored."
1846   (interactive "P")
1847   (gnus-group-catchup-current n 'all))
1848
1849 (defun gnus-group-catchup (group &optional all)
1850   "Mark all articles in GROUP as read.
1851 If ALL is non-nil, all articles are marked as read.
1852 The return value is the number of articles that were marked as read,
1853 or nil if no action could be taken."
1854   (let* ((entry (gnus-gethash group gnus-newsrc-hashtb))
1855          (num (car entry)))
1856     ;; Do the updating only if the newsgroup isn't killed.
1857     (if (not (numberp (car entry)))
1858         (gnus-message 1 "Can't catch up; non-active group")
1859       ;; Do auto-expirable marks if that's required.
1860       (when (gnus-group-auto-expirable-p group)
1861         (gnus-add-marked-articles
1862          group 'expire (gnus-list-of-unread-articles group))
1863         (when all
1864           (let ((marks (nth 3 (nth 2 entry))))
1865             (gnus-add-marked-articles
1866              group 'expire (gnus-uncompress-range (cdr (assq 'tick marks))))
1867             (gnus-add-marked-articles
1868              group 'expire (gnus-uncompress-range (cdr (assq 'tick marks)))))))
1869       (when entry
1870         (gnus-update-read-articles group nil)
1871         ;; Also nix out the lists of marks and dormants.
1872         (when all
1873           (gnus-add-marked-articles group 'tick nil nil 'force)
1874           (gnus-add-marked-articles group 'dormant nil nil 'force))
1875         (run-hooks 'gnus-group-catchup-group-hook)
1876         num))))
1877
1878 (defun gnus-group-expire-articles (&optional n)
1879   "Expire all expirable articles in the current newsgroup."
1880   (interactive "P")
1881   (let ((groups (gnus-group-process-prefix n))
1882         group)
1883     (unless groups
1884       (error "No groups to expire"))
1885     (while (setq group (pop groups))
1886       (gnus-group-remove-mark group)
1887       (when (gnus-check-backend-function 'request-expire-articles group)
1888         (gnus-message 6 "Expiring articles in %s..." group)
1889         (let* ((info (gnus-get-info group))
1890                (expirable (if (gnus-group-total-expirable-p group)
1891                               (cons nil (gnus-list-of-read-articles group))
1892                             (assq 'expire (gnus-info-marks info))))
1893                (expiry-wait (gnus-group-find-parameter group 'expiry-wait)))
1894           (when expirable
1895             (setcdr
1896              expirable
1897              (gnus-compress-sequence
1898               (if expiry-wait
1899                   ;; We set the expiry variables to the groupp
1900                   ;; parameter.
1901                   (let ((nnmail-expiry-wait-function nil)
1902                         (nnmail-expiry-wait expiry-wait))
1903                     (gnus-request-expire-articles
1904                      (gnus-uncompress-sequence (cdr expirable)) group))
1905                 ;; Just expire using the normal expiry values.
1906                 (gnus-request-expire-articles
1907                  (gnus-uncompress-sequence (cdr expirable)) group))))
1908             (gnus-close-group group))
1909           (gnus-message 6 "Expiring articles in %s...done" group)))
1910       (gnus-group-position-point))))
1911
1912 (defun gnus-group-expire-all-groups ()
1913   "Expire all expirable articles in all newsgroups."
1914   (interactive)
1915   (save-excursion
1916     (gnus-message 5 "Expiring...")
1917     (let ((gnus-group-marked (mapcar (lambda (info) (gnus-info-group info))
1918                                      (cdr gnus-newsrc-alist))))
1919       (gnus-group-expire-articles nil)))
1920   (gnus-group-position-point)
1921   (gnus-message 5 "Expiring...done"))
1922
1923 (defun gnus-group-set-current-level (n level)
1924   "Set the level of the next N groups to LEVEL."
1925   (interactive
1926    (list
1927     current-prefix-arg
1928     (string-to-int
1929      (let ((s (read-string
1930                (format "Level (default %s): "
1931                        (or (gnus-group-group-level)
1932                            gnus-level-default-subscribed)))))
1933        (if (string-match "^\\s-*$" s)
1934            (int-to-string (or (gnus-group-group-level)
1935                               gnus-level-default-subscribed))
1936          s)))))
1937   (or (and (>= level 1) (<= level gnus-level-killed))
1938       (error "Illegal level: %d" level))
1939   (let ((groups (gnus-group-process-prefix n))
1940         group)
1941     (while (setq group (pop groups))
1942       (gnus-group-remove-mark group)
1943       (gnus-message 6 "Changed level of %s from %d to %d"
1944                     group (or (gnus-group-group-level) gnus-level-killed)
1945                     level)
1946       (gnus-group-change-level
1947        group level (or (gnus-group-group-level) gnus-level-killed))
1948       (gnus-group-update-group-line)))
1949   (gnus-group-position-point))
1950
1951 (defun gnus-group-unsubscribe-current-group (&optional n)
1952   "Toggle subscription of the current group.
1953 If given numerical prefix, toggle the N next groups."
1954   (interactive "P")
1955   (let ((groups (gnus-group-process-prefix n))
1956         group)
1957     (while groups
1958       (setq group (car groups)
1959             groups (cdr groups))
1960       (gnus-group-remove-mark group)
1961       (gnus-group-unsubscribe-group
1962        group (if (<= (gnus-group-group-level) gnus-level-subscribed)
1963                  gnus-level-default-unsubscribed
1964                gnus-level-default-subscribed) t)
1965       (gnus-group-update-group-line))
1966     (gnus-group-next-group 1)))
1967
1968 (defun gnus-group-unsubscribe-group (group &optional level silent)
1969   "Toggle subscription to GROUP.
1970 Killed newsgroups are subscribed.  If SILENT, don't try to update the
1971 group line."
1972   (interactive
1973    (list (completing-read
1974           "Group: " gnus-active-hashtb nil
1975           (gnus-read-active-file-p)
1976           nil
1977           'gnus-group-history)))
1978   (let ((newsrc (gnus-gethash group gnus-newsrc-hashtb)))
1979     (cond
1980      ((string-match "^[ \t]$" group)
1981       (error "Empty group name"))
1982      (newsrc
1983       ;; Toggle subscription flag.
1984       (gnus-group-change-level
1985        newsrc (if level level (if (<= (nth 1 (nth 2 newsrc))
1986                                       gnus-level-subscribed)
1987                                   (1+ gnus-level-subscribed)
1988                                 gnus-level-default-subscribed)))
1989       (unless silent
1990         (gnus-group-update-group group)))
1991      ((and (stringp group)
1992            (or (not (gnus-read-active-file-p))
1993                (gnus-active group)))
1994       ;; Add new newsgroup.
1995       (gnus-group-change-level
1996        group
1997        (if level level gnus-level-default-subscribed)
1998        (or (and (member group gnus-zombie-list)
1999                 gnus-level-zombie)
2000            gnus-level-killed)
2001        (and (gnus-group-group-name)
2002             (gnus-gethash (gnus-group-group-name) gnus-newsrc-hashtb)))
2003       (unless silent
2004         (gnus-group-update-group group)))
2005      (t (error "No such newsgroup: %s" group)))
2006     (gnus-group-position-point)))
2007
2008 (defun gnus-group-transpose-groups (n)
2009   "Move the current newsgroup up N places.
2010 If given a negative prefix, move down instead.  The difference between
2011 N and the number of steps taken is returned."
2012   (interactive "p")
2013   (or (gnus-group-group-name)
2014       (error "No group on current line"))
2015   (gnus-group-kill-group 1)
2016   (prog1
2017       (forward-line (- n))
2018     (gnus-group-yank-group)
2019     (gnus-group-position-point)))
2020
2021 (defun gnus-group-kill-all-zombies ()
2022   "Kill all zombie newsgroups."
2023   (interactive)
2024   (setq gnus-killed-list (nconc gnus-zombie-list gnus-killed-list))
2025   (setq gnus-zombie-list nil)
2026   (gnus-group-list-groups))
2027
2028 (defun gnus-group-kill-region (begin end)
2029   "Kill newsgroups in current region (excluding current point).
2030 The killed newsgroups can be yanked by using \\[gnus-group-yank-group]."
2031   (interactive "r")
2032   (let ((lines
2033          ;; Count lines.
2034          (save-excursion
2035            (count-lines
2036             (progn
2037               (goto-char begin)
2038               (beginning-of-line)
2039               (point))
2040             (progn
2041               (goto-char end)
2042               (beginning-of-line)
2043               (point))))))
2044     (goto-char begin)
2045     (beginning-of-line)                 ;Important when LINES < 1
2046     (gnus-group-kill-group lines)))
2047
2048 (defun gnus-group-kill-group (&optional n discard)
2049   "Kill the next N groups.
2050 The killed newsgroups can be yanked by using \\[gnus-group-yank-group].
2051 However, only groups that were alive can be yanked; already killed
2052 groups or zombie groups can't be yanked.
2053 The return value is the name of the group that was killed, or a list
2054 of groups killed."
2055   (interactive "P")
2056   (let ((buffer-read-only nil)
2057         (groups (gnus-group-process-prefix n))
2058         group entry level out)
2059     (if (< (length groups) 10)
2060         ;; This is faster when there are few groups.
2061         (while groups
2062           (push (setq group (pop groups)) out)
2063           (gnus-group-remove-mark group)
2064           (setq level (gnus-group-group-level))
2065           (gnus-delete-line)
2066           (when (and (not discard)
2067                      (setq entry (gnus-gethash group gnus-newsrc-hashtb)))
2068             (gnus-undo-register
2069               `(progn
2070                 (gnus-group-goto-group ,(gnus-group-group-name))
2071                 (gnus-group-yank-group)))
2072             (push (cons (car entry) (nth 2 entry))
2073                   gnus-list-of-killed-groups))
2074           (gnus-group-change-level
2075            (if entry entry group) gnus-level-killed (if entry nil level)))
2076       ;; If there are lots and lots of groups to be killed, we use
2077       ;; this thing instead.
2078       (let (entry)
2079         (setq groups (nreverse groups))
2080         (while groups
2081           (gnus-group-remove-mark (setq group (pop groups)))
2082           (gnus-delete-line)
2083           (push group gnus-killed-list)
2084           (setq gnus-newsrc-alist
2085                 (delq (assoc group gnus-newsrc-alist)
2086                       gnus-newsrc-alist))
2087           (when gnus-group-change-level-function
2088             (funcall gnus-group-change-level-function group 9 3))
2089           (cond
2090            ((setq entry (gnus-gethash group gnus-newsrc-hashtb))
2091             (push (cons (car entry) (nth 2 entry))
2092                   gnus-list-of-killed-groups)
2093             (setcdr (cdr entry) (cdddr entry)))
2094            ((member group gnus-zombie-list)
2095             (setq gnus-zombie-list (delete group gnus-zombie-list)))))
2096         (gnus-make-hashtable-from-newsrc-alist)))
2097
2098     (gnus-group-position-point)
2099     (if (< (length out) 2) (car out) (nreverse out))))
2100
2101 (defun gnus-group-yank-group (&optional arg)
2102   "Yank the last newsgroups killed with \\[gnus-group-kill-group],
2103 inserting it before the current newsgroup.  The numeric ARG specifies
2104 how many newsgroups are to be yanked.  The name of the newsgroup yanked
2105 is returned, or (if several groups are yanked) a list of yanked groups
2106 is returned."
2107   (interactive "p")
2108   (setq arg (or arg 1))
2109   (let (info group prev out)
2110     (while (>= (decf arg) 0)
2111       (if (not (setq info (pop gnus-list-of-killed-groups)))
2112           (error "No more newsgroups to yank"))
2113       (push (setq group (nth 1 info)) out)
2114       ;; Find which newsgroup to insert this one before - search
2115       ;; backward until something suitable is found.  If there are no
2116       ;; other newsgroups in this buffer, just make this newsgroup the
2117       ;; first newsgroup.
2118       (setq prev (gnus-group-group-name))
2119       (gnus-group-change-level
2120        info (gnus-info-level (cdr info)) gnus-level-killed
2121        (and prev (gnus-gethash prev gnus-newsrc-hashtb))
2122        t)
2123       (gnus-group-insert-group-line-info group)
2124       (gnus-undo-register
2125         `(when (gnus-group-goto-group ,group)
2126           (gnus-group-kill-group 1))))
2127     (forward-line -1)
2128     (gnus-group-position-point)
2129     (if (< (length out) 2) (car out) (nreverse out))))
2130
2131 (defun gnus-group-kill-level (level)
2132   "Kill all groups that is on a certain LEVEL."
2133   (interactive "nKill all groups on level: ")
2134   (cond
2135    ((= level gnus-level-zombie)
2136     (setq gnus-killed-list
2137           (nconc gnus-zombie-list gnus-killed-list))
2138     (setq gnus-zombie-list nil))
2139    ((and (< level gnus-level-zombie)
2140          (> level 0)
2141          (or gnus-expert-user
2142              (gnus-yes-or-no-p
2143               (format
2144                "Do you really want to kill all groups on level %d? "
2145                level))))
2146     (let* ((prev gnus-newsrc-alist)
2147            (alist (cdr prev)))
2148       (while alist
2149         (if (= (gnus-info-level (car alist)) level)
2150             (progn
2151               (push (gnus-info-group (car alist)) gnus-killed-list)
2152               (setcdr prev (cdr alist)))
2153           (setq prev alist))
2154         (setq alist (cdr alist)))
2155       (gnus-make-hashtable-from-newsrc-alist)
2156       (gnus-group-list-groups)))
2157    (t
2158     (error "Can't kill; illegal level: %d" level))))
2159
2160 (defun gnus-group-list-all-groups (&optional arg)
2161   "List all newsgroups with level ARG or lower.
2162 Default is gnus-level-unsubscribed, which lists all subscribed and most
2163 unsubscribed groups."
2164   (interactive "P")
2165   (gnus-group-list-groups (or arg gnus-level-unsubscribed) t))
2166
2167 ;; Redefine this to list ALL killed groups if prefix arg used.
2168 ;; Rewritten by engstrom@src.honeywell.com (Eric Engstrom).
2169 (defun gnus-group-list-killed (&optional arg)
2170   "List all killed newsgroups in the group buffer.
2171 If ARG is non-nil, list ALL killed groups known to Gnus.  This may
2172 entail asking the server for the groups."
2173   (interactive "P")
2174   ;; Find all possible killed newsgroups if arg.
2175   (when arg
2176     (gnus-get-killed-groups))
2177   (if (not gnus-killed-list)
2178       (gnus-message 6 "No killed groups")
2179     (let (gnus-group-list-mode)
2180       (funcall gnus-group-prepare-function
2181                gnus-level-killed t gnus-level-killed))
2182     (goto-char (point-min)))
2183   (gnus-group-position-point))
2184
2185 (defun gnus-group-list-zombies ()
2186   "List all zombie newsgroups in the group buffer."
2187   (interactive)
2188   (if (not gnus-zombie-list)
2189       (gnus-message 6 "No zombie groups")
2190     (let (gnus-group-list-mode)
2191       (funcall gnus-group-prepare-function
2192                gnus-level-zombie t gnus-level-zombie))
2193     (goto-char (point-min)))
2194   (gnus-group-position-point))
2195
2196 (defun gnus-group-list-active ()
2197   "List all groups that are available from the server(s)."
2198   (interactive)
2199   ;; First we make sure that we have really read the active file.
2200   (unless (gnus-read-active-file-p)
2201     (let ((gnus-read-active-file t))
2202       (gnus-read-active-file)))
2203   ;; Find all groups and sort them.
2204   (let ((groups
2205          (sort
2206           (let (list)
2207             (mapatoms
2208              (lambda (sym)
2209                (and (boundp sym)
2210                     (symbol-value sym)
2211                     (setq list (cons (symbol-name sym) list))))
2212              gnus-active-hashtb)
2213             list)
2214           'string<))
2215         (buffer-read-only nil))
2216     (erase-buffer)
2217     (while groups
2218       (gnus-group-insert-group-line-info (pop groups)))
2219     (goto-char (point-min))))
2220
2221 (defun gnus-activate-all-groups (level)
2222   "Activate absolutely all groups."
2223   (interactive (list 7))
2224   (let ((gnus-activate-level level)
2225         (gnus-activate-foreign-newsgroups level))
2226     (gnus-group-get-new-news)))
2227
2228 (defun gnus-group-get-new-news (&optional arg)
2229   "Get newly arrived articles.
2230 If ARG is a number, it specifies which levels you are interested in
2231 re-scanning.  If ARG is non-nil and not a number, this will force
2232 \"hard\" re-reading of the active files from all servers."
2233   (interactive "P")
2234   (save-excursion
2235     (set-buffer gnus-group-buffer)
2236     (run-hooks 'gnus-get-new-news-hook)
2237     ;; We might read in new NoCeM messages here.
2238     (when (and gnus-use-nocem
2239                (null arg))
2240       (gnus-nocem-scan-groups))
2241     ;; If ARG is not a number, then we read the active file.
2242     (when (and arg (not (numberp arg)))
2243       (let ((gnus-read-active-file t))
2244         (gnus-read-active-file))
2245       (setq arg nil))
2246
2247     (setq arg (gnus-group-default-level arg t))
2248     (if (and gnus-read-active-file (not arg))
2249         (progn
2250           (gnus-read-active-file)
2251           (gnus-get-unread-articles arg))
2252       (let ((gnus-read-active-file (if arg nil gnus-read-active-file)))
2253         (gnus-get-unread-articles arg)))
2254     (run-hooks 'gnus-after-getting-new-news-hook)
2255     (gnus-group-list-groups)))
2256
2257 (defun gnus-group-get-new-news-this-group (&optional n)
2258   "Check for newly arrived news in the current group (and the N-1 next groups).
2259 The difference between N and the number of newsgroup checked is returned.
2260 If N is negative, this group and the N-1 previous groups will be checked."
2261   (interactive "P")
2262   (let* ((groups (gnus-group-process-prefix n))
2263          (ret (if (numberp n) (- n (length groups)) 0))
2264          (beg (unless n (point)))
2265          group)
2266     (while (setq group (pop groups))
2267       (gnus-group-remove-mark group)
2268       (if (gnus-activate-group group 'scan)
2269           (progn
2270             (gnus-get-unread-articles-in-group
2271              (gnus-get-info group) (gnus-active group) t)
2272             (unless (gnus-virtual-group-p group)
2273               (gnus-close-group group))
2274             (gnus-group-update-group group))
2275         (if (eq (gnus-server-status (gnus-find-method-for-group group))
2276                 'denied)
2277             (gnus-error "Server denied access")
2278           (gnus-error 3 "%s error: %s" group (gnus-status-message group)))))
2279     (when beg (goto-char beg))
2280     (when gnus-goto-next-group-when-activating
2281       (gnus-group-next-unread-group 1 t))
2282     (gnus-summary-position-point)
2283     ret))
2284
2285 (defun gnus-group-fetch-faq (group &optional faq-dir)
2286   "Fetch the FAQ for the current group."
2287   (interactive
2288    (list
2289     (and (gnus-group-group-name)
2290          (gnus-group-real-name (gnus-group-group-name)))
2291     (cond (current-prefix-arg
2292            (completing-read
2293             "Faq dir: " (and (listp gnus-group-faq-directory)
2294                              (mapcar (lambda (file) (list file))
2295                                      gnus-group-faq-directory)))))))
2296   (or faq-dir
2297       (setq faq-dir (if (listp gnus-group-faq-directory)
2298                         (car gnus-group-faq-directory)
2299                       gnus-group-faq-directory)))
2300   (or group (error "No group name given"))
2301   (let ((file (concat (file-name-as-directory faq-dir)
2302                       (gnus-group-real-name group))))
2303     (if (not (file-exists-p file))
2304         (error "No such file: %s" file)
2305       (find-file file))))
2306
2307 (defun gnus-group-describe-group (force &optional group)
2308   "Display a description of the current newsgroup."
2309   (interactive (list current-prefix-arg (gnus-group-group-name)))
2310   (let* ((method (gnus-find-method-for-group group))
2311          (mname (gnus-group-prefixed-name "" method))
2312          desc)
2313     (when (and force
2314                gnus-description-hashtb)
2315       (gnus-sethash mname nil gnus-description-hashtb))
2316     (or group (error "No group name given"))
2317     (and (or (and gnus-description-hashtb
2318                   ;; We check whether this group's method has been
2319                   ;; queried for a description file.
2320                   (gnus-gethash mname gnus-description-hashtb))
2321              (setq desc (gnus-group-get-description group))
2322              (gnus-read-descriptions-file method))
2323          (gnus-message 1
2324           (or desc (gnus-gethash group gnus-description-hashtb)
2325               "No description available")))))
2326
2327 ;; Suggested by Per Abrahamsen <amanda@iesd.auc.dk>.
2328 (defun gnus-group-describe-all-groups (&optional force)
2329   "Pop up a buffer with descriptions of all newsgroups."
2330   (interactive "P")
2331   (and force (setq gnus-description-hashtb nil))
2332   (if (not (or gnus-description-hashtb
2333                (gnus-read-all-descriptions-files)))
2334       (error "Couldn't request descriptions file"))
2335   (let ((buffer-read-only nil)
2336         b)
2337     (erase-buffer)
2338     (mapatoms
2339      (lambda (group)
2340        (setq b (point))
2341        (insert (format "      *: %-20s %s\n" (symbol-name group)
2342                        (symbol-value group)))
2343        (gnus-add-text-properties
2344         b (1+ b) (list 'gnus-group group
2345                        'gnus-unread t 'gnus-marked nil
2346                        'gnus-level (1+ gnus-level-subscribed))))
2347      gnus-description-hashtb)
2348     (goto-char (point-min))
2349     (gnus-group-position-point)))
2350
2351 ;; Suggested by Daniel Quinlan <quinlan@best.com>.
2352 (defun gnus-group-apropos (regexp &optional search-description)
2353   "List all newsgroups that have names that match a regexp."
2354   (interactive "sGnus apropos (regexp): ")
2355   (let ((prev "")
2356         (obuf (current-buffer))
2357         groups des)
2358     ;; Go through all newsgroups that are known to Gnus.
2359     (mapatoms
2360      (lambda (group)
2361        (and (symbol-name group)
2362             (string-match regexp (symbol-name group))
2363             (setq groups (cons (symbol-name group) groups))))
2364      gnus-active-hashtb)
2365     ;; Also go through all descriptions that are known to Gnus.
2366     (when search-description
2367       (mapatoms
2368        (lambda (group)
2369          (and (string-match regexp (symbol-value group))
2370               (gnus-active (symbol-name group))
2371               (setq groups (cons (symbol-name group) groups))))
2372        gnus-description-hashtb))
2373     (if (not groups)
2374         (gnus-message 3 "No groups matched \"%s\"." regexp)
2375       ;; Print out all the groups.
2376       (save-excursion
2377         (pop-to-buffer "*Gnus Help*")
2378         (buffer-disable-undo (current-buffer))
2379         (erase-buffer)
2380         (setq groups (sort groups 'string<))
2381         (while groups
2382           ;; Groups may be entered twice into the list of groups.
2383           (if (not (string= (car groups) prev))
2384               (progn
2385                 (insert (setq prev (car groups)) "\n")
2386                 (if (and gnus-description-hashtb
2387                          (setq des (gnus-gethash (car groups)
2388                                                  gnus-description-hashtb)))
2389                     (insert "  " des "\n"))))
2390           (setq groups (cdr groups)))
2391         (goto-char (point-min))))
2392     (pop-to-buffer obuf)))
2393
2394 (defun gnus-group-description-apropos (regexp)
2395   "List all newsgroups that have names or descriptions that match a regexp."
2396   (interactive "sGnus description apropos (regexp): ")
2397   (if (not (or gnus-description-hashtb
2398                (gnus-read-all-descriptions-files)))
2399       (error "Couldn't request descriptions file"))
2400   (gnus-group-apropos regexp t))
2401
2402 ;; Suggested by Per Abrahamsen <amanda@iesd.auc.dk>.
2403 (defun gnus-group-list-matching (level regexp &optional all lowest)
2404   "List all groups with unread articles that match REGEXP.
2405 If the prefix LEVEL is non-nil, it should be a number that says which
2406 level to cut off listing groups.
2407 If ALL, also list groups with no unread articles.
2408 If LOWEST, don't list groups with level lower than LOWEST.
2409
2410 This command may read the active file."
2411   (interactive "P\nsList newsgroups matching: ")
2412   ;; First make sure active file has been read.
2413   (when (and level
2414              (> (prefix-numeric-value level) gnus-level-killed))
2415     (gnus-get-killed-groups))
2416   (gnus-group-prepare-flat (or level gnus-level-subscribed)
2417                            all (or lowest 1) regexp)
2418   (goto-char (point-min))
2419   (gnus-group-position-point))
2420
2421 (defun gnus-group-list-all-matching (level regexp &optional lowest)
2422   "List all groups that match REGEXP.
2423 If the prefix LEVEL is non-nil, it should be a number that says which
2424 level to cut off listing groups.
2425 If LOWEST, don't list groups with level lower than LOWEST."
2426   (interactive "P\nsList newsgroups matching: ")
2427   (gnus-group-list-matching (or level gnus-level-killed) regexp t lowest))
2428
2429 ;; Suggested by Jack Vinson <vinson@unagi.cis.upenn.edu>.
2430 (defun gnus-group-save-newsrc (&optional force)
2431   "Save the Gnus startup files.
2432 If FORCE, force saving whether it is necessary or not."
2433   (interactive "P")
2434   (gnus-save-newsrc-file force))
2435
2436 (defun gnus-group-restart (&optional arg)
2437   "Force Gnus to read the .newsrc file."
2438   (interactive "P")
2439   (when (gnus-yes-or-no-p
2440          (format "Are you sure you want to read %s? "
2441                  gnus-current-startup-file))
2442     (gnus-save-newsrc-file)
2443     (gnus-setup-news 'force)
2444     (gnus-group-list-groups arg)))
2445
2446 (defun gnus-group-read-init-file ()
2447   "Read the Gnus elisp init file."
2448   (interactive)
2449   (gnus-read-init-file))
2450
2451 (defun gnus-group-check-bogus-groups (&optional silent)
2452   "Check bogus newsgroups.
2453 If given a prefix, don't ask for confirmation before removing a bogus
2454 group."
2455   (interactive "P")
2456   (gnus-check-bogus-newsgroups (and (not silent) (not gnus-expert-user)))
2457   (gnus-group-list-groups))
2458
2459 (defun gnus-group-edit-global-kill (&optional article group)
2460   "Edit the global kill file.
2461 If GROUP, edit that local kill file instead."
2462   (interactive "P")
2463   (setq gnus-current-kill-article article)
2464   (gnus-kill-file-edit-file group)
2465   (gnus-message
2466    6
2467    (substitute-command-keys
2468     (format "Editing a %s kill file (Type \\[gnus-kill-file-exit] to exit)"
2469             (if group "local" "global")))))
2470
2471 (defun gnus-group-edit-local-kill (article group)
2472   "Edit a local kill file."
2473   (interactive (list nil (gnus-group-group-name)))
2474   (gnus-group-edit-global-kill article group))
2475
2476 (defun gnus-group-force-update ()
2477   "Update `.newsrc' file."
2478   (interactive)
2479   (gnus-save-newsrc-file))
2480
2481 (defun gnus-group-suspend ()
2482   "Suspend the current Gnus session.
2483 In fact, cleanup buffers except for group mode buffer.
2484 The hook gnus-suspend-gnus-hook is called before actually suspending."
2485   (interactive)
2486   (run-hooks 'gnus-suspend-gnus-hook)
2487   ;; Kill Gnus buffers except for group mode buffer.
2488   (let* ((group-buf (get-buffer gnus-group-buffer))
2489          ;; Do this on a separate list in case the user does a ^G before we finish
2490          (gnus-buffer-list
2491           (delete group-buf (delete gnus-dribble-buffer
2492                                     (append gnus-buffer-list nil)))))
2493     (while gnus-buffer-list
2494       (gnus-kill-buffer (pop gnus-buffer-list)))
2495     (gnus-kill-gnus-frames)
2496     (when group-buf
2497       (setq gnus-buffer-list (list group-buf))
2498       (bury-buffer group-buf)
2499       (delete-windows-on group-buf t))))
2500
2501 (defun gnus-group-clear-dribble ()
2502   "Clear all information from the dribble buffer."
2503   (interactive)
2504   (gnus-dribble-clear)
2505   (gnus-message 7 "Cleared dribble buffer"))
2506
2507 (defun gnus-group-exit ()
2508   "Quit reading news after updating .newsrc.eld and .newsrc.
2509 The hook `gnus-exit-gnus-hook' is called before actually exiting."
2510   (interactive)
2511   (when
2512       (or noninteractive                ;For gnus-batch-kill
2513           (not gnus-interactive-exit)   ;Without confirmation
2514           gnus-expert-user
2515           (gnus-y-or-n-p "Are you sure you want to quit reading news? "))
2516     (run-hooks 'gnus-exit-gnus-hook)
2517     ;; Offer to save data from non-quitted summary buffers.
2518     (gnus-offer-save-summaries)
2519     ;; Save the newsrc file(s).
2520     (gnus-save-newsrc-file)
2521     ;; Kill-em-all.
2522     (gnus-close-backends)
2523     ;; Reset everything.
2524     (gnus-clear-system)
2525     ;; Allow the user to do things after cleaning up.
2526     (run-hooks 'gnus-after-exiting-gnus-hook)))
2527
2528 (defun gnus-group-quit ()
2529   "Quit reading news without updating .newsrc.eld or .newsrc.
2530 The hook `gnus-exit-gnus-hook' is called before actually exiting."
2531   (interactive)
2532   (when (or noninteractive              ;For gnus-batch-kill
2533             (zerop (buffer-size))
2534             (not (gnus-server-opened gnus-select-method))
2535             gnus-expert-user
2536             (not gnus-current-startup-file)
2537             (gnus-yes-or-no-p
2538              (format "Quit reading news without saving %s? "
2539                      (file-name-nondirectory gnus-current-startup-file))))
2540     (run-hooks 'gnus-exit-gnus-hook)
2541     (gnus-configure-windows 'group t)
2542     (gnus-dribble-save)
2543     (gnus-close-backends)
2544     (gnus-clear-system)
2545     (gnus-kill-buffer gnus-group-buffer)
2546     ;; Allow the user to do things after cleaning up.
2547     (run-hooks 'gnus-after-exiting-gnus-hook)))
2548
2549 (defun gnus-group-describe-briefly ()
2550   "Give a one line description of the group mode commands."
2551   (interactive)
2552   (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")))
2553
2554 (defun gnus-group-browse-foreign-server (method)
2555   "Browse a foreign news server.
2556 If called interactively, this function will ask for a select method
2557  (nntp, nnspool, etc.) and a server address (eg. nntp.some.where).
2558 If not, METHOD should be a list where the first element is the method
2559 and the second element is the address."
2560   (interactive
2561    (list (let ((how (completing-read
2562                      "Which backend: "
2563                      (append gnus-valid-select-methods gnus-server-alist)
2564                      nil t (cons "nntp" 0) 'gnus-method-history)))
2565            ;; We either got a backend name or a virtual server name.
2566            ;; If the first, we also need an address.
2567            (if (assoc how gnus-valid-select-methods)
2568                (list (intern how)
2569                      ;; Suggested by mapjph@bath.ac.uk.
2570                      (completing-read
2571                       "Address: "
2572                       (mapcar (lambda (server) (list server))
2573                               gnus-secondary-servers)))
2574              ;; We got a server name, so we find the method.
2575              (gnus-server-to-method how)))))
2576   (gnus-browse-foreign-server method))
2577
2578 (defun gnus-group-set-info (info &optional method-only-group part)
2579   (let* ((entry (gnus-gethash
2580                  (or method-only-group (gnus-info-group info))
2581                  gnus-newsrc-hashtb))
2582          (part-info info)
2583          (info (if method-only-group (nth 2 entry) info))
2584          method)
2585     (when method-only-group
2586       (unless entry
2587         (error "Trying to change non-existent group %s" method-only-group))
2588       ;; We have received parts of the actual group info - either the
2589       ;; select method or the group parameters.  We first check
2590       ;; whether we have to extend the info, and if so, do that.
2591       (let ((len (length info))
2592             (total (if (eq part 'method) 5 6)))
2593         (when (< len total)
2594           (setcdr (nthcdr (1- len) info)
2595                   (make-list (- total len) nil)))
2596         ;; Then we enter the new info.
2597         (setcar (nthcdr (1- total) info) part-info)))
2598     (unless entry
2599       ;; This is a new group, so we just create it.
2600       (save-excursion
2601         (set-buffer gnus-group-buffer)
2602         (setq method (gnus-info-method info))
2603         (when (gnus-server-equal method "native")
2604           (setq method nil))
2605         (save-excursion
2606           (set-buffer gnus-group-buffer)
2607           (if method
2608               ;; It's a foreign group...
2609               (gnus-group-make-group
2610                (gnus-group-real-name (gnus-info-group info))
2611                (if (stringp method) method
2612                  (prin1-to-string (car method)))
2613                (and (consp method)
2614                     (nth 1 (gnus-info-method info))))
2615             ;; It's a native group.
2616             (gnus-group-make-group (gnus-info-group info))))
2617         (gnus-message 6 "Note: New group created")
2618         (setq entry
2619               (gnus-gethash (gnus-group-prefixed-name
2620                              (gnus-group-real-name (gnus-info-group info))
2621                              (or (gnus-info-method info) gnus-select-method))
2622                             gnus-newsrc-hashtb))))
2623     ;; Whether it was a new group or not, we now have the entry, so we
2624     ;; can do the update.
2625     (if entry
2626         (progn
2627           (setcar (nthcdr 2 entry) info)
2628           (when (and (not (eq (car entry) t))
2629                      (gnus-active (gnus-info-group info)))
2630             (setcar entry (length (gnus-list-of-unread-articles (car info))))))
2631       (error "No such group: %s" (gnus-info-group info)))))
2632
2633 (defun gnus-group-set-method-info (group select-method)
2634   (gnus-group-set-info select-method group 'method))
2635
2636 (defun gnus-group-set-params-info (group params)
2637   (gnus-group-set-info params group 'params))
2638
2639 (defun gnus-add-marked-articles (group type articles &optional info force)
2640   ;; Add ARTICLES of TYPE to the info of GROUP.
2641   ;; If INFO is non-nil, use that info.  If FORCE is non-nil, don't
2642   ;; add, but replace marked articles of TYPE with ARTICLES.
2643   (let ((info (or info (gnus-get-info group)))
2644         (uncompressed '(score bookmark killed))
2645         marked m)
2646     (or (not info)
2647         (and (not (setq marked (nthcdr 3 info)))
2648              (or (null articles)
2649                  (setcdr (nthcdr 2 info)
2650                          (list (list (cons type (gnus-compress-sequence
2651                                                  articles t)))))))
2652         (and (not (setq m (assq type (car marked))))
2653              (or (null articles)
2654                  (setcar marked
2655                          (cons (cons type (gnus-compress-sequence articles t) )
2656                                (car marked)))))
2657         (if force
2658             (if (null articles)
2659                 (setcar (nthcdr 3 info)
2660                         (delq (assq type (car marked)) (car marked)))
2661               (setcdr m (gnus-compress-sequence articles t)))
2662           (setcdr m (gnus-compress-sequence
2663                      (sort (nconc (gnus-uncompress-range (cdr m))
2664                                   (copy-sequence articles)) '<) t))))))
2665
2666 (defun gnus-update-read-articles (group unread)
2667   "Update the list of read articles in GROUP."
2668   (let* ((active (or gnus-newsgroup-active (gnus-active group)))
2669          (entry (gnus-gethash group gnus-newsrc-hashtb))
2670          (info (nth 2 entry))
2671          (prev 1)
2672          (unread (sort (copy-sequence unread) '<))
2673          read)
2674     (if (or (not info) (not active))
2675         ;; There is no info on this group if it was, in fact,
2676         ;; killed.  Gnus stores no information on killed groups, so
2677         ;; there's nothing to be done.
2678         ;; One could store the information somewhere temporarily,
2679         ;; perhaps...  Hmmm...
2680         ()
2681       ;; Remove any negative articles numbers.
2682       (while (and unread (< (car unread) 0))
2683         (setq unread (cdr unread)))
2684       ;; Remove any expired article numbers
2685       (while (and unread (< (car unread) (car active)))
2686         (setq unread (cdr unread)))
2687       ;; Compute the ranges of read articles by looking at the list of
2688       ;; unread articles.
2689       (while unread
2690         (if (/= (car unread) prev)
2691             (setq read (cons (if (= prev (1- (car unread))) prev
2692                                (cons prev (1- (car unread)))) read)))
2693         (setq prev (1+ (car unread)))
2694         (setq unread (cdr unread)))
2695       (when (<= prev (cdr active))
2696         (setq read (cons (cons prev (cdr active)) read)))
2697       (gnus-undo-register
2698         `(progn
2699            (gnus-info-set-marks ,info ,(gnus-info-marks info))
2700            (gnus-info-set-read ,info ,(gnus-info-read info))
2701            (gnus-get-unread-articles-in-group ,info (gnus-active ,group))))
2702       ;; Enter this list into the group info.
2703       (gnus-info-set-read
2704        info (if (> (length read) 1) (nreverse read) read))
2705       ;; Set the number of unread articles in gnus-newsrc-hashtb.
2706       (gnus-get-unread-articles-in-group info (gnus-active group))
2707       t)))
2708
2709 (provide 'gnus-group)
2710
2711 ;;; gnus-group.el ends here