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

   1 ;;; gnus-group.el --- group mode commands for Gnus
   2 ;; Copyright (C) 1996, 1997, 1998, 1999, 2000
   3 ;;        Free Software Foundation, Inc.
   4
   5 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
   6 ;; Keywords: news
   7
   8 ;; This file is part of GNU Emacs.
   9
  10 ;; GNU Emacs is free software; you can redistribute it and/or modify
  11 ;; it under the terms of the GNU General Public License as published by
  12 ;; the Free Software Foundation; either version 2, or (at your option)
  13 ;; any later version.
  14
  15 ;; GNU Emacs is distributed in the hope that it will be useful,
  16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;; GNU General Public License for more details.
  19
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  23 ;; Boston, MA 02111-1307, USA.
  24
  25 ;;; Commentary:
  26
  27 ;;; Code:
  28
  29 (eval-when-compile (require 'cl))
  30
  31 (require 'gnus)
  32 (require 'gnus-start)
  33 (require 'nnmail)
  34 (require 'gnus-spec)
  35 (require 'gnus-int)
  36 (require 'gnus-range)
  37 (require 'gnus-win)
  38 (require 'gnus-undo)
  39 (require 'time-date)
  40
  41 (defcustom gnus-group-archive-directory
  42   "*ftp@ftp.hpc.uh.edu:/pub/emacs/ding-list/"
  43   "*The address of the (ding) archives."
  44   :group 'gnus-group-foreign
  45   :type 'directory)
  46
  47 (defcustom gnus-group-recent-archive-directory
  48   "*ftp@ftp.hpc.uh.edu:/pub/emacs/ding-list-recent/"
  49   "*The address of the most recent (ding) articles."
  50   :group 'gnus-group-foreign
  51   :type 'directory)
  52
  53 (defcustom gnus-no-groups-message "No gnus is bad news"
  54   "*Message displayed by Gnus when no groups are available."
  55   :group 'gnus-start
  56   :type 'string)
  57
  58 (defcustom gnus-keep-same-level nil
  59   "*Non-nil means that the next newsgroup after the current will be on the same level.
  60 When you type, for instance, `n' after reading the last article in the
  61 current newsgroup, you will go to the next newsgroup.  If this variable
  62 is nil, the next newsgroup will be the next from the group
  63 buffer.
  64 If this variable is non-nil, Gnus will either put you in the
  65 next newsgroup with the same level, or, if no such newsgroup is
  66 available, the next newsgroup with the lowest possible level higher
  67 than the current level.
  68 If this variable is `best', Gnus will make the next newsgroup the one
  69 with the best level."
  70   :group 'gnus-group-levels
  71   :type '(choice (const nil)
  72                  (const best)
  73                  (sexp :tag "other" t)))
  74
  75 (defcustom gnus-group-goto-unread t
  76   "*If non-nil, movement commands will go to the next unread and subscribed group."
  77   :link '(custom-manual "(gnus)Group Maneuvering")
  78   :group 'gnus-group-various
  79   :type 'boolean)
  80
  81 (defcustom gnus-goto-next-group-when-activating t
  82   "*If non-nil, the \\<gnus-group-mode-map>\\[gnus-group-get-new-news-this-group] command will advance point to the next group."
  83   :link '(custom-manual "(gnus)Scanning New Messages")
  84   :group 'gnus-group-various
  85   :type 'boolean)
  86
  87 (defcustom gnus-permanently-visible-groups nil
  88   "*Regexp to match groups that should always be listed in the group buffer.
  89 This means that they will still be listed even when there are no
  90 unread articles in the groups.
  91
  92 If nil, no groups are permanently visible."
  93   :group 'gnus-group-listing
  94   :type '(choice regexp (const nil)))
  95
  96 (defcustom gnus-list-groups-with-ticked-articles t
  97   "*If non-nil, list groups that have only ticked articles.
  98 If nil, only list groups that have unread articles."
  99   :group 'gnus-group-listing
 100   :type 'boolean)
 101
 102 (defcustom gnus-group-default-list-level gnus-level-subscribed
 103   "*Default listing level.
 104 Ignored if `gnus-group-use-permanent-levels' is non-nil."
 105   :group 'gnus-group-listing
 106   :type 'integer)
 107
 108 (defcustom gnus-group-list-inactive-groups t
 109   "*If non-nil, inactive groups will be listed."
 110   :group 'gnus-group-listing
 111   :group 'gnus-group-levels
 112   :type 'boolean)
 113
 114 (defcustom gnus-group-sort-function 'gnus-group-sort-by-alphabet
 115   "*Function used for sorting the group buffer.
 116 This function will be called with group info entries as the arguments
 117 for the groups to be sorted.  Pre-made functions include
 118 `gnus-group-sort-by-alphabet', `gnus-group-sort-by-real-name',
 119 `gnus-group-sort-by-unread', `gnus-group-sort-by-level',
 120 `gnus-group-sort-by-score', `gnus-group-sort-by-method', and
 121 `gnus-group-sort-by-rank'.
 122
 123 This variable can also be a list of sorting functions.  In that case,
 124 the most significant sort function should be the last function in the
 125 list."
 126   :group 'gnus-group-listing
 127   :link '(custom-manual "(gnus)Sorting Groups")
 128   :type '(radio (function-item gnus-group-sort-by-alphabet)
 129                 (function-item gnus-group-sort-by-real-name)
 130                 (function-item gnus-group-sort-by-unread)
 131                 (function-item gnus-group-sort-by-level)
 132                 (function-item gnus-group-sort-by-score)
 133                 (function-item gnus-group-sort-by-method)
 134                 (function-item gnus-group-sort-by-rank)
 135                 (function :tag "other" nil)))
 136
 137 (defcustom gnus-group-line-format "%M\%S\%p\%P\%5y: %(%g%)%l\n"
 138   "*Format of group lines.
 139 It works along the same lines as a normal formatting string,
 140 with some simple extensions.
 141
 142 %M    Only marked articles (character, \"*\" or \" \")
 143 %S    Whether the group is subscribed (character, \"U\", \"K\", \"Z\" or \" \")
 144 %L    Level of subscribedness (integer)
 145 %N    Number of unread articles (integer)
 146 %I    Number of dormant articles (integer)
 147 %i    Number of ticked and dormant (integer)
 148 %T    Number of ticked articles (integer)
 149 %R    Number of read articles (integer)
 150 %t    Estimated total number of articles (integer)
 151 %y    Number of unread, unticked articles (integer)
 152 %G    Group name (string)
 153 %g    Qualified group name (string)
 154 %D    Group description (string)
 155 %s    Select method (string)
 156 %o    Moderated group (char, \"m\")
 157 %p    Process mark (char)
 158 %O    Moderated group (string, \"(m)\" or \"\")
 159 %P    Topic indentation (string)
 160 %m    Whether there is new(ish) mail in the group (char, \"%\")
 161 %l    Whether there are GroupLens predictions for this group (string)
 162 %n    Select from where (string)
 163 %z    A string that look like `<%s:%n>' if a foreign select method is used
 164 %d    The date the group was last entered.
 165 %E    Icon as defined by `gnus-group-icon-list'.
 166 %u    User defined specifier.  The next character in the format string should
 167       be a letter.  Gnus will call the function gnus-user-format-function-X,
 168       where X is the letter following %u.  The function will be passed the
 169       current header as argument.  The function should return a string, which
 170       will be inserted into the buffer just like information from any other
 171       group specifier.
 172
 173 Text between %( and %) will be highlighted with `gnus-mouse-face' when
 174 the mouse point move inside the area.  There can only be one such area.
 175
 176 Note that this format specification is not always respected.  For
 177 reasons of efficiency, when listing killed groups, this specification
 178 is ignored altogether.  If the spec is changed considerably, your
 179 output may end up looking strange when listing both alive and killed
 180 groups.
 181
 182 If you use %o or %O, reading the active file will be slower and quite
 183 a bit of extra memory will be used.  %D will also worsen performance.
 184 Also note that if you change the format specification to include any
 185 of these specs, you must probably re-start Gnus to see them go into
 186 effect."
 187   :group 'gnus-group-visual
 188   :type 'string)
 189
 190 (defcustom gnus-group-mode-line-format "Gnus: %%b {%M\%:%S}"
 191   "*The format specification for the group mode line.
 192 It works along the same lines as a normal formatting string,
 193 with some simple extensions:
 194
 195 %S   The native news server.
 196 %M   The native select method.
 197 %:   \":\" if %S isn't \"\"."
 198   :group 'gnus-group-visual
 199   :type 'string)
 200
 201 (defcustom gnus-group-mode-hook nil
 202   "Hook for Gnus group mode."
 203   :group 'gnus-group-various
 204   :options '(gnus-topic-mode)
 205   :type 'hook)
 206
 207 (defcustom gnus-group-menu-hook nil
 208   "Hook run after the creation of the group mode menu."
 209   :group 'gnus-group-various
 210   :type 'hook)
 211
 212 (defcustom gnus-group-catchup-group-hook nil
 213   "Hook run when catching up a group from the group buffer."
 214   :group 'gnus-group-various
 215   :link '(custom-manual "(gnus)Group Data")
 216   :type 'hook)
 217
 218 (defcustom gnus-group-update-group-hook nil
 219   "Hook called when updating group lines."
 220   :group 'gnus-group-visual
 221   :type 'hook)
 222
 223 (defcustom gnus-group-prepare-function 'gnus-group-prepare-flat
 224   "*A function that is called to generate the group buffer.
 225 The function is called with three arguments: The first is a number;
 226 all group with a level less or equal to that number should be listed,
 227 if the second is non-nil, empty groups should also be displayed.  If
 228 the third is non-nil, it is a number.  No groups with a level lower
 229 than this number should be displayed.
 230
 231 The only current function implemented is `gnus-group-prepare-flat'."
 232   :group 'gnus-group-listing
 233   :type 'function)
 234
 235 (defcustom gnus-group-prepare-hook nil
 236   "Hook called after the group buffer has been generated.
 237 If you want to modify the group buffer, you can use this hook."
 238   :group 'gnus-group-listing
 239   :type 'hook)
 240
 241 (defcustom gnus-suspend-gnus-hook nil
 242   "Hook called when suspending (not exiting) Gnus."
 243   :group 'gnus-exit
 244   :type 'hook)
 245
 246 (defcustom gnus-exit-gnus-hook nil
 247   "Hook called when exiting Gnus."
 248   :group 'gnus-exit
 249   :type 'hook)
 250
 251 (defcustom gnus-after-exiting-gnus-hook nil
 252   "Hook called after exiting Gnus."
 253   :group 'gnus-exit
 254   :type 'hook)
 255
 256 (defcustom gnus-group-update-hook '(gnus-group-highlight-line)
 257   "Hook called when a group line is changed.
 258 The hook will not be called if `gnus-visual' is nil.
 259
 260 The default function `gnus-group-highlight-line' will
 261 highlight the line according to the `gnus-group-highlight'
 262 variable."
 263   :group 'gnus-group-visual
 264   :type 'hook)
 265
 266 (defcustom gnus-useful-groups
 267   '(("(ding) mailing list mirrored at sunsite.auc.dk"
 268      "emacs.ding"
 269      (nntp "sunsite.auc.dk"
 270            (nntp-address "sunsite.auc.dk")))
 271     ("gnus-bug archive"
 272      "gnus-bug"
 273      (nndir "/ftp@ftp.ifi.uio.no:/pub/emacs/gnus/gnus-bug/"))
 274     ("Gnus help group"
 275      "gnus-help"
 276      (nndoc "gnus-help"
 277             (nndoc-article-type mbox)
 278             (eval `(nndoc-address
 279                     ,(let ((file (nnheader-find-etc-directory
 280                                   "gnus-tut.txt" t)))
 281                        (unless file
 282                          (error "Couldn't find doc group"))
 283                        file))))))
 284   "*Alist of useful group-server pairs."
 285   :group 'gnus-group-listing
 286   :type '(repeat (list (string :tag "Description")
 287                        (string :tag "Name")
 288                        (sexp :tag "Method"))))
 289
 290 (defcustom gnus-group-highlight
 291   '(;; News.
 292     ((and (= unread 0) (not mailp) (eq level 1)) .
 293      gnus-group-news-1-empty-face)
 294     ((and (not mailp) (eq level 1)) .
 295      gnus-group-news-1-face)
 296     ((and (= unread 0) (not mailp) (eq level 2)) .
 297      gnus-group-news-2-empty-face)
 298     ((and (not mailp) (eq level 2)) .
 299      gnus-group-news-2-face)
 300     ((and (= unread 0) (not mailp) (eq level 3)) .
 301      gnus-group-news-3-empty-face)
 302     ((and (not mailp) (eq level 3)) .
 303      gnus-group-news-3-face)
 304     ((and (= unread 0) (not mailp) (eq level 4)) .
 305      gnus-group-news-4-empty-face)
 306     ((and (not mailp) (eq level 4)) .
 307      gnus-group-news-4-face)
 308     ((and (= unread 0) (not mailp) (eq level 5)) .
 309      gnus-group-news-5-empty-face)
 310     ((and (not mailp) (eq level 5)) .
 311      gnus-group-news-5-face)
 312     ((and (= unread 0) (not mailp) (eq level 6)) .
 313      gnus-group-news-6-empty-face)
 314     ((and (not mailp) (eq level 6)) .
 315      gnus-group-news-6-face)
 316     ((and (= unread 0) (not mailp)) .
 317      gnus-group-news-low-empty-face)
 318     ((and (not mailp)) .
 319      gnus-group-news-low-face)
 320     ;; Mail.
 321     ((and (= unread 0) (eq level 1)) .
 322      gnus-group-mail-1-empty-face)
 323     ((eq level 1) .
 324      gnus-group-mail-1-face)
 325     ((and (= unread 0) (eq level 2)) .
 326      gnus-group-mail-2-empty-face)
 327     ((eq level 2) .
 328      gnus-group-mail-2-face)
 329     ((and (= unread 0) (eq level 3)) .
 330      gnus-group-mail-3-empty-face)
 331     ((eq level 3) .
 332      gnus-group-mail-3-face)
 333     ((= unread 0) .
 334      gnus-group-mail-low-empty-face)
 335     (t .
 336        gnus-group-mail-low-face))
 337   "*Controls the highlighting of group buffer lines.
 338
 339 Below is a list of `Form'/`Face' pairs.  When deciding how a a
 340 particular group line should be displayed, each form is
 341 evaluated.  The content of the face field after the first true form is
 342 used.  You can change how those group lines are displayed by
 343 editing the face field.
 344
 345 It is also possible to change and add form fields, but currently that
 346 requires an understanding of Lisp expressions.  Hopefully this will
 347 change in a future release.  For now, you can use the following
 348 variables in the Lisp expression:
 349
 350 group: The name of the group.
 351 unread: The number of unread articles in the group.
 352 method: The select method used.
 353 mailp: Whether it's a mail group or not.
 354 level: The level of the group.
 355 score: The score of the group.
 356 ticked: The number of ticked articles."
 357   :group 'gnus-group-visual
 358   :type '(repeat (cons (sexp :tag "Form") face)))
 359
 360 (defcustom gnus-new-mail-mark ?%
 361   "Mark used for groups with new mail."
 362   :group 'gnus-group-visual
 363   :type 'character)
 364
 365 (defgroup gnus-group-icons nil
 366   "Add Icons to your group buffer.  "
 367   :group 'gnus-group-visual)
 368
 369 (defcustom gnus-group-icon-list
 370   nil
 371   "*Controls the insertion of icons into group buffer lines.
 372
 373 Below is a list of `Form'/`File' pairs.  When deciding how a
 374 particular group line should be displayed, each form is evaluated.
 375 The icon from the file field after the first true form is used.  You
 376 can change how those group lines are displayed by editing the file
 377 field.  The File will either be found in the
 378 `gnus-group-glyph-directory' or by designating absolute path to the
 379 file.
 380
 381 It is also possible to change and add form fields, but currently that
 382 requires an understanding of Lisp expressions.  Hopefully this will
 383 change in a future release.  For now, you can use the following
 384 variables in the Lisp expression:
 385
 386 group: The name of the group.
 387 unread: The number of unread articles in the group.
 388 method: The select method used.
 389 mailp: Whether it's a mail group or not.
 390 newsp: Whether it's a news group or not
 391 level: The level of the group.
 392 score: The score of the group.
 393 ticked: The number of ticked articles."
 394   :group 'gnus-group-icons
 395   :type '(repeat (cons (sexp :tag "Form") file)))
 396
 397 ;;; Internal variables
 398
 399 (defvar gnus-group-sort-alist-function 'gnus-group-sort-flat
 400   "Function for sorting the group buffer.")
 401
 402 (defvar gnus-group-sort-selected-function 'gnus-group-sort-selected-flat
 403   "Function for sorting the selected groups in the group buffer.")
 404
 405 (defvar gnus-group-indentation-function nil)
 406 (defvar gnus-goto-missing-group-function nil)
 407 (defvar gnus-group-update-group-function nil)
 408 (defvar gnus-group-goto-next-group-function nil
 409   "Function to override finding the next group after listing groups.")
 410
 411 (defvar gnus-group-edit-buffer nil)
 412
 413 (defvar gnus-group-line-format-alist
 414   `((?M gnus-tmp-marked-mark ?c)
 415     (?S gnus-tmp-subscribed ?c)
 416     (?L gnus-tmp-level ?d)
 417     (?N (cond ((eq number t) "*" )
 418               ((numberp number)
 419                (int-to-string
 420                 (+ number
 421                    (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked)))
 422                    (gnus-range-length (cdr (assq 'tick gnus-tmp-marked))))))
 423               (t number)) ?s)
 424     (?R gnus-tmp-number-of-read ?s)
 425     (?t gnus-tmp-number-total ?d)
 426     (?y gnus-tmp-number-of-unread ?s)
 427     (?I (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked))) ?d)
 428     (?T (gnus-range-length (cdr (assq 'tick gnus-tmp-marked))) ?d)
 429     (?i (+ (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked)))
 430            (gnus-range-length (cdr (assq 'tick gnus-tmp-marked)))) ?d)
 431     (?g gnus-tmp-group ?s)
 432     (?G gnus-tmp-qualified-group ?s)
 433     (?c (gnus-short-group-name gnus-tmp-group) ?s)
 434     (?D gnus-tmp-newsgroup-description ?s)
 435     (?o gnus-tmp-moderated ?c)
 436     (?O gnus-tmp-moderated-string ?s)
 437     (?p gnus-tmp-process-marked ?c)
 438     (?s gnus-tmp-news-server ?s)
 439     (?n gnus-tmp-news-method ?s)
 440     (?P gnus-group-indentation ?s)
 441     (?E gnus-tmp-group-icon ?s)
 442     (?l gnus-tmp-grouplens ?s)
 443     (?z gnus-tmp-news-method-string ?s)
 444     (?m (gnus-group-new-mail gnus-tmp-group) ?c)
 445     (?d (gnus-group-timestamp-string gnus-tmp-group) ?s)
 446     (?u gnus-tmp-user-defined ?s)))
 447
 448 (defvar gnus-group-mode-line-format-alist
 449   `((?S gnus-tmp-news-server ?s)
 450     (?M gnus-tmp-news-method ?s)
 451     (?u gnus-tmp-user-defined ?s)
 452     (?: gnus-tmp-colon ?s)))
 453
 454 (defvar gnus-topic-topology nil
 455   "The complete topic hierarchy.")
 456
 457 (defvar gnus-topic-alist nil
 458   "The complete topic-group alist.")
 459
 460 (defvar gnus-group-marked nil)
 461
 462 (defvar gnus-group-list-mode nil)
 463
 464
 465 (defvar gnus-group-icon-cache nil)
 466 (defvar gnus-group-running-xemacs (string-match "XEmacs" emacs-version))
 467
 468 ;;;
 469 ;;; Gnus group mode
 470 ;;;
 471
 472 (put 'gnus-group-mode 'mode-class 'special)
 473
 474 (when t
 475   (gnus-define-keys gnus-group-mode-map
 476     " " gnus-group-read-group
 477     "=" gnus-group-select-group
 478     "\r" gnus-group-select-group
 479     "\M-\r" gnus-group-quick-select-group
 480     [(meta control return)] gnus-group-select-group-ephemerally
 481     "j" gnus-group-jump-to-group
 482     "n" gnus-group-next-unread-group
 483     "p" gnus-group-prev-unread-group
 484     "\177" gnus-group-prev-unread-group
 485     [delete] gnus-group-prev-unread-group
 486     [backspace] gnus-group-prev-unread-group
 487     "N" gnus-group-next-group
 488     "P" gnus-group-prev-group
 489     "\M-n" gnus-group-next-unread-group-same-level
 490     "\M-p" gnus-group-prev-unread-group-same-level
 491     "," gnus-group-best-unread-group
 492     "." gnus-group-first-unread-group
 493     "u" gnus-group-unsubscribe-current-group
 494     "U" gnus-group-unsubscribe-group
 495     "c" gnus-group-catchup-current
 496     "C" gnus-group-catchup-current-all
 497     "\M-c" gnus-group-clear-data
 498     "l" gnus-group-list-groups
 499     "L" gnus-group-list-all-groups
 500     "m" gnus-group-mail
 501     "g" gnus-group-get-new-news
 502     "\M-g" gnus-group-get-new-news-this-group
 503     "R" gnus-group-restart
 504     "r" gnus-group-read-init-file
 505     "B" gnus-group-browse-foreign-server
 506     "b" gnus-group-check-bogus-groups
 507     "F" gnus-group-find-new-groups
 508     "\C-c\C-d" gnus-group-describe-group
 509     "\M-d" gnus-group-describe-all-groups
 510     "\C-c\C-a" gnus-group-apropos
 511     "\C-c\M-\C-a" gnus-group-description-apropos
 512     "a" gnus-group-post-news
 513     "\ek" gnus-group-edit-local-kill
 514     "\eK" gnus-group-edit-global-kill
 515     "\C-k" gnus-group-kill-group
 516     "\C-y" gnus-group-yank-group
 517     "\C-w" gnus-group-kill-region
 518     "\C-x\C-t" gnus-group-transpose-groups
 519     "\C-c\C-l" gnus-group-list-killed
 520     "\C-c\C-x" gnus-group-expire-articles
 521     "\C-c\M-\C-x" gnus-group-expire-all-groups
 522     "V" gnus-version
 523     "s" gnus-group-save-newsrc
 524     "z" gnus-group-suspend
 525     "q" gnus-group-exit
 526     "Q" gnus-group-quit
 527     "?" gnus-group-describe-briefly
 528     "\C-c\C-i" gnus-info-find-node
 529     "\M-e" gnus-group-edit-group-method
 530     "^" gnus-group-enter-server-mode
 531     gnus-mouse-2 gnus-mouse-pick-group
 532     "<" beginning-of-buffer
 533     ">" end-of-buffer
 534     "\C-c\C-b" gnus-bug
 535     "\C-c\C-s" gnus-group-sort-groups
 536     "t" gnus-topic-mode
 537     "\C-c\M-g" gnus-activate-all-groups
 538     "\M-&" gnus-group-universal-argument
 539     "#" gnus-group-mark-group
 540     "\M-#" gnus-group-unmark-group)
 541
 542   (gnus-define-keys (gnus-group-mark-map "M" gnus-group-mode-map)
 543     "m" gnus-group-mark-group
 544     "u" gnus-group-unmark-group
 545     "w" gnus-group-mark-region
 546     "b" gnus-group-mark-buffer
 547     "r" gnus-group-mark-regexp
 548     "U" gnus-group-unmark-all-groups)
 549
 550   (gnus-define-keys (gnus-group-group-map "G" gnus-group-mode-map)
 551     "d" gnus-group-make-directory-group
 552     "h" gnus-group-make-help-group
 553     "u" gnus-group-make-useful-group
 554     "a" gnus-group-make-archive-group
 555     "k" gnus-group-make-kiboze-group
 556     "l" gnus-group-nnimap-edit-acl
 557     "m" gnus-group-make-group
 558     "E" gnus-group-edit-group
 559     "e" gnus-group-edit-group-method
 560     "p" gnus-group-edit-group-parameters
 561     "v" gnus-group-add-to-virtual
 562     "V" gnus-group-make-empty-virtual
 563     "D" gnus-group-enter-directory
 564     "f" gnus-group-make-doc-group
 565     "w" gnus-group-make-web-group
 566     "r" gnus-group-rename-group
 567     "c" gnus-group-customize
 568     "x" gnus-group-nnimap-expunge
 569     "\177" gnus-group-delete-group
 570     [delete] gnus-group-delete-group)
 571
 572   (gnus-define-keys (gnus-group-soup-map "s" gnus-group-group-map)
 573     "b" gnus-group-brew-soup
 574     "w" gnus-soup-save-areas
 575     "s" gnus-soup-send-replies
 576     "p" gnus-soup-pack-packet
 577     "r" nnsoup-pack-replies)
 578
 579   (gnus-define-keys (gnus-group-sort-map "S" gnus-group-group-map)
 580     "s" gnus-group-sort-groups
 581     "a" gnus-group-sort-groups-by-alphabet
 582     "u" gnus-group-sort-groups-by-unread
 583     "l" gnus-group-sort-groups-by-level
 584     "v" gnus-group-sort-groups-by-score
 585     "r" gnus-group-sort-groups-by-rank
 586     "m" gnus-group-sort-groups-by-method)
 587
 588   (gnus-define-keys (gnus-group-sort-selected-map "P" gnus-group-group-map)
 589     "s" gnus-group-sort-selected-groups
 590     "a" gnus-group-sort-selected-groups-by-alphabet
 591     "u" gnus-group-sort-selected-groups-by-unread
 592     "l" gnus-group-sort-selected-groups-by-level
 593     "v" gnus-group-sort-selected-groups-by-score
 594     "r" gnus-group-sort-selected-groups-by-rank
 595     "m" gnus-group-sort-selected-groups-by-method)
 596
 597   (gnus-define-keys (gnus-group-list-map "A" gnus-group-mode-map)
 598     "k" gnus-group-list-killed
 599     "z" gnus-group-list-zombies
 600     "s" gnus-group-list-groups
 601     "u" gnus-group-list-all-groups
 602     "A" gnus-group-list-active
 603     "a" gnus-group-apropos
 604     "d" gnus-group-description-apropos
 605     "m" gnus-group-list-matching
 606     "M" gnus-group-list-all-matching
 607     "l" gnus-group-list-level
 608     "c" gnus-group-list-cached)
 609
 610   (gnus-define-keys (gnus-group-score-map "W" gnus-group-mode-map)
 611     "f" gnus-score-flush-cache)
 612
 613   (gnus-define-keys (gnus-group-help-map "H" gnus-group-mode-map)
 614     "d" gnus-group-describe-group
 615     "f" gnus-group-fetch-faq
 616     "v" gnus-version)
 617
 618   (gnus-define-keys (gnus-group-sub-map "S" gnus-group-mode-map)
 619     "l" gnus-group-set-current-level
 620     "t" gnus-group-unsubscribe-current-group
 621     "s" gnus-group-unsubscribe-group
 622     "k" gnus-group-kill-group
 623     "y" gnus-group-yank-group
 624     "w" gnus-group-kill-region
 625     "\C-k" gnus-group-kill-level
 626     "z" gnus-group-kill-all-zombies))
 627
 628 (defun gnus-group-make-menu-bar ()
 629   (gnus-turn-off-edit-menu 'group)
 630   (unless (boundp 'gnus-group-reading-menu)
 631
 632     (easy-menu-define
 633      gnus-group-reading-menu gnus-group-mode-map ""
 634      '("Group"
 635        ["Read" gnus-group-read-group (gnus-group-group-name)]
 636        ["Select" gnus-group-select-group (gnus-group-group-name)]
 637        ["See old articles" (gnus-group-select-group 'all)
 638         :keys "C-u SPC" :active (gnus-group-group-name)]
 639        ["Catch up" gnus-group-catchup-current (gnus-group-group-name)]
 640        ["Catch up all articles" gnus-group-catchup-current-all
 641         (gnus-group-group-name)]
 642        ["Check for new articles" gnus-group-get-new-news-this-group
 643         (gnus-group-group-name)]
 644        ["Toggle subscription" gnus-group-unsubscribe-current-group
 645         (gnus-group-group-name)]
 646        ["Kill" gnus-group-kill-group (gnus-group-group-name)]
 647        ["Yank" gnus-group-yank-group gnus-list-of-killed-groups]
 648        ["Describe" gnus-group-describe-group (gnus-group-group-name)]
 649        ["Fetch FAQ" gnus-group-fetch-faq (gnus-group-group-name)]
 650        ;; Actually one should check, if any of the marked groups gives t for
 651        ;; (gnus-check-backend-function 'request-expire-articles ...)
 652        ["Expire articles" gnus-group-expire-articles
 653         (or (and (gnus-group-group-name)
 654                  (gnus-check-backend-function
 655                   'request-expire-articles
 656                   (gnus-group-group-name))) gnus-group-marked)]
 657        ["Set group level" gnus-group-set-current-level
 658         (gnus-group-group-name)]
 659        ["Select quick" gnus-group-quick-select-group (gnus-group-group-name)]
 660        ["Customize" gnus-group-customize (gnus-group-group-name)]
 661        ("Edit"
 662         ["Parameters" gnus-group-edit-group-parameters
 663          (gnus-group-group-name)]
 664         ["Select method" gnus-group-edit-group-method
 665          (gnus-group-group-name)]
 666         ["Info" gnus-group-edit-group (gnus-group-group-name)]
 667         ["Local kill file" gnus-group-edit-local-kill (gnus-group-group-name)]
 668         ["Global kill file" gnus-group-edit-global-kill t])))
 669
 670     (easy-menu-define
 671      gnus-group-group-menu gnus-group-mode-map ""
 672      '("Groups"
 673        ("Listing"
 674         ["List unread subscribed groups" gnus-group-list-groups t]
 675         ["List (un)subscribed groups" gnus-group-list-all-groups t]
 676         ["List killed groups" gnus-group-list-killed gnus-killed-list]
 677         ["List zombie groups" gnus-group-list-zombies gnus-zombie-list]
 678         ["List level..." gnus-group-list-level t]
 679         ["Describe all groups" gnus-group-describe-all-groups t]
 680         ["Group apropos..." gnus-group-apropos t]
 681         ["Group and description apropos..." gnus-group-description-apropos t]
 682         ["List groups matching..." gnus-group-list-matching t]
 683         ["List all groups matching..." gnus-group-list-all-matching t]
 684         ["List active file" gnus-group-list-active t]
 685         ["List groups with cached" gnus-group-list-cached t])
 686        ("Sort"
 687         ["Default sort" gnus-group-sort-groups t]
 688         ["Sort by method" gnus-group-sort-groups-by-method t]
 689         ["Sort by rank" gnus-group-sort-groups-by-rank t]
 690         ["Sort by score" gnus-group-sort-groups-by-score t]
 691         ["Sort by level" gnus-group-sort-groups-by-level t]
 692         ["Sort by unread" gnus-group-sort-groups-by-unread t]
 693         ["Sort by name" gnus-group-sort-groups-by-alphabet t])
 694        ("Sort process/prefixed"
 695         ["Default sort" gnus-group-sort-selected-groups
 696          (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))]
 697         ["Sort by method" gnus-group-sort-selected-groups-by-method
 698          (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))]
 699         ["Sort by rank" gnus-group-sort-selected-groups-by-rank
 700          (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))]
 701         ["Sort by score" gnus-group-sort-selected-groups-by-score
 702          (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))]
 703         ["Sort by level" gnus-group-sort-selected-groups-by-level
 704          (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))]
 705         ["Sort by unread" gnus-group-sort-selected-groups-by-unread
 706          (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))]
 707         ["Sort by name" gnus-group-sort-selected-groups-by-alphabet
 708          (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))])
 709        ("Mark"
 710         ["Mark group" gnus-group-mark-group
 711          (and (gnus-group-group-name)
 712               (not (memq (gnus-group-group-name) gnus-group-marked)))]
 713         ["Unmark group" gnus-group-unmark-group
 714          (and (gnus-group-group-name)
 715               (memq (gnus-group-group-name) gnus-group-marked))]
 716         ["Unmark all" gnus-group-unmark-all-groups gnus-group-marked]
 717         ["Mark regexp..." gnus-group-mark-regexp t]
 718         ["Mark region" gnus-group-mark-region t]
 719         ["Mark buffer" gnus-group-mark-buffer t]
 720         ["Execute command" gnus-group-universal-argument
 721          (or gnus-group-marked (gnus-group-group-name))])
 722        ("Subscribe"
 723         ["Subscribe to a group" gnus-group-unsubscribe-group t]
 724         ["Kill all newsgroups in region" gnus-group-kill-region t]
 725         ["Kill all zombie groups" gnus-group-kill-all-zombies
 726          gnus-zombie-list]
 727         ["Kill all groups on level..." gnus-group-kill-level t])
 728        ("Foreign groups"
 729         ["Make a foreign group" gnus-group-make-group t]
 730         ["Add a directory group" gnus-group-make-directory-group t]
 731         ["Add the help group" gnus-group-make-help-group t]
 732         ["Add the archive group" gnus-group-make-archive-group t]
 733         ["Make a doc group" gnus-group-make-doc-group t]
 734         ["Make a web group" gnus-group-make-web-group t]
 735         ["Make a kiboze group" gnus-group-make-kiboze-group t]
 736         ["Make a virtual group" gnus-group-make-empty-virtual t]
 737         ["Add a group to a virtual" gnus-group-add-to-virtual t]
 738         ["Rename group" gnus-group-rename-group
 739          (gnus-check-backend-function
 740           'request-rename-group (gnus-group-group-name))]
 741         ["Delete group" gnus-group-delete-group
 742          (gnus-check-backend-function
 743           'request-delete-group (gnus-group-group-name))])
 744        ("Move"
 745         ["Next" gnus-group-next-group t]
 746         ["Previous" gnus-group-prev-group t]
 747         ["Next unread" gnus-group-next-unread-group t]
 748         ["Previous unread" gnus-group-prev-unread-group t]
 749         ["Next unread same level" gnus-group-next-unread-group-same-level t]
 750         ["Previous unread same level"
 751          gnus-group-prev-unread-group-same-level t]
 752         ["Jump to group" gnus-group-jump-to-group t]
 753         ["First unread group" gnus-group-first-unread-group t]
 754         ["Best unread group" gnus-group-best-unread-group t])
 755        ["Delete bogus groups" gnus-group-check-bogus-groups t]
 756        ["Find new newsgroups" gnus-group-find-new-groups t]
 757        ["Transpose" gnus-group-transpose-groups
 758         (gnus-group-group-name)]
 759        ["Read a directory as a group..." gnus-group-enter-directory t]))
 760
 761     (easy-menu-define
 762      gnus-group-misc-menu gnus-group-mode-map ""
 763      '("Misc"
 764        ("SOUP"
 765         ["Pack replies" nnsoup-pack-replies (fboundp 'nnsoup-request-group)]
 766         ["Send replies" gnus-soup-send-replies
 767          (fboundp 'gnus-soup-pack-packet)]
 768         ["Pack packet" gnus-soup-pack-packet (fboundp 'gnus-soup-pack-packet)]
 769         ["Save areas" gnus-soup-save-areas (fboundp 'gnus-soup-pack-packet)]
 770         ["Brew SOUP" gnus-group-brew-soup (fboundp 'gnus-soup-pack-packet)])
 771        ["Send a mail" gnus-group-mail t]
 772        ["Post an article..." gnus-group-post-news t]
 773        ["Check for new news" gnus-group-get-new-news t]
 774        ["Activate all groups" gnus-activate-all-groups t]
 775        ["Restart Gnus" gnus-group-restart t]
 776        ["Read init file" gnus-group-read-init-file t]
 777        ["Browse foreign server" gnus-group-browse-foreign-server t]
 778        ["Enter server buffer" gnus-group-enter-server-mode t]
 779        ["Expire all expirable articles" gnus-group-expire-all-groups t]
 780        ["Generate any kiboze groups" nnkiboze-generate-groups t]
 781        ["Gnus version" gnus-version t]
 782        ["Save .newsrc files" gnus-group-save-newsrc t]
 783        ["Suspend Gnus" gnus-group-suspend t]
 784        ["Clear dribble buffer" gnus-group-clear-dribble t]
 785        ["Read manual" gnus-info-find-node t]
 786        ["Flush score cache" gnus-score-flush-cache t]
 787        ["Toggle topics" gnus-topic-mode t]
 788        ["Send a bug report" gnus-bug t]
 789        ["Exit from Gnus" gnus-group-exit t]
 790        ["Exit without saving" gnus-group-quit t]))
 791
 792     (gnus-run-hooks 'gnus-group-menu-hook)))
 793
 794 (defun gnus-group-mode ()
 795   "Major mode for reading news.
 796
 797 All normal editing commands are switched off.
 798 \\<gnus-group-mode-map>
 799 The group buffer lists (some of) the groups available.  For instance,
 800 `\\[gnus-group-list-groups]' will list all subscribed groups with unread articles, while `\\[gnus-group-list-zombies]'
 801 lists all zombie groups.
 802
 803 Groups that are displayed can be entered with `\\[gnus-group-read-group]'.  To subscribe
 804 to a group not displayed, type `\\[gnus-group-unsubscribe-group]'.
 805
 806 For more in-depth information on this mode, read the manual (`\\[gnus-info-find-node]').
 807
 808 The following commands are available:
 809
 810 \\{gnus-group-mode-map}"
 811   (interactive)
 812   (when (gnus-visual-p 'group-menu 'menu)
 813     (gnus-group-make-menu-bar))
 814   (kill-all-local-variables)
 815   (gnus-simplify-mode-line)
 816   (setq major-mode 'gnus-group-mode)
 817   (setq mode-name "Group")
 818   (gnus-group-set-mode-line)
 819   (setq mode-line-process nil)
 820   (use-local-map gnus-group-mode-map)
 821   (buffer-disable-undo)
 822   (setq truncate-lines t)
 823   (setq buffer-read-only t)
 824   (gnus-set-default-directory)
 825   (gnus-update-format-specifications nil 'group 'group-mode)
 826   (gnus-update-group-mark-positions)
 827   (when gnus-use-undo
 828     (gnus-undo-mode 1))
 829   (when gnus-slave
 830     (gnus-slave-mode))
 831   (gnus-run-hooks 'gnus-group-mode-hook))
 832
 833 (defun gnus-update-group-mark-positions ()
 834   (save-excursion
 835     (let ((gnus-process-mark ?\200)
 836           (gnus-group-marked '("dummy.group"))
 837           (gnus-active-hashtb (make-vector 10 0))
 838           (topic ""))
 839       (gnus-set-active "dummy.group" '(0 . 0))
 840       (gnus-set-work-buffer)
 841       (gnus-group-insert-group-line "dummy.group" 0 nil 0 nil)
 842       (goto-char (point-min))
 843       (setq gnus-group-mark-positions
 844             (list (cons 'process (and (search-forward "\200" nil t)
 845                                       (- (point) 2))))))))
 846
 847 (defun gnus-mouse-pick-group (e)
 848   "Enter the group under the mouse pointer."
 849   (interactive "e")
 850   (mouse-set-point e)
 851   (gnus-group-read-group nil))
 852
 853 ;; Look at LEVEL and find out what the level is really supposed to be.
 854 ;; If LEVEL is non-nil, LEVEL will be returned, if not, what happens
 855 ;; will depend on whether `gnus-group-use-permanent-levels' is used.
 856 (defun gnus-group-default-level (&optional level number-or-nil)
 857   (cond
 858    (gnus-group-use-permanent-levels
 859     (or (setq gnus-group-use-permanent-levels
 860               (or level (if (numberp gnus-group-use-permanent-levels)
 861                             gnus-group-use-permanent-levels
 862                           (or gnus-group-default-list-level
 863                               gnus-level-subscribed))))
 864         gnus-group-default-list-level gnus-level-subscribed))
 865    (number-or-nil
 866     level)
 867    (t
 868     (or level gnus-group-default-list-level gnus-level-subscribed))))
 869
 870 (defun gnus-group-setup-buffer ()
 871   (set-buffer (gnus-get-buffer-create gnus-group-buffer))
 872   (unless (eq major-mode 'gnus-group-mode)
 873     (gnus-group-mode)
 874     (when gnus-carpal
 875       (gnus-carpal-setup-buffer 'group))))
 876
 877 (defun gnus-group-list-groups (&optional level unread lowest)
 878   "List newsgroups with level LEVEL or lower that have unread articles.
 879 Default is all subscribed groups.
 880 If argument UNREAD is non-nil, groups with no unread articles are also
 881 listed.
 882
 883 Also see the `gnus-group-use-permanent-levels' variable."
 884   (interactive
 885    (list (if current-prefix-arg
 886              (prefix-numeric-value current-prefix-arg)
 887            (or
 888             (gnus-group-default-level nil t)
 889             gnus-group-default-list-level
 890             gnus-level-subscribed))))
 891   (unless level
 892     (setq level (car gnus-group-list-mode)
 893           unread (cdr gnus-group-list-mode)))
 894   (setq level (gnus-group-default-level level))
 895   (gnus-group-setup-buffer)
 896   (gnus-update-format-specifications nil 'group 'group-mode)
 897   (let ((case-fold-search nil)
 898         (props (text-properties-at (gnus-point-at-bol)))
 899         (empty (= (point-min) (point-max)))
 900         (group (gnus-group-group-name))
 901         number)
 902     (set-buffer gnus-group-buffer)
 903     (setq number (funcall gnus-group-prepare-function level unread lowest))
 904     (when (or (and (numberp number)
 905                    (zerop number))
 906               (zerop (buffer-size)))
 907       ;; No groups in the buffer.
 908       (gnus-message 5 gnus-no-groups-message))
 909     ;; We have some groups displayed.
 910     (goto-char (point-max))
 911     (when (or (not gnus-group-goto-next-group-function)
 912               (not (funcall gnus-group-goto-next-group-function
 913                             group props)))
 914       (cond
 915        (empty
 916         (goto-char (point-min)))
 917        ((not group)
 918         ;; Go to the first group with unread articles.
 919         (gnus-group-search-forward t))
 920        (t
 921         ;; Find the right group to put point on.  If the current group
 922         ;; has disappeared in the new listing, try to find the next
 923         ;; one.  If no next one can be found, just leave point at the
 924         ;; first newsgroup in the buffer.
 925         (when (not (gnus-goto-char
 926                     (text-property-any
 927                      (point-min) (point-max)
 928                      'gnus-group (gnus-intern-safe
 929                                   group gnus-active-hashtb))))
 930           (let ((newsrc (cdddr (gnus-gethash group gnus-newsrc-hashtb))))
 931             (while (and newsrc
 932                         (not (gnus-goto-char
 933                               (text-property-any
 934                                (point-min) (point-max) 'gnus-group
 935                                (gnus-intern-safe
 936                                 (caar newsrc) gnus-active-hashtb)))))
 937               (setq newsrc (cdr newsrc)))
 938             (unless newsrc
 939               (goto-char (point-max))
 940               (forward-line -1)))))))
 941     ;; Adjust cursor point.
 942     (gnus-group-position-point)))
 943
 944 (defun gnus-group-list-level (level &optional all)
 945   "List groups on LEVEL.
 946 If ALL (the prefix), also list groups that have no unread articles."
 947   (interactive "nList groups on level: \nP")
 948   (gnus-group-list-groups level all level))
 949
 950 (defun gnus-group-prepare-flat (level &optional all lowest regexp)
 951   "List all newsgroups with unread articles of level LEVEL or lower.
 952 If ALL is non-nil, list groups that have no unread articles.
 953 If LOWEST is non-nil, list all newsgroups of level LOWEST or higher.
 954 If REGEXP, only list groups matching REGEXP."
 955   (set-buffer gnus-group-buffer)
 956   (let ((buffer-read-only nil)
 957         (newsrc (cdr gnus-newsrc-alist))
 958         (lowest (or lowest 1))
 959         info clevel unread group params)
 960     (erase-buffer)
 961     (when (< lowest gnus-level-zombie)
 962       ;; List living groups.
 963       (while newsrc
 964         (setq info (car newsrc)
 965               group (gnus-info-group info)
 966               params (gnus-info-params info)
 967               newsrc (cdr newsrc)
 968               unread (car (gnus-gethash group gnus-newsrc-hashtb)))
 969         (and unread                     ; This group might be unchecked
 970              (or (not regexp)
 971                  (string-match regexp group))
 972              (<= (setq clevel (gnus-info-level info)) level)
 973              (>= clevel lowest)
 974              (or all                    ; We list all groups?
 975                  (if (eq unread t)      ; Unactivated?
 976                      gnus-group-list-inactive-groups ; We list unactivated
 977                    (> unread 0))        ; We list groups with unread articles
 978                  (and gnus-list-groups-with-ticked-articles
 979                       (cdr (assq 'tick (gnus-info-marks info))))
 980                                         ; And groups with tickeds
 981                  ;; Check for permanent visibility.
 982                  (and gnus-permanently-visible-groups
 983                       (string-match gnus-permanently-visible-groups
 984                                     group))
 985                  (memq 'visible params)
 986                  (cdr (assq 'visible params)))
 987              (gnus-group-insert-group-line
 988               group (gnus-info-level info)
 989               (gnus-info-marks info) unread (gnus-info-method info)))))
 990
 991     ;; List dead groups.
 992     (and (>= level gnus-level-zombie) (<= lowest gnus-level-zombie)
 993          (gnus-group-prepare-flat-list-dead
 994           (setq gnus-zombie-list (sort gnus-zombie-list 'string<))
 995           gnus-level-zombie ?Z
 996           regexp))
 997     (and (>= level gnus-level-killed) (<= lowest gnus-level-killed)
 998          (gnus-group-prepare-flat-list-dead
 999           (setq gnus-killed-list (sort gnus-killed-list 'string<))
1000           gnus-level-killed ?K regexp))
1001
1002     (gnus-group-set-mode-line)
1003     (setq gnus-group-list-mode (cons level all))
1004     (gnus-run-hooks 'gnus-group-prepare-hook)
1005     t))
1006
1007 (defun gnus-group-prepare-flat-list-dead (groups level mark regexp)
1008   ;; List zombies and killed lists somewhat faster, which was
1009   ;; suggested by Jack Vinson <vinson@unagi.cis.upenn.edu>.  It does
1010   ;; this by ignoring the group format specification altogether.
1011   (let (group)
1012     (if regexp
1013         ;; This loop is used when listing groups that match some
1014         ;; regexp.
1015         (while groups
1016           (setq group (pop groups))
1017           (when (string-match regexp group)
1018             (gnus-add-text-properties
1019              (point) (prog1 (1+ (point))
1020                        (insert " " mark "     *: " group "\n"))
1021              (list 'gnus-group (gnus-intern-safe group gnus-active-hashtb)
1022                    'gnus-unread t
1023                    'gnus-level level))))
1024       ;; This loop is used when listing all groups.
1025       (while groups
1026         (gnus-add-text-properties
1027          (point) (prog1 (1+ (point))
1028                    (insert " " mark "     *: "
1029                            (setq group (pop groups)) "\n"))
1030          (list 'gnus-group (gnus-intern-safe group gnus-active-hashtb)
1031                'gnus-unread t
1032                'gnus-level level))))))
1033
1034 (defun gnus-group-update-group-line ()
1035   "Update the current line in the group buffer."
1036   (let* ((buffer-read-only nil)
1037          (group (gnus-group-group-name))
1038          (entry (and group (gnus-gethash group gnus-newsrc-hashtb)))
1039          gnus-group-indentation)
1040     (when group
1041       (and entry
1042            (not (gnus-ephemeral-group-p group))
1043            (gnus-dribble-enter
1044             (concat "(gnus-group-set-info '"
1045                     (gnus-prin1-to-string (nth 2 entry))
1046                     ")")))
1047       (setq gnus-group-indentation (gnus-group-group-indentation))
1048       (gnus-delete-line)
1049       (gnus-group-insert-group-line-info group)
1050       (forward-line -1)
1051       (gnus-group-position-point))))
1052
1053 (defun gnus-group-insert-group-line-info (group)
1054   "Insert GROUP on the current line."
1055   (let ((entry (gnus-gethash group gnus-newsrc-hashtb))
1056         (gnus-group-indentation (gnus-group-group-indentation))
1057         active info)
1058     (if entry
1059         (progn
1060           ;; (Un)subscribed group.
1061           (setq info (nth 2 entry))
1062           (gnus-group-insert-group-line
1063            group (gnus-info-level info) (gnus-info-marks info)
1064            (or (car entry) t) (gnus-info-method info)))
1065       ;; This group is dead.
1066       (gnus-group-insert-group-line
1067        group
1068        (if (member group gnus-zombie-list) gnus-level-zombie gnus-level-killed)
1069        nil
1070        (if (setq active (gnus-active group))
1071            (if (zerop (cdr active))
1072                0
1073              (- (1+ (cdr active)) (car active)))
1074          nil)
1075        nil))))
1076
1077 (defun gnus-group-insert-group-line (gnus-tmp-group gnus-tmp-level
1078                                                     gnus-tmp-marked number
1079                                                     gnus-tmp-method)
1080   "Insert a group line in the group buffer."
1081   (let* ((gnus-tmp-active (gnus-active gnus-tmp-group))
1082          (gnus-tmp-number-total
1083           (if gnus-tmp-active
1084               (1+ (- (cdr gnus-tmp-active) (car gnus-tmp-active)))
1085             0))
1086          (gnus-tmp-number-of-unread
1087           (if (numberp number) (int-to-string (max 0 number))
1088             "*"))
1089          (gnus-tmp-number-of-read
1090           (if (numberp number)
1091               (int-to-string (max 0 (- gnus-tmp-number-total number)))
1092             "*"))
1093          (gnus-tmp-subscribed
1094           (cond ((<= gnus-tmp-level gnus-level-subscribed) ? )
1095                 ((<= gnus-tmp-level gnus-level-unsubscribed) ?U)
1096                 ((= gnus-tmp-level gnus-level-zombie) ?Z)
1097                 (t ?K)))
1098          (gnus-tmp-qualified-group (gnus-group-real-name gnus-tmp-group))
1099          (gnus-tmp-newsgroup-description
1100           (if gnus-description-hashtb
1101               (or (gnus-gethash gnus-tmp-group gnus-description-hashtb) "")
1102             ""))
1103          (gnus-tmp-moderated
1104           (if (and gnus-moderated-hashtb
1105                    (gnus-gethash gnus-tmp-group gnus-moderated-hashtb))
1106               ?m ? ))
1107          (gnus-tmp-moderated-string
1108           (if (eq gnus-tmp-moderated ?m) "(m)" ""))
1109          (gnus-tmp-group-icon "==&&==")
1110          (gnus-tmp-method
1111           (gnus-server-get-method gnus-tmp-group gnus-tmp-method)) ;
1112          (gnus-tmp-news-server (or (cadr gnus-tmp-method) ""))
1113          (gnus-tmp-news-method (or (car gnus-tmp-method) ""))
1114          (gnus-tmp-news-method-string
1115           (if gnus-tmp-method
1116               (format "(%s:%s)" (car gnus-tmp-method)
1117                       (cadr gnus-tmp-method)) ""))
1118          (gnus-tmp-marked-mark
1119           (if (and (numberp number)
1120                    (zerop number)
1121                    (cdr (assq 'tick gnus-tmp-marked)))
1122               ?* ? ))
1123          (gnus-tmp-process-marked
1124           (if (member gnus-tmp-group gnus-group-marked)
1125               gnus-process-mark ? ))
1126          (gnus-tmp-grouplens
1127           (or (and gnus-use-grouplens
1128                    (bbb-grouplens-group-p gnus-tmp-group))
1129               ""))
1130          (buffer-read-only nil)
1131          header gnus-tmp-header)        ; passed as parameter to user-funcs.
1132     (beginning-of-line)
1133     (gnus-add-text-properties
1134      (point)
1135      (prog1 (1+ (point))
1136        ;; Insert the text.
1137        (eval gnus-group-line-format-spec))
1138      `(gnus-group ,(gnus-intern-safe gnus-tmp-group gnus-active-hashtb)
1139                   gnus-unread ,(if (numberp number)
1140                                    (string-to-int gnus-tmp-number-of-unread)
1141                                  t)
1142                   gnus-marked ,gnus-tmp-marked-mark
1143                   gnus-indentation ,gnus-group-indentation
1144                   gnus-level ,gnus-tmp-level))
1145     (forward-line -1)
1146     (when (inline (gnus-visual-p 'group-highlight 'highlight))
1147       (gnus-run-hooks 'gnus-group-update-hook)
1148       (forward-line))
1149     ;; Allow XEmacs to remove front-sticky text properties.
1150     (gnus-group-remove-excess-properties)))
1151
1152 (defun gnus-group-highlight-line ()
1153   "Highlight the current line according to `gnus-group-highlight'."
1154   (let* ((list gnus-group-highlight)
1155          (p (point))
1156          (end (progn (end-of-line) (point)))
1157          ;; now find out where the line starts and leave point there.
1158          (beg (progn (beginning-of-line) (point)))
1159          (group (gnus-group-group-name))
1160          (entry (gnus-group-entry group))
1161          (unread (if (numberp (car entry)) (car entry) 0))
1162          (active (gnus-active group))
1163          (total (if active (1+ (- (cdr active) (car active))) 0))
1164          (info (nth 2 entry))