lisp/gnus/gnus-group.el

0 ;;; gnus-group.el --- group mode commands for Gnus
6 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
34 (require 'gnus)
35 (require 'gnus-start)
37 (require 'gnus-spec)
38 (require 'gnus-int)
39 (require 'gnus-range)
40 (require 'gnus-win)
41 (require 'gnus-undo)
44 (require 'gnus-ems)
48   (let ((features (cons 'gnus-group features)))
49     (require 'gnus-sum))
50   (defvar gnus-cache-active-hashtb))
52 (defcustom gnus-group-archive-directory
55   :group 'gnus-group-foreign
58 (defcustom gnus-group-recent-archive-directory
61   :group 'gnus-group-foreign
64 (defcustom gnus-no-groups-message "No gnus is bad news"
65   "*Message displayed by Gnus when no groups are available."
66   :group 'gnus-start
69 (defcustom gnus-keep-same-level nil
73 is nil, the next newsgroup will be the next from the group
81   :group 'gnus-group-levels
86 (defcustom gnus-group-goto-unread t
87   "*If non-nil, movement commands will go to the next unread and subscribed group."
88   :link '(custom-manual "(gnus)Group Maneuvering")
89   :group 'gnus-group-various
92 (defcustom gnus-goto-next-group-when-activating t
93   "*If non-nil, the \\<gnus-group-mode-map>\\[gnus-group-get-new-news-this-group] command will advance point to the next group."
94   :link '(custom-manual "(gnus)Scanning New Messages")
95   :group 'gnus-group-various
98 (defcustom gnus-permanently-visible-groups nil
99   "*Regexp to match groups that should always be listed in the group buffer.
101 unread articles in the groups.
103 If nil, no groups are permanently visible."
104   :group 'gnus-group-listing
107 (defcustom gnus-list-groups-with-ticked-articles t
108   "*If non-nil, list groups that have only ticked articles.
109 If nil, only list groups that have unread articles."
110   :group 'gnus-group-listing
113 (defcustom gnus-group-default-list-level gnus-level-subscribed
115 Ignored if `gnus-group-use-permanent-levels' is non-nil."
116   :group 'gnus-group-listing
119 (defcustom gnus-group-list-inactive-groups t
120   "*If non-nil, inactive groups will be listed."
121   :group 'gnus-group-listing
122   :group 'gnus-group-levels
125 (defcustom gnus-group-sort-function 'gnus-group-sort-by-alphabet
126   "*Function used for sorting the group buffer.
127 This function will be called with group info entries as the arguments
128 for the groups to be sorted.  Pre-made functions include
129 `gnus-group-sort-by-alphabet', `gnus-group-sort-by-real-name',
130 `gnus-group-sort-by-unread', `gnus-group-sort-by-level',
131 `gnus-group-sort-by-score', `gnus-group-sort-by-method',
132 `gnus-group-sort-by-server', and `gnus-group-sort-by-rank'.
135 the most significant sort function should be the last function in the
137   :group 'gnus-group-listing
138   :link '(custom-manual "(gnus)Sorting Groups")
144 		 (choice (function-item gnus-group-sort-by-alphabet)
145 			 (function-item gnus-group-sort-by-real-name)
146 			 (function-item gnus-group-sort-by-unread)
147 			 (function-item gnus-group-sort-by-level)
148 			 (function-item gnus-group-sort-by-score)
149 			 (function-item gnus-group-sort-by-method)
150 			 (function-item gnus-group-sort-by-server)
151 			 (function-item gnus-group-sort-by-rank)
154 (defcustom gnus-group-line-format "%M\%S\%p\%P\%5y:%B%(%g%)%l %O\n"
155   "*Format of group lines.
160 %S    Whether the group is subscribed (character, \"U\", \"K\", \"Z\" or \" \")
171 %g    Qualified group name (string)
172 %c    Short (collapsed) group name.  See `gnus-group-uncollapsed-levels'.
176 %o    Moderated group (char, \"m\")
178 %B    Whether a summary buffer for the group is open (char, \"*\")
179 %O    Moderated group (string, \"(m)\" or \"\")
181 %m    Whether there is new(ish) mail in the group (char, \"%\")
182 %l    Whether there are GroupLens predictions for this group (string)
185 %d    The date the group was last entered.
186 %E    Icon as defined by `gnus-group-icon-list'.
188       be a letter.  Gnus will call the function gnus-user-format-function-X,
192       from any other group specifier.
195 reasons of efficiency, when listing killed groups, this specification
198 groups.
207 See Info node `(gnus)Formatting Variables'."
208   :link '(custom-manual "(gnus)Formatting Variables")
209   :group 'gnus-group-visual
212 (defcustom gnus-group-mode-line-format "Gnus: %%b {%M\%:%S}"
213   "*The format specification for the group mode line.
220   :group 'gnus-group-visual
223 ;; Extracted from gnus-xmas-redefine in order to preserve user settings
225   (add-hook 'gnus-group-mode-hook 'gnus-xmas-group-menu-add)
226   (add-hook 'gnus-group-mode-hook 'gnus-xmas-setup-group-toolbar))
228 (defcustom gnus-group-menu-hook nil
229   "Hook run after the creation of the group mode menu."
230   :group 'gnus-group-various
233 (defcustom gnus-group-catchup-group-hook nil
234   "Hook run when catching up a group from the group buffer."
235   :group 'gnus-group-various
236   :link '(custom-manual "(gnus)Group Data")
239 (defcustom gnus-group-update-group-hook nil
240   "Hook called when updating group lines."
241   :group 'gnus-group-visual
244 (defcustom gnus-group-prepare-function 'gnus-group-prepare-flat
245   "*A function that is called to generate the group buffer.
247 all group with a level less or equal to that number should be listed,
248 if the second is non-nil, empty groups should also be displayed.  If
249 the third is non-nil, it is a number.  No groups with a level lower
252 The only current function implemented is `gnus-group-prepare-flat'."
253   :group 'gnus-group-listing
256 (defcustom gnus-group-prepare-hook nil
257   "Hook called after the group buffer has been generated.
258 If you want to modify the group buffer, you can use this hook."
259   :group 'gnus-group-listing
262 (defcustom gnus-suspend-gnus-hook nil
264   :group 'gnus-exit
267 (defcustom gnus-exit-gnus-hook nil
269   :group 'gnus-exit
272 (defcustom gnus-after-exiting-gnus-hook nil
274   :group 'gnus-exit
277 (defcustom gnus-group-update-hook '(gnus-group-highlight-line)
278   "Hook called when a group line is changed.
279 The hook will not be called if `gnus-visual' is nil.
281 The default function `gnus-group-highlight-line' will
282 highlight the line according to the `gnus-group-highlight'
284   :group 'gnus-group-visual
287 (defcustom gnus-useful-groups
289      "gmane.emacs.gnus.general"
293      "gnus.gnus-bug"
294      (nntp "news.gnus.org"
295 	   (nntp-address "news.gnus.org")))
296     ("Local Gnus help group"
297      "gnus-help"
298      (nndoc "gnus-help"
302 				  "gnus-tut.txt" t)))
304 			 (error "Couldn't find doc group"))
306   "*Alist of useful group-server pairs."
307   :group 'gnus-group-listing
312 (defcustom gnus-group-highlight
315      gnus-group-mail-1-empty)
317      gnus-group-mail-1)
319      gnus-group-mail-2-empty)
321      gnus-group-mail-2)
323      gnus-group-mail-3-empty)
325      gnus-group-mail-3)
327      gnus-group-mail-low-empty)
329      gnus-group-mail-low)
332      gnus-group-news-1-empty)
334      gnus-group-news-1)
336      gnus-group-news-2-empty)
338      gnus-group-news-2)
340      gnus-group-news-3-empty)
342      gnus-group-news-3)
344      gnus-group-news-4-empty)
346      gnus-group-news-4)
348      gnus-group-news-5-empty)
350      gnus-group-news-5)
352      gnus-group-news-6-empty)
354      gnus-group-news-6)
356      gnus-group-news-low-empty)
358      gnus-group-news-low))
359   "*Controls the highlighting of group buffer lines.
362 particular group line should be displayed, each form is
364 used.  You can change how those group lines are displayed by
372 group: The name of the group.
373 unread: The number of unread articles in the group.
375 mailp: Whether it's a mail group or not.
376 level: The level of the group.
377 score: The score of the group.
379   :group 'gnus-group-visual
382 (defcustom gnus-new-mail-mark ?%
383   "Mark used for groups with new mail."
384   :group 'gnus-group-visual
387 (defgroup gnus-group-icons nil
388   "Add Icons to your group buffer."
389   :group 'gnus-group-visual)
391 (defcustom gnus-group-icon-list
393   "*Controls the insertion of icons into group buffer lines.
396 particular group line should be displayed, each form is evaluated.
398 can change how those group lines are displayed by editing the file
400 `gnus-group-glyph-directory' or by designating absolute name of the
408 group: The name of the group.
409 unread: The number of unread articles in the group.
411 mailp: Whether it's a mail group or not.
412 newsp: Whether it's a news group or not
413 level: The level of the group.
414 score: The score of the group.
416   :group 'gnus-group-icons
419 (defcustom gnus-group-name-charset-method-alist nil
420   "Alist of method and the charset for group names.
425   :group 'gnus-charset
428 (defcustom gnus-group-name-charset-group-alist
433   "Alist of group regexp and the charset for group names.
437   :group 'gnus-charset
440 (defcustom gnus-group-jump-to-group-prompt nil
441   "Default prompt for `gnus-group-jump-to-group'.
443 in which case `gnus-group-jump-to-group' offers \"Group: nnml:\"
446   :group 'gnus-group-various
450 (defvar gnus-group-listing-limit 1000
451   "*A limit of the number of groups when listing.
452 If the number of groups is larger than the limit, list them in a
457 (defvar gnus-group-is-exiting-p nil)
458 (defvar gnus-group-is-exiting-without-update-p nil)
459 (defvar gnus-group-sort-alist-function 'gnus-group-sort-flat
460   "Function for sorting the group buffer.")
462 (defvar gnus-group-sort-selected-function 'gnus-group-sort-selected-flat
463   "Function for sorting the selected groups in the group buffer.")
465 (defvar gnus-group-indentation-function nil)
466 (defvar gnus-goto-missing-group-function nil)
467 (defvar gnus-group-update-group-function nil)
468 (defvar gnus-group-goto-next-group-function nil
469   "Function to override finding the next group after listing groups.")
471 (defvar gnus-group-edit-buffer nil)
473 (defvar gnus-group-line-format-alist
474   `((?M gnus-tmp-marked-mark ?c)
475     (?S gnus-tmp-subscribed ?c)
476     (?L gnus-tmp-level ?d)
481 		   (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked)))
482 		   (gnus-range-length (cdr (assq 'tick gnus-tmp-marked))))))
484     (?R gnus-tmp-number-of-read ?s)
485     (?U (gnus-number-of-unseen-articles-in-group gnus-tmp-group) ?d)
486     (?t gnus-tmp-number-total ?d)
487     (?y gnus-tmp-number-of-unread ?s)
488     (?I (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked))) ?d)
489     (?T (gnus-range-length (cdr (assq 'tick gnus-tmp-marked))) ?d)
490     (?i (+ (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked)))
491 	   (gnus-range-length (cdr (assq 'tick gnus-tmp-marked)))) ?d)
492     (?g (if (boundp 'gnus-tmp-decoded-group)
493 	    gnus-tmp-decoded-group
494 	  gnus-tmp-group)
496     (?G gnus-tmp-qualified-group ?s)
497     (?c (gnus-short-group-name (if (boundp 'gnus-tmp-decoded-group)
498 				   gnus-tmp-decoded-group
499 				 gnus-tmp-group))
501     (?C gnus-tmp-comment ?s)
502     (?D gnus-tmp-newsgroup-description ?s)
503     (?o gnus-tmp-moderated ?c)
504     (?O gnus-tmp-moderated-string ?s)
505     (?p gnus-tmp-process-marked ?c)
506     (?s gnus-tmp-news-server ?s)
508 	     '(symbol-name gnus-tmp-news-method)
509 	   'gnus-tmp-news-method)
511     (?P gnus-group-indentation ?s)
512     (?E gnus-tmp-group-icon ?s)
513     (?B gnus-tmp-summary-live ?c)
514     (?l gnus-tmp-grouplens ?s)
515     (?z gnus-tmp-news-method-string ?s)
516     (?m (gnus-group-new-mail gnus-tmp-group) ?c)
517     (?d (gnus-group-timestamp-string gnus-tmp-group) ?s)
518     (?u gnus-tmp-user-defined ?s)))
520 (defvar gnus-group-mode-line-format-alist
521   `((?S gnus-tmp-news-server ?s)
522     (?M gnus-tmp-news-method ?s)
523     (?u gnus-tmp-user-defined ?s)
524     (?: gnus-tmp-colon ?s)))
526 (defvar gnus-topic-topology nil
529 (defvar gnus-topic-alist nil
530   "The complete topic-group alist.")
532 (defvar gnus-group-marked nil)
534 (defvar gnus-group-list-mode nil)
537 (defvar gnus-group-icon-cache nil)
539 (defvar gnus-group-listed-groups nil)
540 (defvar gnus-group-list-option nil)
543 ;;; Gnus group mode
546 (put 'gnus-group-mode 'mode-class 'special)
548 (gnus-define-keys gnus-group-mode-map
549   " " gnus-group-read-group
550   "=" gnus-group-select-group
551   "\r" gnus-group-select-group
552   "\M-\r" gnus-group-quick-select-group
553   "\M- " gnus-group-visible-select-group
554   [(meta control return)] gnus-group-select-group-ephemerally
555   "j" gnus-group-jump-to-group
556   "n" gnus-group-next-unread-group
557   "p" gnus-group-prev-unread-group
558   "\177" gnus-group-prev-unread-group
559   [delete] gnus-group-prev-unread-group
560   [backspace] gnus-group-prev-unread-group
561   "N" gnus-group-next-group
562   "P" gnus-group-prev-group
563   "\M-n" gnus-group-next-unread-group-same-level
564   "\M-p" gnus-group-prev-unread-group-same-level
565   "," gnus-group-best-unread-group
566   "." gnus-group-first-unread-group
567   "u" gnus-group-unsubscribe-current-group
568   "U" gnus-group-unsubscribe-group
569   "c" gnus-group-catchup-current
570   "C" gnus-group-catchup-current-all
571   "\M-c" gnus-group-clear-data
572   "l" gnus-group-list-groups
573   "L" gnus-group-list-all-groups
574   "m" gnus-group-mail
575   "i" gnus-group-news
576   "g" gnus-group-get-new-news
577   "\M-g" gnus-group-get-new-news-this-group
578   "R" gnus-group-restart
579   "r" gnus-group-read-init-file
580   "B" gnus-group-browse-foreign-server
581   "b" gnus-group-check-bogus-groups
582   "F" gnus-group-find-new-groups
583   "\C-c\C-d" gnus-group-describe-group
584   "\M-d" gnus-group-describe-all-groups
585   "\C-c\C-a" gnus-group-apropos
586   "\C-c\M-\C-a" gnus-group-description-apropos
587   "a" gnus-group-post-news
588   "\ek" gnus-group-edit-local-kill
589   "\eK" gnus-group-edit-global-kill
590   "\C-k" gnus-group-kill-group
591   "\C-y" gnus-group-yank-group
592   "\C-w" gnus-group-kill-region
593   "\C-x\C-t" gnus-group-transpose-groups
594   "\C-c\C-l" gnus-group-list-killed
595   "\C-c\C-x" gnus-group-expire-articles
596   "\C-c\M-\C-x" gnus-group-expire-all-groups
597   "V" gnus-version
598   "s" gnus-group-save-newsrc
599   "z" gnus-group-suspend
600   "q" gnus-group-exit
601   "Q" gnus-group-quit
602   "?" gnus-group-describe-briefly
603   "\C-c\C-i" gnus-info-find-node
604   "\M-e" gnus-group-edit-group-method
605   "^" gnus-group-enter-server-mode
606   gnus-mouse-2 gnus-mouse-pick-group
610   "\C-c\C-b" gnus-bug
611   "\C-c\C-s" gnus-group-sort-groups
612   "t" gnus-topic-mode
613   "\C-c\M-g" gnus-activate-all-groups
614   "\M-&" gnus-group-universal-argument
615   "#" gnus-group-mark-group
616   "\M-#" gnus-group-unmark-group)
618 (gnus-define-keys (gnus-group-mark-map "M" gnus-group-mode-map)
619   "m" gnus-group-mark-group
620   "u" gnus-group-unmark-group
621   "w" gnus-group-mark-region
622   "b" gnus-group-mark-buffer
623   "r" gnus-group-mark-regexp
624   "U" gnus-group-unmark-all-groups)
626 (gnus-define-keys (gnus-group-sieve-map "D" gnus-group-mode-map)
627   "u" gnus-sieve-update
628   "g" gnus-sieve-generate)
630 (gnus-define-keys (gnus-group-group-map "G" gnus-group-mode-map)
631   "d" gnus-group-make-directory-group
632   "h" gnus-group-make-help-group
633   "u" gnus-group-make-useful-group
634   "a" gnus-group-make-archive-group
635   "k" gnus-group-make-kiboze-group
636   "l" gnus-group-nnimap-edit-acl
637   "m" gnus-group-make-group
638   "E" gnus-group-edit-group
639   "e" gnus-group-edit-group-method
640   "p" gnus-group-edit-group-parameters
641   "v" gnus-group-add-to-virtual
642   "V" gnus-group-make-empty-virtual
643   "D" gnus-group-enter-directory
644   "f" gnus-group-make-doc-group
645   "w" gnus-group-make-web-group
646   "M" gnus-group-read-ephemeral-group
647   "r" gnus-group-rename-group
648   "R" gnus-group-make-rss-group
649   "c" gnus-group-customize
650   "x" gnus-group-nnimap-expunge
651   "\177" gnus-group-delete-group
652   [delete] gnus-group-delete-group)
654 (gnus-define-keys (gnus-group-soup-map "s" gnus-group-group-map)
655   "b" gnus-group-brew-soup
656   "w" gnus-soup-save-areas
657   "s" gnus-soup-send-replies
658   "p" gnus-soup-pack-packet
661 (gnus-define-keys (gnus-group-sort-map "S" gnus-group-group-map)
662   "s" gnus-group-sort-groups
663   "a" gnus-group-sort-groups-by-alphabet
664   "u" gnus-group-sort-groups-by-unread
665   "l" gnus-group-sort-groups-by-level
666   "v" gnus-group-sort-groups-by-score
667   "r" gnus-group-sort-groups-by-rank
668   "m" gnus-group-sort-groups-by-method
669   "n" gnus-group-sort-groups-by-real-name)
671 (gnus-define-keys (gnus-group-sort-selected-map "P" gnus-group-group-map)
672   "s" gnus-group-sort-selected-groups
673   "a" gnus-group-sort-selected-groups-by-alphabet
674   "u" gnus-group-sort-selected-groups-by-unread
675   "l" gnus-group-sort-selected-groups-by-level
676   "v" gnus-group-sort-selected-groups-by-score
677   "r" gnus-group-sort-selected-groups-by-rank
678   "m" gnus-group-sort-selected-groups-by-method
679   "n" gnus-group-sort-selected-groups-by-real-name)
681 (gnus-define-keys (gnus-group-list-map "A" gnus-group-mode-map)
682   "k" gnus-group-list-killed
683   "z" gnus-group-list-zombies
684   "s" gnus-group-list-groups
685   "u" gnus-group-list-all-groups
686   "A" gnus-group-list-active
687   "a" gnus-group-apropos
688   "d" gnus-group-description-apropos
689   "m" gnus-group-list-matching
690   "M" gnus-group-list-all-matching
691   "l" gnus-group-list-level
692   "c" gnus-group-list-cached
693   "?" gnus-group-list-dormant)
695 (gnus-define-keys (gnus-group-list-limit-map "/" gnus-group-list-map)
696   "k"  gnus-group-list-limit
697   "z"  gnus-group-list-limit
698   "s"  gnus-group-list-limit
699   "u"  gnus-group-list-limit
700   "A"  gnus-group-list-limit
701   "m"  gnus-group-list-limit
702   "M"  gnus-group-list-limit
703   "l"  gnus-group-list-limit
704   "c"  gnus-group-list-limit
705   "?"  gnus-group-list-limit)
707 (gnus-define-keys (gnus-group-list-flush-map "f" gnus-group-list-map)
708   "k"  gnus-group-list-flush
709   "z"  gnus-group-list-flush
710   "s"  gnus-group-list-flush
711   "u"  gnus-group-list-flush
712   "A"  gnus-group-list-flush
713   "m"  gnus-group-list-flush
714   "M"  gnus-group-list-flush
715   "l"  gnus-group-list-flush
716   "c"  gnus-group-list-flush
717   "?"  gnus-group-list-flush)
719 (gnus-define-keys (gnus-group-list-plus-map "p" gnus-group-list-map)
720   "k"  gnus-group-list-plus
721   "z"  gnus-group-list-plus
722   "s"  gnus-group-list-plus
723   "u"  gnus-group-list-plus
724   "A"  gnus-group-list-plus
725   "m"  gnus-group-list-plus
726   "M"  gnus-group-list-plus
727   "l"  gnus-group-list-plus
728   "c"  gnus-group-list-plus
729   "?"  gnus-group-list-plus)
731 (gnus-define-keys (gnus-group-score-map "W" gnus-group-mode-map)
732   "f" gnus-score-flush-cache)
734 (gnus-define-keys (gnus-group-help-map "H" gnus-group-mode-map)
735   "c" gnus-group-fetch-charter
736   "C" gnus-group-fetch-control
737   "d" gnus-group-describe-group
738   "f" gnus-group-fetch-faq
739   "v" gnus-version)
741 (gnus-define-keys (gnus-group-sub-map "S" gnus-group-mode-map)
742   "l" gnus-group-set-current-level
743   "t" gnus-group-unsubscribe-current-group
744   "s" gnus-group-unsubscribe-group
745   "k" gnus-group-kill-group
746   "y" gnus-group-yank-group
747   "w" gnus-group-kill-region
748   "\C-k" gnus-group-kill-level
749   "z" gnus-group-kill-all-zombies)
751 (defun gnus-topic-mode-p ()
752   "Return non-nil in `gnus-topic-mode'."
753   (and (boundp 'gnus-topic-mode)
754        (symbol-value 'gnus-topic-mode)))
756 (defun gnus-group-make-menu-bar ()
757   (gnus-turn-off-edit-menu 'group)
758   (unless (boundp 'gnus-group-reading-menu)
761      gnus-group-reading-menu gnus-group-mode-map ""
763        ["Read" gnus-group-read-group
764 	:included (not (gnus-topic-mode-p))
765 	:active (gnus-group-group-name)]
766        ["Read " gnus-topic-read-group
767 	:included (gnus-topic-mode-p)]
768        ["Select" gnus-group-select-group
769 	:included (not (gnus-topic-mode-p))
770 	:active (gnus-group-group-name)]
771        ["Select " gnus-topic-select-group
772 	:included (gnus-topic-mode-p)]
773        ["See old articles" (gnus-group-select-group 'all)
774 	:keys "C-u SPC" :active (gnus-group-group-name)]
775        ["Catch up" gnus-group-catchup-current
776 	:included (not (gnus-topic-mode-p))
777 	:active (gnus-group-group-name)
779 	    '(:help "Mark unread articles in the current group as read"))]
780        ["Catch up " gnus-topic-catchup-articles
781 	:included (gnus-topic-mode-p)
783 	    '(:help "Mark unread articles in the current group or topic as read"))]
784        ["Catch up all articles" gnus-group-catchup-current-all
785 	(gnus-group-group-name)]
786        ["Check for new articles" gnus-group-get-new-news-this-group
787 	:included (not (gnus-topic-mode-p))
788 	:active (gnus-group-group-name)
790 	    '(:help "Check for new messages in current group"))]
791        ["Check for new articles " gnus-topic-get-new-news-this-topic
792 	:included (gnus-topic-mode-p)
794 	    '(:help "Check for new messages in current group or topic"))]
795        ["Toggle subscription" gnus-group-unsubscribe-current-group
796 	(gnus-group-group-name)]
797        ["Kill" gnus-group-kill-group :active (gnus-group-group-name)
799 	      '(:help "Kill (remove) current group"))]
800        ["Yank" gnus-group-yank-group gnus-list-of-killed-groups]
801        ["Describe" gnus-group-describe-group :active (gnus-group-group-name)
803 	    '(:help "Display description of the current group"))]
804        ["Fetch FAQ" gnus-group-fetch-faq (gnus-group-group-name)]
805        ["Fetch charter" gnus-group-fetch-charter
806 	:active (gnus-group-group-name)
808 	    '(:help "Display the charter of the current group"))]
809        ["Fetch control message" gnus-group-fetch-control
810 	:active (gnus-group-group-name)
812 	    '(:help "Display the archived control message for the current group"))]
813        ;; Actually one should check, if any of the marked groups gives t for
814        ;; (gnus-check-backend-function 'request-expire-articles ...)
815        ["Expire articles" gnus-group-expire-articles
816 	:included (not (gnus-topic-mode-p))
817 	:active (or (and (gnus-group-group-name)
818 			 (gnus-check-backend-function
820 			  (gnus-group-group-name))) gnus-group-marked)]
821        ["Expire articles " gnus-topic-expire-articles
822 	:included (gnus-topic-mode-p)]
823        ["Set group level..." gnus-group-set-current-level
824 	(gnus-group-group-name)]
825        ["Select quick" gnus-group-quick-select-group (gnus-group-group-name)]
826        ["Customize" gnus-group-customize (gnus-group-group-name)]
828 	["Parameters" gnus-group-edit-group-parameters
829 	 :included (not (gnus-topic-mode-p))
830 	 :active (gnus-group-group-name)]
831 	["Parameters " gnus-topic-edit-parameters
832 	 :included (gnus-topic-mode-p)]
833 	["Select method" gnus-group-edit-group-method
834 	 (gnus-group-group-name)]
835 	["Info" gnus-group-edit-group (gnus-group-group-name)]
836 	["Local kill file" gnus-group-edit-local-kill (gnus-group-group-name)]
837 	["Global kill file" gnus-group-edit-global-kill t])))
840      gnus-group-group-menu gnus-group-mode-map ""
843 	["List unread subscribed groups" gnus-group-list-groups t]
844 	["List (un)subscribed groups" gnus-group-list-all-groups t]
845 	["List killed groups" gnus-group-list-killed gnus-killed-list]
846 	["List zombie groups" gnus-group-list-zombies gnus-zombie-list]
847 	["List level..." gnus-group-list-level t]
848 	["Describe all groups" gnus-group-describe-all-groups t]
849 	["Group apropos..." gnus-group-apropos t]
850 	["Group and description apropos..." gnus-group-description-apropos t]
851 	["List groups matching..." gnus-group-list-matching t]
852 	["List all groups matching..." gnus-group-list-all-matching t]
853 	["List active file" gnus-group-list-active t]
854 	["List groups with cached" gnus-group-list-cached t]
855 	["List groups with dormant" gnus-group-list-dormant t])
857 	["Default sort" gnus-group-sort-groups t]
858 	["Sort by method" gnus-group-sort-groups-by-method t]
859 	["Sort by rank" gnus-group-sort-groups-by-rank t]
860 	["Sort by score" gnus-group-sort-groups-by-score t]
861 	["Sort by level" gnus-group-sort-groups-by-level t]
862 	["Sort by unread" gnus-group-sort-groups-by-unread t]
863 	["Sort by name" gnus-group-sort-groups-by-alphabet t]
864 	["Sort by real name" gnus-group-sort-groups-by-real-name t])
866 	["Default sort" gnus-group-sort-selected-groups
867 	 (not (gnus-topic-mode-p))]
868 	["Sort by method" gnus-group-sort-selected-groups-by-method
869 	 (not (gnus-topic-mode-p))]
870 	["Sort by rank" gnus-group-sort-selected-groups-by-rank
871 	 (not (gnus-topic-mode-p))]
872 	["Sort by score" gnus-group-sort-selected-groups-by-score
873 	 (not (gnus-topic-mode-p))]
874 	["Sort by level" gnus-group-sort-selected-groups-by-level
875 	 (not (gnus-topic-mode-p))]
876 	["Sort by unread" gnus-group-sort-selected-groups-by-unread
877 	 (not (gnus-topic-mode-p))]
878 	["Sort by name" gnus-group-sort-selected-groups-by-alphabet
879 	 (not (gnus-topic-mode-p))]
880 	["Sort by real name" gnus-group-sort-selected-groups-by-real-name
881 	 (not (gnus-topic-mode-p))])
883 	["Mark group" gnus-group-mark-group
884 	 (and (gnus-group-group-name)
885 	      (not (memq (gnus-group-group-name) gnus-group-marked)))]
886 	["Unmark group" gnus-group-unmark-group
887 	 (and (gnus-group-group-name)
888 	      (memq (gnus-group-group-name) gnus-group-marked))]
889 	["Unmark all" gnus-group-unmark-all-groups gnus-group-marked]
890 	["Mark regexp..." gnus-group-mark-regexp t]
891 	["Mark region" gnus-group-mark-region :active (gnus-mark-active-p)]
892 	["Mark buffer" gnus-group-mark-buffer t]
893 	["Execute command" gnus-group-universal-argument
894 	 (or gnus-group-marked (gnus-group-group-name))])
896 	["Subscribe to a group..." gnus-group-unsubscribe-group t]
897 	["Kill all newsgroups in region" gnus-group-kill-region
898 	 :active (gnus-mark-active-p)]
899 	["Kill all zombie groups" gnus-group-kill-all-zombies
900 	 gnus-zombie-list]
901 	["Kill all groups on level..." gnus-group-kill-level t])
902        ("Foreign groups"
903 	["Make a foreign group..." gnus-group-make-group t]
904 	["Add a directory group..." gnus-group-make-directory-group t]
905 	["Add the help group" gnus-group-make-help-group t]
906 	["Add the archive group" gnus-group-make-archive-group t]
907 	["Make a doc group..." gnus-group-make-doc-group t]
908 	["Make a web group..." gnus-group-make-web-group t]
909 	["Make a kiboze group..." gnus-group-make-kiboze-group t]
910 	["Make a virtual group..." gnus-group-make-empty-virtual t]
911 	["Add a group to a virtual..." gnus-group-add-to-virtual t]
912 	["Make an ephemeral group..." gnus-group-read-ephemeral-group t]
913 	["Make an RSS group..." gnus-group-make-rss-group t]
914 	["Rename group..." gnus-group-rename-group
915 	 (gnus-check-backend-function
916 	  'request-rename-group (gnus-group-group-name))]
917 	["Delete group" gnus-group-delete-group
918 	 (gnus-check-backend-function
919 	  'request-delete-group (gnus-group-group-name))])
921 	["Next" gnus-group-next-group t]
922 	["Previous" gnus-group-prev-group t]
923 	["Next unread" gnus-group-next-unread-group t]
924 	["Previous unread" gnus-group-prev-unread-group t]
925 	["Next unread same level" gnus-group-next-unread-group-same-level t]
927 	 gnus-group-prev-unread-group-same-level t]
928 	["Jump to group..." gnus-group-jump-to-group t]
929 	["First unread group" gnus-group-first-unread-group t]
930 	["Best unread group" gnus-group-best-unread-group t])
932 	["Generate" gnus-sieve-generate t]
933 	["Generate and update" gnus-sieve-update t])
934        ["Delete bogus groups" gnus-group-check-bogus-groups t]
935        ["Find new newsgroups" gnus-group-find-new-groups t]
936        ["Transpose" gnus-group-transpose-groups
937 	(gnus-group-group-name)]
938        ["Read a directory as a group..." gnus-group-enter-directory t]))
941      gnus-group-misc-menu gnus-group-mode-map ""
944 	["Pack replies" nnsoup-pack-replies (fboundp 'nnsoup-request-group)]
945 	["Send replies" gnus-soup-send-replies
946 	 (fboundp 'gnus-soup-pack-packet)]
947 	["Pack packet" gnus-soup-pack-packet (fboundp 'gnus-soup-pack-packet)]
948 	["Save areas" gnus-soup-save-areas (fboundp 'gnus-soup-pack-packet)]
949 	["Brew SOUP" gnus-group-brew-soup (fboundp 'gnus-soup-pack-packet)])
950        ["Send a mail" gnus-group-mail t]
951        ["Send a message (mail or news)" gnus-group-post-news t]
952        ["Create a local message" gnus-group-news t]
953        ["Check for new news" gnus-group-get-new-news
957        ["Send queued messages" gnus-delay-send-queue
961        ["Activate all groups" gnus-activate-all-groups t]
962        ["Restart Gnus" gnus-group-restart t]
963        ["Read init file" gnus-group-read-init-file t]
964        ["Browse foreign server..." gnus-group-browse-foreign-server t]
965        ["Enter server buffer" gnus-group-enter-server-mode t]
966        ["Expire all expirable articles" gnus-group-expire-all-groups t]
967        ["Generate any kiboze groups" nnkiboze-generate-groups t]
968        ["Gnus version" gnus-version t]
969        ["Save .newsrc files" gnus-group-save-newsrc t]
970        ["Suspend Gnus" gnus-group-suspend t]
971        ["Clear dribble buffer" gnus-group-clear-dribble t]
972        ["Read manual" gnus-info-find-node t]
973        ["Flush score cache" gnus-score-flush-cache t]
974        ["Toggle topics" gnus-topic-mode t]
975        ["Send a bug report" gnus-bug t]
976        ["Exit from Gnus" gnus-group-exit
979        ["Exit without saving" gnus-group-quit t]))
981     (gnus-run-hooks 'gnus-group-menu-hook)))
984 (defvar gnus-group-tool-bar-map nil)
986 (defun gnus-group-tool-bar-update (&optional symbol value)
987   "Update group buffer toolbar.
991   ;; (setq-default gnus-group-tool-bar-map nil)
992   ;; (use-local-map gnus-group-mode-map)
993   (when (gnus-alive-p)
994     (with-current-buffer gnus-group-buffer
995       (gnus-group-make-tool-bar t))))
997 (defcustom gnus-group-tool-bar (if (eq gmm-tool-bar-style 'gnome)
998 				   'gnus-group-tool-bar-gnome
999 				 'gnus-group-tool-bar-retro)
1000   "Specifies the Gnus group tool bar.
1004 default key map is `gnus-group-mode-map'.
1006 Pre-defined symbols include `gnus-group-tool-bar-gnome' and
1007 `gnus-group-tool-bar-retro'."
1008   :type '(choice (const :tag "GNOME style" gnus-group-tool-bar-gnome)
1009 		 (const :tag "Retro look" gnus-group-tool-bar-retro)
1014   :set 'gnus-group-tool-bar-update
1015   :group 'gnus-group)
1017 (defcustom gnus-group-tool-bar-gnome
1018   '((gnus-group-post-news "mail/compose")
1021     (gnus-agent-toggle-plugged "disconnect" t
1023      			       :visible (and gnus-agent (not gnus-plugged)))
1024     (gnus-agent-toggle-plugged "connect" t
1026      			       :visible (and gnus-agent gnus-plugged))
1027     ;; FIXME: gnus-agent-toggle-plugged (in gnus-agent-group-make-menu-bar)
1029     (gnus-group-send-queue "mail/outbox" t
1030 			   :visible (and gnus-agent gnus-plugged)
1031 			   :help "Send articles from the queue group")
1032     (gnus-group-get-new-news "mail/inbox" nil
1033 			     :visible (or (not gnus-agent)
1034 					  gnus-plugged))
1035     ;; FIXME: gnus-*-read-group should have a better help text.
1036     (gnus-topic-read-group "open" nil
1037 			   :visible (and (boundp 'gnus-topic-mode)
1038 					 gnus-topic-mode))
1039     (gnus-group-read-group "open" nil
1040 			   :visible (not (and (boundp 'gnus-topic-mode)
1041 					      gnus-topic-mode)))
1042     ;; (gnus-group-find-new-groups "???" nil)
1043     (gnus-group-save-newsrc "save")
1044     (gnus-group-describe-group "describe")
1045     (gnus-group-unsubscribe-current-group "gnus/toggle-subscription")
1046     (gnus-group-prev-unread-group "left-arrow")
1047     (gnus-group-next-unread-group "right-arrow")
1048     (gnus-group-exit "exit")
1050     (gnus-info-find-node "help"))
1051   "List of functions for the group tool bar (GNOME style).
1057   :set 'gnus-group-tool-bar-update
1058   :group 'gnus-group)
1060 (defcustom gnus-group-tool-bar-retro
1061   '((gnus-group-get-new-news "gnus/get-news")
1062     (gnus-group-get-new-news-this-group "gnus/gnntg")
1063     (gnus-group-catchup-current "gnus/catchup")
1064     (gnus-group-describe-group "gnus/describe-group")
1065     (gnus-group-subscribe "gnus/subscribe" t
1066 			  :help "Subscribe to the current group")
1067     (gnus-group-unsubscribe "gnus/unsubscribe" t
1068 			    :help "Unsubscribe from the current group")
1069     (gnus-group-exit "gnus/exit-gnus" gnus-group-mode-map))
1070   "List of functions for the group tool bar (retro look).
1076   :set 'gnus-group-tool-bar-update
1077   :group 'gnus-group)
1079 (defcustom gnus-group-tool-bar-zap-list t
1081 These items are not displayed in the Gnus group mode tool bar.
1087   :set 'gnus-group-tool-bar-update
1088   :group 'gnus-group)
1092 (defun gnus-group-make-tool-bar (&optional force)
1093   "Make a group mode tool bar from `gnus-group-tool-bar'.
1100 	     (or (not gnus-group-tool-bar-map) force))
1102 	    (gmm-image-load-path-for-library "gnus"
1103 					     "gnus/toggle-subscription.xpm"
1108 	   (map (gmm-tool-bar-from-list gnus-group-tool-bar
1109 					gnus-group-tool-bar-zap-list
1110 					'gnus-group-mode-map)))
1113   gnus-group-tool-bar-map)
1115 (defun gnus-group-mode ()
1119 \\<gnus-group-mode-map>
1120 The group buffer lists (some of) the groups available.  For instance,
1121 `\\[gnus-group-list-groups]' will list all subscribed groups with unread articles, while `\\[gnus-group-list-zombies]'
1122 lists all zombie groups.
1124 Groups that are displayed can be entered with `\\[gnus-group-read-group]'.  To subscribe
1125 to a group not displayed, type `\\[gnus-group-unsubscribe-group]'.
1127 For more in-depth information on this mode, read the manual (`\\[gnus-info-find-node]').
1131 \\{gnus-group-mode-map}"
1134   (when (gnus-visual-p 'group-menu 'menu)
1135     (gnus-group-make-menu-bar)
1136     (gnus-group-make-tool-bar))
1137   (gnus-simplify-mode-line)
1138   (setq major-mode 'gnus-group-mode)
1140   (gnus-group-set-mode-line)
1142   (use-local-map gnus-group-mode-map)
1146   (gnus-set-default-directory)
1147   (gnus-update-format-specifications nil 'group 'group-mode)
1148   (gnus-update-group-mark-positions)
1149   (when gnus-use-undo
1150     (gnus-undo-mode 1))
1151   (when gnus-slave
1152     (gnus-slave-mode))
1153   (gnus-run-mode-hooks 'gnus-group-mode-hook))
1155 (defun gnus-update-group-mark-positions ()
1157     (let ((gnus-process-mark ?\200)
1158 	  (gnus-group-update-hook nil)
1159 	  (gnus-group-marked '("dummy.group"))
1160 	  (gnus-active-hashtb (make-vector 10 0))
1162       (gnus-set-active "dummy.group" '(0 . 0))
1163       (gnus-set-work-buffer)
1164       (gnus-group-insert-group-line "dummy.group" 0 nil 0 nil)
1166       (setq gnus-group-mark-positions
1171 (defun gnus-mouse-pick-group (e)
1172   "Enter the group under the mouse pointer."
1175   (gnus-group-read-group nil))
1179 ;; will depend on whether `gnus-group-use-permanent-levels' is used.
1180 (defun gnus-group-default-level (&optional level number-or-nil)
1182    (gnus-group-use-permanent-levels
1183     (or (setq gnus-group-use-permanent-levels
1184 	      (or level (if (numberp gnus-group-use-permanent-levels)
1185 			    gnus-group-use-permanent-levels
1186 			  (or gnus-group-default-list-level
1187 			      gnus-level-subscribed))))
1188 	gnus-group-default-list-level gnus-level-subscribed))
1192     (or level gnus-group-default-list-level gnus-level-subscribed))))
1194 (defun gnus-group-setup-buffer ()
1195   (set-buffer (gnus-get-buffer-create gnus-group-buffer))
1196   (unless (eq major-mode 'gnus-group-mode)
1197     (gnus-group-mode)
1198     (when gnus-carpal
1199       (gnus-carpal-setup-buffer 'group))))
1201 (defun gnus-group-name-charset (method group)
1203       (setq method (gnus-find-method-for-group group)))
1204   (let ((item (assoc method gnus-group-name-charset-method-alist))
1205 	(alist gnus-group-name-charset-group-alist)
1210 	(if (string-match (car item) group)
1215 (defun gnus-group-name-decode (string charset)
1221 (defun gnus-group-decoded-name (string)
1222   (let ((charset (gnus-group-name-charset nil string)))
1223     (gnus-group-name-decode string charset)))
1225 (defun gnus-group-list-groups (&optional level unread lowest)
1227 Default is all subscribed groups.
1228 If argument UNREAD is non-nil, groups with no unread articles are also
1231 Also see the `gnus-group-use-permanent-levels' variable."
1236 	    (gnus-group-default-level nil t)
1237 	    gnus-group-default-list-level
1238 	    gnus-level-subscribed))))
1240     (setq level (car gnus-group-list-mode)
1241 	  unread (cdr gnus-group-list-mode)))
1242   (setq level (gnus-group-default-level level))
1243   (gnus-group-setup-buffer)
1244   (gnus-update-format-specifications nil 'group 'group-mode)
1246 	(props (text-properties-at (gnus-point-at-bol)))
1248 	(group (gnus-group-group-name))
1250     (set-buffer gnus-group-buffer)
1251     (setq number (funcall gnus-group-prepare-function level unread lowest))
1255       ;; No groups in the buffer.
1256       (gnus-message 5 gnus-no-groups-message))
1257     ;; We have some groups displayed.
1259     (when (or (not gnus-group-goto-next-group-function)
1260 	      (not (funcall gnus-group-goto-next-group-function
1261 			    group props)))
1265        ((not group)
1266 	;; Go to the first group with unread articles.
1267 	(gnus-group-search-forward t))
1269 	;; Find the right group to put point on.  If the current group
1273 	(when (not (gnus-goto-char
1276 		     'gnus-group (gnus-intern-safe
1277 				  group gnus-active-hashtb))))
1278 	  (let ((newsrc (cdddr (gnus-gethash group gnus-newsrc-hashtb))))
1280 			(not (gnus-goto-char
1282 			       (point-min) (point-max) 'gnus-group
1283 			       (gnus-intern-safe
1284 				(caar newsrc) gnus-active-hashtb)))))
1290     (gnus-group-position-point)))
1292 (defun gnus-group-list-level (level &optional all)
1293   "List groups on LEVEL.
1294 If ALL (the prefix), also list groups that have no unread articles."
1295   (interactive "nList groups on level: \nP")
1296   (gnus-group-list-groups level all level))
1298 (defun gnus-group-prepare-logic (group test)
1299   (or (and gnus-group-listed-groups
1300 	   (null gnus-group-list-option)
1301 	   (member group gnus-group-listed-groups))
1303        ((null gnus-group-listed-groups) test)
1304        ((null gnus-group-list-option) test)
1305        (t (and (member group gnus-group-listed-groups)
1306 	       (if (eq gnus-group-list-option 'flush)
1310 (defun gnus-group-prepare-flat (level &optional predicate lowest regexp)
1312 If PREDICATE is a function, list groups that the function returns non-nil;
1313 if it is t, list groups that have no unread articles.
1315 If REGEXP is a function, list dead groups that the function returns non-nil;
1316 if it is a string, only list groups matching REGEXP."
1317   (set-buffer gnus-group-buffer)
1319 	(newsrc (cdr gnus-newsrc-alist))
1321 	(not-in-list (and gnus-group-listed-groups
1322 			  (copy-sequence gnus-group-listed-groups)))
1323 	info clevel unread group params)
1325     (when (or (< lowest gnus-level-zombie)
1326 	      gnus-group-listed-groups)
1327       ;; List living groups.
1330 	      group (gnus-info-group info)
1331 	      params (gnus-info-params info)
1333 	      unread (car (gnus-gethash group gnus-newsrc-hashtb)))
1335 	  (setq not-in-list (delete group not-in-list)))
1336 	(when (gnus-group-prepare-logic
1337 	       group
1338 	       (and unread		; This group might be unchecked
1340 			(string-match regexp group))
1341 		    (<= (setq clevel (gnus-info-level info)) level)
1346 		     (predicate t)	; We list all groups?
1350 			   gnus-group-list-inactive-groups
1353 					; We list groups with unread articles
1354 		       (and gnus-list-groups-with-ticked-articles
1355 			    (cdr (assq 'tick (gnus-info-marks info))))
1356 					; And groups with tickeds
1358 		       (and gnus-permanently-visible-groups
1359 			    (string-match gnus-permanently-visible-groups
1360 					  group))
1363 	  (gnus-group-insert-group-line
1364 	   group (gnus-info-level info)
1365 	   (gnus-info-marks info) unread (gnus-info-method info)))))
1367     ;; List dead groups.
1368     (when (or gnus-group-listed-groups
1369 	      (and (>= level gnus-level-zombie)
1370 		   (<= lowest gnus-level-zombie)))
1371       (gnus-group-prepare-flat-list-dead
1372        (setq gnus-zombie-list (sort gnus-zombie-list 'string<))
1373        gnus-level-zombie ?Z
1376       (dolist (group gnus-zombie-list)
1377 	(setq not-in-list (delete group not-in-list))))
1378     (when (or gnus-group-listed-groups
1379 	      (and (>= level gnus-level-killed) (<= lowest gnus-level-killed)))
1380       (gnus-group-prepare-flat-list-dead
1381        (gnus-union
1383 	(setq gnus-killed-list (sort gnus-killed-list 'string<)))
1384        gnus-level-killed ?K regexp))
1386     (gnus-group-set-mode-line)
1387     (setq gnus-group-list-mode (cons level predicate))
1388     (gnus-run-hooks 'gnus-group-prepare-hook)
1391 (defun gnus-group-prepare-flat-list-dead (groups level mark regexp)
1394   ;; this by ignoring the group format specification altogether.
1395   (let (group)
1396     (if (> (length groups) gnus-group-listing-limit)
1397 	(while groups
1398 	  (setq group (pop groups))
1399 	  (when (gnus-group-prepare-logic
1400 		 group
1402 		     (and (stringp regexp) (string-match regexp group))
1403 		     (and (functionp regexp) (funcall regexp group))))
1404 	    (gnus-add-text-properties
1407 			       (gnus-group-decoded-name group)
1409 	     (list 'gnus-group (gnus-intern-safe group gnus-active-hashtb)
1410 		   'gnus-unread t
1411 		   'gnus-level level))))
1412       (while groups
1413 	(setq group (pop groups))
1414 	(when (gnus-group-prepare-logic
1415 	       group
1417 		   (and (stringp regexp) (string-match regexp group))
1418 		   (and (functionp regexp) (funcall regexp group))))
1419 	  (gnus-group-insert-group-line
1420 	   group level nil
1421 	   (let ((active (gnus-active group)))
1427 	   (gnus-method-simplify (gnus-find-method-for-group group))))))))
1429 (defun gnus-group-update-group-line ()
1430   "Update the current line in the group buffer."
1432 	 (group (gnus-group-group-name))
1433 	 (entry (and group (gnus-gethash group gnus-newsrc-hashtb)))
1434 	 gnus-group-indentation)
1435     (when group
1437 	   (not (gnus-ephemeral-group-p group))
1438 	   (gnus-dribble-enter
1439 	    (concat "(gnus-group-set-info '"
1440 		    (gnus-prin1-to-string (nth 2 entry))
1442       (setq gnus-group-indentation (gnus-group-group-indentation))
1443       (gnus-delete-line)
1444       (gnus-group-insert-group-line-info group)
1446       (gnus-group-position-point))))
1448 (defun gnus-group-insert-group-line-info (group)
1450   (let ((entry (gnus-gethash group gnus-newsrc-hashtb))
1451 	(gnus-group-indentation (gnus-group-group-indentation))
1455 	  ;; (Un)subscribed group.
1457 	  (gnus-group-insert-group-line
1458 	   group (gnus-info-level info) (gnus-info-marks info)
1459 	   (or (car entry) t) (gnus-info-method info)))
1460       ;; This group is dead.
1461       (gnus-group-insert-group-line
1462        group
1463        (if (member group gnus-zombie-list) gnus-level-zombie gnus-level-killed)
1465        (if (setq active (gnus-active group))
1470        (gnus-method-simplify (gnus-find-method-for-group group))))))
1472 (defun gnus-number-of-unseen-articles-in-group (group)
1473   (let* ((info (nth 2 (gnus-group-entry group)))
1474 	 (marked (gnus-info-marks info))
1476 	 (active (gnus-active group)))
1479       (length (gnus-uncompress-range
1480 	       (gnus-range-difference
1481 		(gnus-range-difference (list active) (gnus-info-read info))
1485 ;; update the state (enabled/disabled) of the icon `gnus-group-describe-group'
1495 (defcustom gnus-group-update-tool-bar
1499        ;; Using `redraw-frame' (see `gnus-tool-bar-update') in Emacs 21 might
1502   "Force updating the group buffer tool bar."
1503   :group 'gnus-group
1508 	 (when (gnus-alive-p)
1509 	   (with-current-buffer gnus-group-buffer
1510 	     ;; FIXME: Is there a better way to redraw the group buffer?
1511 	     (gnus-group-get-new-news 0))))
1514 (defun gnus-group-insert-group-line (gnus-tmp-group gnus-tmp-level
1515 						    gnus-tmp-marked number
1516 						    gnus-tmp-method)
1517   "Insert a group line in the group buffer."
1518   (let* ((gnus-tmp-method
1519 	  (gnus-server-get-method gnus-tmp-group gnus-tmp-method))
1520 	 (group-name-charset (gnus-group-name-charset gnus-tmp-method
1521 						      gnus-tmp-group))
1522 	 (gnus-tmp-active (gnus-active gnus-tmp-group))
1523 	 (gnus-tmp-number-total
1524 	  (if gnus-tmp-active
1525 	      (1+ (- (cdr gnus-tmp-active) (car gnus-tmp-active)))
1527 	 (gnus-tmp-number-of-unread
1530 	 (gnus-tmp-number-of-read
1532 	      (int-to-string (max 0 (- gnus-tmp-number-total number)))
1534 	 (gnus-tmp-subscribed
1535 	  (cond ((<= gnus-tmp-level gnus-level-subscribed) ? )
1536 		((<= gnus-tmp-level gnus-level-unsubscribed) ?U)
1537 		((= gnus-tmp-level gnus-level-zombie) ?Z)
1539 	 (gnus-tmp-qualified-group
1540 	  (gnus-group-name-decode (gnus-group-real-name gnus-tmp-group)
1541 				  group-name-charset))
1542 	 (gnus-tmp-comment
1543 	  (or (gnus-group-get-parameter gnus-tmp-group 'comment t)
1544 	      gnus-tmp-group))
1545 	 (gnus-tmp-newsgroup-description
1546 	  (if gnus-description-hashtb
1547 	      (or (gnus-group-name-decode
1548 		   (gnus-gethash gnus-tmp-group gnus-description-hashtb)
1549 		   group-name-charset) "")
1551 	 (gnus-tmp-moderated
1552 	  (if (and gnus-moderated-hashtb
1553 		   (gnus-gethash gnus-tmp-group gnus-moderated-hashtb))
1555 	 (gnus-tmp-moderated-string
1556 	  (if (eq gnus-tmp-moderated ?m) "(m)" ""))
1557 	 (gnus-tmp-group-icon "==&&==")
1558 	 (gnus-tmp-news-server (or (cadr gnus-tmp-method) ""))
1559 	 (gnus-tmp-news-method (or (car gnus-tmp-method) ""))
1560 	 (gnus-tmp-news-method-string
1561 	  (if gnus-tmp-method
1562 	      (format "(%s:%s)" (car gnus-tmp-method)
1563 		      (cadr gnus-tmp-method)) ""))
1564 	 (gnus-tmp-marked-mark
1567 		   (cdr (assq 'tick gnus-tmp-marked)))
1569 	 (gnus-tmp-summary-live
1570 	  (if (and (not gnus-group-is-exiting-p)
1571 		   (gnus-buffer-live-p (gnus-summary-buffer-name
1572 					gnus-tmp-group)))
1574 	 (gnus-tmp-process-marked
1575 	  (if (member gnus-tmp-group gnus-group-marked)
1576 	      gnus-process-mark ? ))
1577 	 (gnus-tmp-grouplens
1578 	  (or (and gnus-use-grouplens
1579 		   (bbb-grouplens-group-p gnus-tmp-group))
1583 	 header gnus-tmp-header)	; passed as parameter to user-funcs.
1586     (gnus-add-text-properties
1590        (let ((gnus-tmp-decoded-group (gnus-group-name-decode
1591 				      gnus-tmp-group group-name-charset)))
1592 	 (eval gnus-group-line-format-spec)))
1593      `(gnus-group ,(gnus-intern-safe gnus-tmp-group gnus-active-hashtb)
1594 		  gnus-unread ,(if (numberp number)
1595 				   (string-to-number gnus-tmp-number-of-unread)
1597 		  gnus-marked ,gnus-tmp-marked-mark
1598 		  gnus-indentation ,gnus-group-indentation
1599 		  gnus-level ,gnus-tmp-level))
1601     (when gnus-group-update-tool-bar
1602       (gnus-put-text-property beg end 'point-entered
1603 			      'gnus-tool-bar-update)
1604       (gnus-put-text-property beg end 'point-left
1605 			      'gnus-tool-bar-update))
1607     (when (inline (gnus-visual-p 'group-highlight 'highlight))
1608       (gnus-run-hooks 'gnus-group-update-hook))
1611     (gnus-group-remove-excess-properties)))
1613 (defun gnus-group-highlight-line ()
1614   "Highlight the current line according to `gnus-group-highlight'."
1615   (let* ((list gnus-group-highlight)
1617 	 (end (gnus-point-at-eol))
1620 	 (group (gnus-group-group-name))
1621 	 (entry (gnus-group-entry group))
1623 	 (active (gnus-active group))
1626 	 (method (inline (gnus-server-get-method group (gnus-info-method info))))
1627 	 (marked (gnus-info-marks info))
1632 					  (car (or method gnus-select-method)))
1633 					 gnus-valid-select-methods)))
1635 	 (level (or (gnus-info-level info) gnus-level-killed))
1636 	 (score (or (gnus-info-score info) 0))
1637 	 (ticked (gnus-range-length (cdr (assq 'tick marked))))
1638 	 (group-age (gnus-group-timestamp-delta group))
1646 	(gnus-put-text-property-excluding-characters-with-faces
1649 	(gnus-extent-start-open beg)))
1652 (defun gnus-group-update-group (group &optional visible-only)
1654 If VISIBLE-ONLY is non-nil, the group won't be displayed if it isn't
1659     (set-buffer gnus-group-buffer)
1664       (let ((ident (gnus-intern-safe group gnus-active-hashtb))
1668 	(let ((entry (gnus-gethash group gnus-newsrc-hashtb)))
1670 		     (not (gnus-ephemeral-group-p group)))
1671 	    (gnus-dribble-enter
1672 	     (concat "(gnus-group-set-info '"
1673 		     (gnus-prin1-to-string (nth 2 entry))
1675 	;; Find all group instances.  If topics are in use, each group
1678 			  loc (point-max) 'gnus-group ident))
1681 	  (let ((gnus-group-indentation (gnus-group-group-indentation)))
1682 	    (gnus-delete-line)
1683 	    (gnus-group-insert-group-line-info group)
1686 	      (gnus-run-hooks 'gnus-group-update-group-hook)))
1691 	  (if gnus-goto-missing-group-function
1692 	      (funcall gnus-goto-missing-group-function group)
1693 	    (let ((entry (cddr (gnus-gethash group gnus-newsrc-hashtb))))
1696 			   (gnus-goto-char
1699 			     'gnus-group (gnus-intern-safe
1700 					  (caar entry) gnus-active-hashtb)))))
1704 	  (let ((gnus-group-indentation (gnus-group-group-indentation)))
1705 	    (gnus-group-insert-group-line-info group)
1708 	      (gnus-run-hooks 'gnus-group-update-group-hook))))
1709 	(when gnus-group-update-group-function
1710 	  (funcall gnus-group-update-group-function group))
1711 	(gnus-group-set-mode-line)))
1716 (defun gnus-group-set-mode-line ()
1717   "Update the mode line in the group buffer."
1718   (when (memq 'group gnus-updated-mode-lines)
1721       (set-buffer gnus-group-buffer)
1722       (let* ((gformat (or gnus-group-mode-line-format-spec
1723 			  (gnus-set-format 'group-mode)))
1724 	     (gnus-tmp-news-server (cadr gnus-select-method))
1725 	     (gnus-tmp-news-method (car gnus-select-method))
1726 	     (gnus-tmp-colon (if (equal gnus-tmp-news-server "") "" ":"))
1728 	     gnus-tmp-header		;Dummy binding for user-defined formats
1731 	      (and gnus-dribble-buffer
1732 		   (buffer-name gnus-dribble-buffer)
1733 		   (buffer-modified-p gnus-dribble-buffer)
1735 		     (set-buffer gnus-dribble-buffer)
1740 	      (if modified (car gnus-mode-line-modified)
1741 		(cdr gnus-mode-line-modified)))
1747 		  (gnus-mode-line-buffer-identification
1751 (defun gnus-group-group-name ()
1753   (let ((group (get-text-property (gnus-point-at-bol) 'gnus-group)))
1754     (when group
1755       (symbol-name group))))
1757 (defun gnus-group-group-level ()
1759   (get-text-property (gnus-point-at-bol) 'gnus-level))
1761 (defun gnus-group-group-indentation ()
1763   (or (get-text-property (gnus-point-at-bol) 'gnus-indentation)
1764       (and gnus-group-indentation-function
1765 	   (funcall gnus-group-indentation-function))
1768 (defun gnus-group-group-unread ()
1770   (get-text-property (gnus-point-at-bol) 'gnus-unread))
1772 (defun gnus-group-new-mail (group)
1773   (if (nnmail-new-mail-p (gnus-group-real-name group))
1774       gnus-new-mail-mark
1777 (defun gnus-group-level (group)
1779   (or (gnus-info-level (gnus-get-info group))
1780       (and (member group gnus-zombie-list) gnus-level-zombie)
1781       gnus-level-killed))
1783 (defun gnus-group-search-forward (&optional backward all level first-too)
1787 If LEVEL is non-nil, find group with level LEVEL, or higher if no such
1788 group exists.
1791 	(low gnus-level-killed)
1803 		     (get-text-property (point) 'gnus-group)
1807 				 (get-text-property (point) 'gnus-unread)))
1810 						       'gnus-level))
1811 			  (<= lev gnus-level-subscribed)))
1814 							   'gnus-level))
1824 	(progn (gnus-group-position-point) t)
1828 ;;; Gnus group mode commands
1832 (defun gnus-group-mark-line-p ()
1835     (forward-char (or (cdr (assq 'process gnus-group-mark-positions)) 2))
1836     (eq (char-after) gnus-process-mark)))
1838 (defun gnus-group-mark-group (n &optional unmark no-advance)
1839   "Mark the current group."
1842 	group)
1845       (when (setq group (gnus-group-group-name))
1848 	(forward-char (or (cdr (assq 'process gnus-group-mark-positions)) 2))
1853 	       (setq gnus-group-marked (delete group gnus-group-marked))
1855 	   (setq gnus-group-marked
1856 		 (cons group (delete group gnus-group-marked)))
1857 	   gnus-process-mark)))
1859 	(gnus-group-next-group 1))
1861     (gnus-summary-position-point)
1864 (defun gnus-group-unmark-group (n)
1865   "Remove the mark from the current group."
1867   (gnus-group-mark-group n 'unmark)
1868   (gnus-group-position-point))
1870 (defun gnus-group-unmark-all-groups ()
1871   "Unmark all groups."
1873   (let ((groups gnus-group-marked))
1875       (while groups
1876 	(gnus-group-remove-mark (pop groups)))))
1877   (gnus-group-position-point))
1879 (defun gnus-group-mark-region (unmark beg end)
1880   "Mark all groups between point and mark.
1886       (- num (gnus-group-mark-group num unmark)))))
1888 (defun gnus-group-mark-buffer (&optional unmark)
1889   "Mark all groups in the buffer.
1892   (gnus-group-mark-region unmark (point-min) (point-max)))
1894 (defun gnus-group-mark-regexp (regexp)
1895   "Mark all groups that match some regexp."
1897   (let ((alist (cdr gnus-newsrc-alist))
1898 	group)
1901 	(when (string-match regexp (setq group (gnus-info-group (pop alist))))
1902 	  (gnus-group-jump-to-group group)
1903 	  (gnus-group-set-mark group)))))
1904   (gnus-group-position-point))
1906 (defun gnus-group-remove-mark (group &optional test-marked)
1908 Return nil if the group isn't displayed."
1909   (if (gnus-group-goto-group group nil test-marked)
1911 	(gnus-group-mark-group 1 'unmark t)
1913     (setq gnus-group-marked
1914 	  (delete group gnus-group-marked))
1917 (defun gnus-group-set-mark (group)
1919   (if (gnus-group-goto-group group)
1921 	(gnus-group-mark-group 1 nil t))
1922     (setq gnus-group-marked (cons group (delete group gnus-group-marked)))))
1924 (defun gnus-group-universal-argument (arg &optional groups func)
1925   "Perform any command on all groups according to the process/prefix convention."
1931 			    "\\<gnus-group-mode-map>\\[gnus-group-universal-argument]")))))
1933       (gnus-error 1 "Undefined key")
1934     (gnus-group-iterate arg
1935       (lambda (group)
1937   (gnus-group-position-point))
1939 (defun gnus-group-process-prefix (n)
1940   "Return a list of groups to work on.
1941 Take into consideration N (the prefix) and the list of marked groups."
1946     ;; groups.
1949 	  group groups)
1952 	  (if (setq group (gnus-group-group-name))
1953 	      (push group groups))
1955 	  (gnus-group-next-group way)))
1956       (nreverse groups)))
1957    ((and (gnus-region-active-p) (mark))
1960 	  groups)
1965 	     (push (gnus-group-group-name) groups)
1966 	     (zerop (gnus-group-next-group 1))
1968 	(nreverse groups))))
1969    (gnus-group-marked
1971     (reverse gnus-group-marked))
1974     ;; current group.
1975     (let ((group (gnus-group-group-name)))
1976       (and group (list group))))))
1978 ;;; !!!Surely gnus-group-iterate should be a macro instead?  I can't
1981   (let ((function (make-symbol "gnus-group-iterate-function"))
1982 	(window (make-symbol "gnus-group-iterate-window"))
1983 	(groups (make-symbol "gnus-group-iterate-groups"))
1984 	(group (make-symbol "gnus-group-iterate-group")))
1986      `(defun gnus-group-iterate (arg ,function)
1987 	"Iterate FUNCTION over all process/prefixed groups.
1988 FUNCTION will be called with the group name as the parameter
1989 and with point over the group in question."
1990 	(let ((,groups (gnus-group-process-prefix arg))
1992 	      ,group)
1993 	  (while ,groups
1994 	    (setq ,group (car ,groups)
1995 		  ,groups (cdr ,groups))
1997 	    (gnus-group-remove-mark ,group)
2000 		(funcall ,function ,group)))))))))
2002 (put 'gnus-group-iterate 'lisp-indent-function 1)
2004 ;; Selecting groups.
2006 (defun gnus-group-read-group (&optional all no-article group select-articles)
2011 auto-selected upon group entry.  If GROUP is non-nil, fetch that
2012 group."
2015 	(group (or group (gnus-group-group-name)))
2019     (unless group
2020       (error "No group on current line"))
2021     (setq marked (gnus-info-marks
2022 		  (nth 2 (setq entry (gnus-gethash
2023 				      group gnus-newsrc-hashtb)))))
2024     ;; This group might be a dead group.  In that case we have to get
2025     ;; the number of unread articles from `gnus-active-hashtb'.
2029 		((setq active (gnus-active group))
2031     (gnus-summary-read-group
2032      group (or all (and (numberp number)
2033 			(zerop (+ number (gnus-range-length
2035 				  (gnus-range-length
2039 (defun gnus-group-select-group (&optional all)
2042 If the group is opened, just switch the summary buffer.
2045 articles in the group.
2047 articles in the group."
2049   (when (and (eobp) (not (gnus-group-group-name)))
2051   (gnus-group-read-group all t))
2053 (defun gnus-group-quick-select-group (&optional all)
2054   "Select the current group \"quickly\".
2060 before entering the group."
2062   (require 'gnus-score)
2063   (let (gnus-visual
2064 	gnus-score-find-score-files-function
2065 	gnus-home-score-file
2066 	gnus-apply-kill-hook
2067 	gnus-summary-expunge-below)
2068     (gnus-group-read-group all t)))
2070 (defun gnus-group-visible-select-group (&optional all)
2071   "Select the current group without hiding any articles."
2073   (let ((gnus-inhibit-limiting t))
2074     (gnus-group-read-group all t)))
2076 (defun gnus-group-select-group-ephemerally ()
2077   "Select the current group without doing any processing whatsoever.
2078 You will actually be entered into a group that's a copy of
2079 the current group; no changes you make while in this group will
2082   (require 'gnus-score)
2083   (let* (gnus-visual
2084 	 gnus-score-find-score-files-function gnus-apply-kill-hook
2085 	 gnus-summary-expunge-below gnus-show-threads gnus-suppress-duplicates
2086 	 gnus-summary-mode-hook gnus-select-group-hook
2087 	 (group (gnus-group-group-name))
2088 	 (method (gnus-find-method-for-group group)))
2089     (gnus-group-read-ephemeral-group
2090      (gnus-group-prefixed-name group method) method)))
2093 (defun gnus-fetch-group (group &optional articles)
2096   (interactive (list (completing-read "Group name: " gnus-active-hashtb)))
2097   (unless (get-buffer gnus-group-buffer)
2098     (gnus-no-server))
2099   (gnus-group-read-group articles nil group))
2102 (defun gnus-fetch-group-other-frame (group)
2105   (let ((window (get-buffer-window gnus-group-buffer)))
2112   (gnus-fetch-group group))
2114 (defvar gnus-ephemeral-group-server 0)
2116 (defcustom gnus-large-ephemeral-newsgroup 200
2118 Same as `gnus-large-newsgroup', but only used for ephemeral newsgroups.
2124   :group 'gnus-group-select
2128 (defcustom gnus-fetch-old-ephemeral-headers nil
2129   "Same as `gnus-fetch-old-headers', but only used for ephemeral newsgroups."
2131   :group 'gnus-thread
2137 ;; Enter a group that is not in the group buffer.  Non-nil is returned
2139 (defun gnus-group-read-ephemeral-group (group method &optional activate
2144   "Read GROUP from METHOD as an ephemeral group.
2145 If ACTIVATE, request the group first.
2147 ephemeral group.
2148 If REQUEST-ONLY, don't actually read the group; just request it.
2150 If PARAMETERS, use those as the group parameters.
2153 Return the name of the group if selection was successful."
2156     ;; (gnus-read-group "Group name: ")
2158      "Group: " gnus-active-hashtb
2160      'gnus-group-history)
2161     (gnus-read-method "From method: ")))
2164     (setq method (gnus-server-to-method method)))
2169   (let ((group (if (gnus-group-foreign-p group) group
2170 		 (gnus-group-prefixed-name (gnus-group-real-name group)
2172     (gnus-sethash
2173      group
2174      `(-1 nil (,group
2175 	       ,gnus-level-default-subscribed nil nil ,method
2180 			 (cons gnus-summary-buffer
2181 			       gnus-current-window-configuration)))
2183      gnus-newsrc-hashtb)
2184     (push method gnus-ephemeral-servers)
2185     (set-buffer gnus-group-buffer)
2186     (unless (gnus-check-server method)
2187       (error "Unable to contact server: %s" (gnus-status-message method)))
2189       (gnus-activate-group group 'scan)
2190       (unless (gnus-request-group group)
2191 	(error "Couldn't request group: %s"
2194 	group
2196 	  (when (let ((gnus-large-newsgroup gnus-large-ephemeral-newsgroup)
2197 		      (gnus-fetch-old-headers
2198 		       gnus-fetch-old-ephemeral-headers))
2199 		  (gnus-group-read-group (or number t) t group select-articles))
2200 	    group)
2203 	 (message "Quit reading the ephemeral group")
2206 (defun gnus-group-jump-to-group (group)
2211 	   "Group: " gnus-active-hashtb nil
2212 	   (gnus-read-active-file-p)
2213 	   gnus-group-jump-to-group-prompt
2214 	   'gnus-group-history))))
2216   (when (equal group "")
2217     (error "Empty group name"))
2219   (unless (gnus-ephemeral-group-p group)
2220     ;; Either go to the line in the group buffer...
2221     (unless (gnus-group-goto-group group)
2223       (gnus-group-update-group group)
2224       (gnus-group-goto-group group)))
2226   (gnus-group-position-point))
2228 (defun gnus-group-goto-group (group &optional far test-marked)
2230 If FAR, it is likely that the group is not on the current line.
2232   (when group
2238 	   (eq (get-text-property (point) 'gnus-group)
2239 	       (gnus-intern-safe group gnus-active-hashtb))
2240 	   (or (not test-marked) (gnus-group-mark-line-p)))
2246 	     (and (eq (get-text-property (point) 'gnus-group)
2247 		      (gnus-intern-safe group gnus-active-hashtb))
2248 		  (or (not test-marked) (gnus-group-mark-line-p)))))
2254 	     (and (eq (get-text-property (point) 'gnus-group)
2255 		      (gnus-intern-safe group gnus-active-hashtb))
2256 		  (or (not test-marked) (gnus-group-mark-line-p)))))
2263 		    (gnus-goto-char
2266 		      'gnus-group
2267 		      (gnus-intern-safe group gnus-active-hashtb))))
2268 	  (if (gnus-group-mark-line-p)
2274       (gnus-goto-char
2277 	'gnus-group (gnus-intern-safe group gnus-active-hashtb)))))))
2279 (defun gnus-group-next-group (n &optional silent)
2285   (gnus-group-next-unread-group n t nil silent))
2287 (defun gnus-group-next-unread-group (n &optional all level silent)
2291 If LEVEL is non-nil, choose the next group with level LEVEL, or, if no
2292 such group can be found, the next group with a level higher than
2300 		(gnus-group-search-forward
2301 		 backward (or (not gnus-group-goto-unread) all) level))
2305       (gnus-message 7 "No more%s newsgroups%s" (if all "" " unread")
2309 (defun gnus-group-prev-group (n)
2314   (gnus-group-next-unread-group (- n) t))
2316 (defun gnus-group-prev-unread-group (n)
2321   (gnus-group-next-unread-group (- n)))
2323 (defun gnus-group-next-unread-group-same-level (n)
2329   (gnus-group-next-unread-group n t (gnus-group-group-level))
2330   (gnus-group-position-point))
2332 (defun gnus-group-prev-unread-group-same-level (n)
2337   (gnus-group-next-unread-group (- n) t (gnus-group-group-level))
2338   (gnus-group-position-point))
2340 (defun gnus-group-best-unread-group (&optional exclude-group)
2341   "Go to the group with the highest level.
2342 If EXCLUDE-GROUP, do not go to that group."
2348       (setq unread (get-text-property (point) 'gnus-unread))
2350 	(when (and (get-text-property (point) 'gnus-level)
2351 		   (< (get-text-property (point) 'gnus-level) best)
2352 		   (or (not exclude-group)
2353 		       (not (equal exclude-group (gnus-group-group-name)))))
2354 	  (setq best (get-text-property (point) 'gnus-level))
2359     (gnus-group-position-point)
2360     (and best-point (gnus-group-group-name))))
2362 (defun gnus-group-first-unread-group ()
2363   "Go to the first group with unread articles."
2369 	(if (or (eq (setq unread (gnus-group-group-unread)) t) ; Not active.
2372 		(zerop (gnus-group-next-unread-group 1))) ; Next unread group.
2376     (gnus-group-position-point)))
2378 (defun gnus-group-enter-server-mode ()
2381   (gnus-enter-server-buffer))
2383 (defun gnus-group-make-group (name &optional method address args)
2389     (gnus-read-group "Group name: ")
2390     (gnus-read-method "From method: ")))
2393     (setq method (or (gnus-server-to-method method) method)))
2394   (let* ((meth (gnus-method-simplify
2396 			   (not (gnus-server-equal method gnus-select-method)))
2399 	 (nname (if method (gnus-group-prefixed-name name meth) name))
2401     (when (gnus-gethash nname gnus-newsrc-hashtb)
2402       (error "Group %s already exists" (gnus-group-decoded-name nname)))
2403     ;; Subscribe to the new group.
2404     (gnus-group-change-level
2405      (setq info (list t nname gnus-level-default-subscribed nil nil meth))
2406      gnus-level-default-subscribed gnus-level-killed
2407      (and (gnus-group-group-name)
2408 	  (gnus-gethash (gnus-group-group-name)
2409 			gnus-newsrc-hashtb))
2412     (gnus-set-active nname (cons 1 0))
2413     (unless (gnus-ephemeral-group-p name)
2414       (gnus-dribble-enter
2415        (concat "(gnus-group-set-info '"
2416 	       (gnus-prin1-to-string (cdr info)) ")")))
2418     (gnus-group-insert-group-line-info nname)
2420     (gnus-group-position-point)
2423     ;; the group as well.
2424     (when (assoc (symbol-name (setq backend (car (gnus-server-get-method
2426 		 gnus-valid-select-methods)
2428     (gnus-check-server meth)
2429     (when (gnus-check-backend-function 'request-create-group nname)
2430       (unless (gnus-request-create-group nname nil args)
2431 	(error "Could not create group on server: %s"
2435 (defun gnus-group-delete-groups (&optional arg)
2436   "Delete the current group.  Only meaningful with editable groups."
2438   (let ((n (length (gnus-group-process-prefix arg))))
2439     (when (gnus-yes-or-no-p
2441 	       "Delete this 1 group? "
2442 	     (format "Delete these %d groups? " n)))
2443       (gnus-group-iterate arg
2444 	(lambda (group)
2445 	  (gnus-group-delete-group group nil t))))))
2447 (defun gnus-group-delete-group (group &optional force no-prompt)
2448   "Delete the current group.  Only meaningful with editable groups.
2449 If FORCE (the prefix) is non-nil, all the articles in the group will
2453 Note that you also have to specify FORCE if you want the group to
2456    (list (gnus-group-group-name)
2458   (unless group
2459     (error "No group to delete"))
2460   (unless (gnus-check-backend-function 'request-delete-group group)
2461     (error "This back end does not support group deletion"))
2463       (let ((group-decoded (gnus-group-decoded-name group)))
2465 		 (not (gnus-yes-or-no-p
2468 			group-decoded (if force " and all its contents" "")))))
2470 	  (gnus-message 6 "Deleting group %s..." group-decoded)
2471 	  (if (not (gnus-request-delete-group group force))
2472 	      (gnus-error 3 "Couldn't delete group %s" group-decoded)
2473 	    (gnus-message 6 "Deleting group %s...done" group-decoded)
2474 	    (gnus-group-goto-group group)
2475 	    (gnus-group-kill-group 1 t)
2476 	    (gnus-sethash group nil gnus-active-hashtb)
2478     (gnus-group-position-point)))
2480 (defun gnus-group-rename-group (group new-name)
2481   "Rename group from GROUP to NEW-NAME.
2482 When used interactively, GROUP is the group under point
2486     (gnus-group-group-name)
2488       (unless (gnus-check-backend-function
2489 	       'request-rename-group (gnus-group-group-name))
2490 	(error "This back end does not support renaming groups"))
2491       (gnus-read-group "Rename group to: "
2492 		       (gnus-group-real-name (gnus-group-group-name))))))
2494   (unless (gnus-check-backend-function 'request-rename-group group)
2495     (error "This back end does not support renaming groups"))
2496   (unless group
2497     (error "No group to rename"))
2498   (when (equal (gnus-group-real-name group) new-name)
2503 	(if (gnus-group-native-p group)
2504 	    ;; Native group.
2506 	  ;; Foreign group.
2507 	  (gnus-group-prefixed-name
2508 	   (gnus-group-real-name new-name)
2509 	   (gnus-info-method (gnus-get-info group)))))
2511   (when (gnus-active new-name)
2512     (error "The group %s already exists" new-name))
2514   (gnus-message 6 "Renaming group %s to %s..." group new-name)
2517 	    (gnus-group-goto-group group)
2518 	    (not (when (< (gnus-group-group-level) gnus-level-zombie)
2519 		   (gnus-request-rename-group group new-name))))
2520 	  (gnus-error 3 "Couldn't rename group %s to %s" group new-name)
2521 	;; We rename the group internally by killing it...
2522 	(gnus-group-kill-group)
2524 	(setcar (cdar gnus-list-of-killed-groups) new-name)
2526 	(gnus-group-yank-group)
2527 	(gnus-set-active new-name (gnus-active group))
2528 	(gnus-message 6 "Renaming group %s to %s...done" group new-name)
2530     (setq gnus-killed-list (delete group gnus-killed-list))
2531     (gnus-set-active group nil)
2532     (gnus-dribble-touch)
2533     (gnus-group-position-point)))
2535 (defun gnus-group-edit-group (group &optional part)
2536   "Edit the group on the current line."
2537   (interactive (list (gnus-group-group-name)))
2540     (unless group
2541       (error "No group on current line"))
2542     (unless (setq info (gnus-get-info group))
2543       (error "Killed group; can't be edited"))
2545       (gnus-close-group group))
2546     (gnus-edit-form
2549 	    (or (gnus-info-method info) "native"))
2551 	    (gnus-info-params info))
2558        ((eq part 'params) "group parameters")
2559        (t "group info"))
2560       (gnus-group-decoded-name group))
2562 	(gnus-group-edit-group-done ',part ,group form)))
2565      (gnus-create-info-command
2568 	"(gnus)Select Methods")
2570 	"(gnus)Group Parameters")
2572 	"(gnus)Group Info"))))))
2574 (defun gnus-group-edit-group-method (group)
2576   (interactive (list (gnus-group-group-name)))
2577   (gnus-group-edit-group group 'method))
2579 (defun gnus-group-edit-group-parameters (group)
2580   "Edit the group parameters of GROUP."
2581   (interactive (list (gnus-group-group-name)))
2582   (gnus-group-edit-group group 'params))
2584 (defun gnus-group-edit-group-done (part group form)
2590 		     ((eq part 'method) (gnus-get-info group))
2592 	 (new-group (if info
2594 				(gnus-server-equal
2595 				 gnus-select-method method))
2596 			    (gnus-group-real-name (car info))
2597 			  (gnus-group-prefixed-name
2598 			   (gnus-group-real-name (car info)) method))
2600     (when (and new-group
2601 	       (not (equal new-group group)))
2602       (when (gnus-group-goto-group group)
2603 	(gnus-group-kill-group 1))
2604       (gnus-activate-group new-group))
2606     (if (not (and info new-group))
2607 	(gnus-group-set-info form (or new-group group) part)
2608       (setq info (gnus-copy-sequence info))
2609       (setcar info new-group)
2610       (unless (gnus-server-equal method "native")
2615 	(gnus-info-set-method info method))
2616       (gnus-group-set-info info))
2617     (gnus-group-update-group (or new-group group))
2618     (gnus-group-position-point)))
2620 (defun gnus-group-make-useful-group (group method)
2621   "Create one of the groups described in `gnus-useful-groups'."
2623    (let ((entry (assoc (completing-read "Create group: " gnus-useful-groups
2625 		       gnus-useful-groups)))
2627   (setq method (gnus-copy-sequence method))
2631   (gnus-group-make-group group method))
2633 (defun gnus-group-make-help-group (&optional noerror)
2634   "Create the Gnus documentation group.
2636 group already exists:
2641   (let ((name (gnus-group-prefixed-name "gnus-help" '(nndoc "gnus-help")))
2642 	(file (nnheader-find-etc-directory "gnus-tut.txt" t)))
2643     (if (gnus-gethash name gnus-newsrc-hashtb)
2645 	       (error "Documentation group already exists"))
2650 	       (gnus-message 1 "Documentation group already exists")))
2653 	  (gnus-message 1 "Couldn't find doc group")
2654 	(gnus-group-make-group
2655 	 (gnus-group-real-name name)
2656 	 (list 'nndoc "gnus-help"
2660   (gnus-group-position-point))
2662 (defun gnus-group-make-doc-group (file type)
2663   "Create a group that uses a single file as the source.
2686   (let ((name (gnus-generate-new-group-name
2687 	       (gnus-group-prefixed-name
2690     (gnus-group-make-group
2692 	 (mm-encode-coding-string (gnus-group-real-name name) 'utf-8)
2693        (gnus-group-real-name name))
2701 (defvar gnus-group-web-type-history nil)
2702 (defvar gnus-group-web-search-history nil)
2703 (defun gnus-group-make-web-group (&optional solid)
2704   "Create an ephemeral nnweb group.
2705 If SOLID (the prefix), create a solid group."
2708   (let* ((group
2709 	  (if solid (gnus-read-group "Group name: ")
2711 	 (default-type (or (car gnus-group-web-type-history)
2714 	  (gnus-string-or
2719 	    nil t nil 'gnus-group-web-type-history)
2724 	   (cons (or (car gnus-group-web-search-history) "") 0)
2725 	   'gnus-group-web-search-history))
2727 	  `(nnweb ,group (nnweb-search ,search)
2732 	  (gnus-pull 'nnweb-ephemeral-p method)
2733 	  (gnus-group-make-group group method))
2734       (gnus-group-read-ephemeral-group
2735        group method t
2737 	     (if (eq major-mode 'gnus-summary-mode) 'summary 'group))))))
2740   (defvar nnrss-group-alist)
2743 (defun gnus-group-make-rss-group (&optional url)
2745 If there is, use Gnus to create an nnrss group"
2752 	(let ((title (gnus-newsgroup-savable-name
2754 					    (gnus-newsgroup-savable-name
2767 	  (gnus-group-make-group (if encodable
2771 	  (push (list title href desc) nnrss-group-alist)
2776 (defvar gnus-group-warchive-type-history nil)
2777 (defvar gnus-group-warchive-login-history nil)
2778 (defvar gnus-group-warchive-address-history nil)
2780 (defun gnus-group-make-warchive-group ()
2781   "Create a nnwarchive group."
2784   (let* ((group (gnus-read-group "Group name: "))
2785 	 (default-type (or (car gnus-group-warchive-type-history)
2788 	  (gnus-string-or
2793 	    nil t nil 'gnus-group-warchive-type-history)
2796 			       nil 'gnus-group-warchive-address-history))
2797 	 (default-login (or (car gnus-group-warchive-login-history)
2800 	  (gnus-string-or
2803 	    default-login 'gnus-group-warchive-login-history)
2809     (gnus-group-make-group group method)))
2811 (defun gnus-group-make-archive-group (&optional all)
2812   "Create the (ding) Gnus archive group of the most recent articles.
2813 Given a prefix, create a full group."
2815   (let ((group (gnus-group-prefixed-name
2817     (when (gnus-gethash group gnus-newsrc-hashtb)
2818       (error "Archive group already exists"))
2819     (gnus-group-make-group
2820      (gnus-group-real-name group)
2823 		 (if all gnus-group-archive-directory
2824 		   gnus-group-recent-archive-directory))))
2825     (gnus-group-add-parameter group (cons 'to-address "ding@gnus.org"))))
2827 (defun gnus-group-make-directory-group (dir)
2828   "Create an nndir group.
2833    (list (read-file-name "Create group from directory: ")))
2840 	group)
2841     (while (or (not group) (gnus-gethash group gnus-newsrc-hashtb))
2842       (setq group
2843 	    (gnus-group-prefixed-name
2847     (gnus-group-make-group
2848      (gnus-group-real-name group)
2849      (list 'nndir (gnus-group-real-name group) (list 'nndir-directory dir)))))
2852 (defun gnus-group-make-kiboze-group (group address scores)
2853   "Create an nnkiboze group.
2854 The user will be prompted for a name, a regexp to match groups, and
2855 score file entries for articles to include in the group."
2858     (read-string "nnkiboze group name: ")
2859     (read-string "Source groups (regexp): ")
2860     (let ((headers (mapcar (lambda (group) (list group))
2874   (gnus-group-make-group group "nnkiboze" address)
2875   (let* ((nnkiboze-current-group group)
2882 	(gnus-pp scores)))))
2884 (defun gnus-group-add-to-virtual (n vgroup)
2885   "Add the current group to a virtual group."
2888 	 (completing-read "Add to virtual group: " gnus-newsrc-hashtb nil t
2890   (unless (eq (car (gnus-find-method-for-group vgroup)) 'nnvirtual)
2891     (error "%s is not an nnvirtual group" vgroup))
2892   (gnus-close-group vgroup)
2893   (let* ((groups (gnus-group-process-prefix n))
2894 	 (method (gnus-info-method (gnus-get-info vgroup))))
2900 		(gnus-group-remove-mark s)
2902 	      groups "\\|"))))
2903   (gnus-group-position-point))
2905 (defun gnus-group-make-empty-virtual (group)
2906   "Create a new, fresh, empty virtual group."
2907   (interactive "sCreate new, empty virtual group: ")
2909 	 (pgroup (gnus-group-prefixed-name group method)))
2911     (when (gnus-gethash pgroup gnus-newsrc-hashtb)
2913     ;; Subscribe the new group after the group on the current line.
2914     (gnus-subscribe-group pgroup (gnus-group-group-name) method)
2915     (gnus-group-update-group pgroup)
2917     (gnus-group-position-point)))
2919 (defun gnus-group-enter-directory (dir)
2920   "Enter an ephemeral nneething group."
2923 	 (leaf (gnus-group-prefixed-name
2926 	 (name (gnus-generate-new-group-name leaf)))
2927     (unless (gnus-group-read-ephemeral-group
2930 		   (if (eq major-mode 'gnus-summary-mode)
2931 		       'summary 'group)))
2939 (defun gnus-group-nnimap-expunge (group)
2941   (interactive (list (gnus-group-group-name)))
2942   (let ((mailbox (gnus-group-real-name group)) method)
2943     (unless group
2944       (error "No group on current line"))
2945     (unless (gnus-get-info group)
2946       (error "Killed group; can't be edited"))
2947     (unless (eq 'nnimap (car (setq method (gnus-find-method-for-group group))))
2948       (error "%s is not an nnimap group" group))
2951 (defun gnus-group-nnimap-edit-acl (group)
2953   (interactive (list (gnus-group-group-name)))
2954   (let ((mailbox (gnus-group-real-name group)) method acl)
2955     (unless group
2956       (error "No group on current line"))
2957     (unless (gnus-get-info group)
2958       (error "Killed group; can't be edited"))
2959     (unless (eq (car (setq method (gnus-find-method-for-group group))) 'nnimap)
2960       (error "%s is not an nnimap group" group))
2963     (gnus-edit-form acl (format "Editing the access control list for `%s'.
2986    a - administer (perform SETACL)" group)
2994 (defun gnus-group-sort-groups (func &optional reverse)
2995   "Sort the group buffer according to FUNC.
2997 determined by the `gnus-group-sort-function' variable.
2999   (interactive (list gnus-group-sort-function current-prefix-arg))
3000   (funcall gnus-group-sort-alist-function
3001 	   (gnus-make-sort-function func) reverse)
3002   (gnus-group-unmark-all-groups)
3003   (gnus-group-list-groups)
3004   (gnus-dribble-touch))
3006 (defun gnus-group-sort-flat (func reverse)
3007   ;; We peel off the dummy group from the alist.
3009     (when (equal (gnus-info-group (car gnus-newsrc-alist)) "dummy.group")
3010       (pop gnus-newsrc-alist))
3012     (setq gnus-newsrc-alist
3013 	  (sort gnus-newsrc-alist func))
3015       (setq gnus-newsrc-alist (nreverse gnus-newsrc-alist)))
3017     (gnus-make-hashtable-from-newsrc-alist)))
3019 (defun gnus-group-sort-groups-by-alphabet (&optional reverse)
3020   "Sort the group buffer alphabetically by group name.
3021 If REVERSE, sort in reverse order."
3023   (gnus-group-sort-groups 'gnus-group-sort-by-alphabet reverse))
3025 (defun gnus-group-sort-groups-by-real-name (&optional reverse)
3026   "Sort the group buffer alphabetically by real (unprefixed) group name.
3027 If REVERSE, sort in reverse order."
3029   (gnus-group-sort-groups 'gnus-group-sort-by-real-name reverse))
3031 (defun gnus-group-sort-groups-by-unread (&optional reverse)
3032   "Sort the group buffer by number of unread articles.
3033 If REVERSE, sort in reverse order."
3035   (gnus-group-sort-groups 'gnus-group-sort-by-unread reverse))
3037 (defun gnus-group-sort-groups-by-level (&optional reverse)
3038   "Sort the group buffer by group level.
3039 If REVERSE, sort in reverse order."
3041   (gnus-group-sort-groups 'gnus-group-sort-by-level reverse))
3043 (defun gnus-group-sort-groups-by-score (&optional reverse)
3044   "Sort the group buffer by group score.
3045 If REVERSE, sort in reverse order."
3047   (gnus-group-sort-groups 'gnus-group-sort-by-score reverse))
3049 (defun gnus-group-sort-groups-by-rank (&optional reverse)
3050   "Sort the group buffer by group rank.
3051 If REVERSE, sort in reverse order."
3053   (gnus-group-sort-groups 'gnus-group-sort-by-rank reverse))
3055 (defun gnus-group-sort-groups-by-method (&optional reverse)
3056   "Sort the group buffer alphabetically by back end name.
3057 If REVERSE, sort in reverse order."
3059   (gnus-group-sort-groups 'gnus-group-sort-by-method reverse))
3061 (defun gnus-group-sort-groups-by-server (&optional reverse)
3062   "Sort the group buffer alphabetically by server name.
3063 If REVERSE, sort in reverse order."
3065   (gnus-group-sort-groups 'gnus-group-sort-by-server reverse))
3067 ;;; Selected group sorting.
3069 (defun gnus-group-sort-selected-groups (n func &optional reverse)
3070   "Sort the process/prefixed groups."
3071   (interactive (list current-prefix-arg gnus-group-sort-function))
3072   (let ((groups (gnus-group-process-prefix n)))
3073     (funcall gnus-group-sort-selected-function
3074 	     groups (gnus-make-sort-function func) reverse)
3075     (gnus-group-unmark-all-groups)
3076     (gnus-group-list-groups)
3077     (gnus-dribble-touch)))
3079 (defun gnus-group-sort-selected-flat (groups func reverse)
3081     ;; First find all the group entries for these groups.
3082     (while groups
3083       (push (nthcdr 2 (gnus-gethash (pop groups) gnus-newsrc-hashtb))
3085     ;; Then sort the infos.
3087 	  (sort
3100     (gnus-make-hashtable-from-newsrc-alist)))
3102 (defun gnus-group-sort-selected-groups-by-alphabet (&optional n reverse)
3103   "Sort the group buffer alphabetically by group name.
3105 sort in reverse order."
3106   (interactive (gnus-interactive "P\ny"))
3107   (gnus-group-sort-selected-groups n 'gnus-group-sort-by-alphabet reverse))
3109 (defun gnus-group-sort-selected-groups-by-real-name (&optional n reverse)
3110   "Sort the group buffer alphabetically by real group name.
3112 sort in reverse order."
3113   (interactive (gnus-interactive "P\ny"))
3114   (gnus-group-sort-selected-groups n 'gnus-group-sort-by-real-name reverse))
3116 (defun gnus-group-sort-selected-groups-by-unread (&optional n reverse)
3117   "Sort the group buffer by number of unread articles.
3119 sort in reverse order."
3120   (interactive (gnus-interactive "P\ny"))
3121   (gnus-group-sort-selected-groups n 'gnus-group-sort-by-unread reverse))
3123 (defun gnus-group-sort-selected-groups-by-level (&optional n reverse)
3124   "Sort the group buffer by group level.
3126 sort in reverse order."
3127   (interactive (gnus-interactive "P\ny"))
3128   (gnus-group-sort-selected-groups n 'gnus-group-sort-by-level reverse))
3130 (defun gnus-group-sort-selected-groups-by-score (&optional n reverse)
3131   "Sort the group buffer by group score.
3133 sort in reverse order."
3134   (interactive (gnus-interactive "P\ny"))
3135   (gnus-group-sort-selected-groups n 'gnus-group-sort-by-score reverse))
3137 (defun gnus-group-sort-selected-groups-by-rank (&optional n reverse)
3138   "Sort the group buffer by group rank.
3140 sort in reverse order."
3141   (interactive (gnus-interactive "P\ny"))
3142   (gnus-group-sort-selected-groups n 'gnus-group-sort-by-rank reverse))
3144 (defun gnus-group-sort-selected-groups-by-method (&optional n reverse)
3145   "Sort the group buffer alphabetically by back end name.
3147 sort in reverse order."
3148   (interactive (gnus-interactive "P\ny"))
3149   (gnus-group-sort-selected-groups n 'gnus-group-sort-by-method reverse))
3153 (defun gnus-group-sort-by-alphabet (info1 info2)
3155   (string< (gnus-info-group info1) (gnus-info-group info2)))
3157 (defun gnus-group-sort-by-real-name (info1 info2)
3159   (string< (gnus-group-real-name (gnus-info-group info1))
3160 	   (gnus-group-real-name (gnus-info-group info2))))
3162 (defun gnus-group-sort-by-unread (info1 info2)
3164   (let ((n1 (car (gnus-gethash (gnus-info-group info1) gnus-newsrc-hashtb)))
3165 	(n2 (car (gnus-gethash (gnus-info-group info2) gnus-newsrc-hashtb))))
3169 (defun gnus-group-sort-by-level (info1 info2)
3171   (< (gnus-info-level info1) (gnus-info-level info2)))
3173 (defun gnus-group-sort-by-method (info1 info2)
3175   (string< (car (gnus-find-method-for-group
3176 		 (gnus-info-group info1) info1))
3177 	   (car (gnus-find-method-for-group
3178 		 (gnus-info-group info2) info2))))
3180 (defun gnus-group-sort-by-server (info1 info2)
3182   (string< (gnus-method-to-full-server-name
3183 	    (gnus-find-method-for-group
3184 	     (gnus-info-group info1) info1))
3185 	   (gnus-method-to-full-server-name
3186 	    (gnus-find-method-for-group
3187 	     (gnus-info-group info2) info2))))
3189 (defun gnus-group-sort-by-score (info1 info2)
3190   "Sort by group score."
3191   (> (gnus-info-score info1) (gnus-info-score info2)))
3193 (defun gnus-group-sort-by-rank (info1 info2)
3195   (let ((level1 (gnus-info-level info1))
3196 	(level2 (gnus-info-level info2)))
3199 	     (> (gnus-info-score info1) (gnus-info-score info2))))))
3203 (defun gnus-group-clear-data (&optional arg)
3204   "Clear all marks and read ranges from the current group.
3207   (gnus-group-iterate arg
3208     (lambda (group)
3210 	(gnus-info-clear-data (setq info (gnus-get-info group)))
3211 	(gnus-get-unread-articles-in-group info (gnus-active group) t)
3212 	(when (gnus-group-goto-group group)
3213 	  (gnus-group-update-group-line))))))
3215 (defun gnus-group-clear-data-on-native-groups ()
3216   "Clear all marks and read ranges from all native groups."
3218   (when (gnus-yes-or-no-p "Really clear all data from almost all groups? ")
3219     (let ((alist (cdr gnus-newsrc-alist))
3222 	(when (gnus-group-native-p (gnus-info-group info))
3223 	  (gnus-info-clear-data info)))
3224       (gnus-get-unread-articles)
3225       (gnus-dribble-touch)
3226       (when (gnus-y-or-n-p
3228 	(call-interactively 'gnus-cache-move-cache)))))
3230 (defun gnus-info-clear-data (info)
3232   (let ((group (gnus-info-group info))
3234     (dolist (el (gnus-info-marks info))
3236     (push `(,(gnus-info-read info) add (read)) action)
3237     (gnus-undo-register
3239 	 (gnus-request-set-mark ,group ',action)
3240 	 (gnus-info-set-marks ',info ',(gnus-info-marks info) t)
3241 	 (gnus-info-set-read ',info ',(gnus-info-read info))
3242 	 (when (gnus-group-goto-group ,group)
3243 	   (gnus-get-unread-articles-in-group ',info ',(gnus-active group) t)
3244 	   (gnus-group-update-group-line))))
3247     (gnus-request-set-mark group action)
3248     (gnus-info-set-read info nil)
3249     (when (gnus-info-marks info)
3250       (gnus-info-set-marks info nil))))
3254 (defun gnus-group-catchup-current (&optional n all)
3262   (let ((groups (gnus-group-process-prefix n))
3264 	group)
3265     (unless groups (error "No groups selected"))
3267 	 (or (not gnus-interactive-catchup) ;Without confirmation?
3268 	     gnus-expert-user
3269 	     (gnus-y-or-n-p
3274 	       (if (= (length groups) 1)
3275 		   (gnus-group-decoded-name (car groups))
3276 		 (format "these %d groups" (length groups)))))))
3278       (while (setq group (pop groups))
3279 	(gnus-group-remove-mark group)
3280 	;; Virtual groups have to be given special treatment.
3281 	(let ((method (gnus-find-method-for-group group)))
3283 	    (nnvirtual-catchup-group
3284 	     (gnus-group-real-name group) (nth 1 method) all)))
3285 	(if (>= (gnus-group-level group) gnus-level-zombie)
3286 	    (gnus-message 2 "Dead groups can't be caught up")
3288 		  (gnus-group-goto-group group)
3289 		(gnus-group-catchup group all))
3290 	      (gnus-group-update-group-line)
3292       (gnus-group-next-unread-group 1)
3295 (defun gnus-group-catchup-current-all (&optional n)
3299   (gnus-group-catchup-current n 'all))
3301 (defun gnus-group-catchup (group &optional all)
3306   (let* ((entry (gnus-gethash group gnus-newsrc-hashtb))
3309 	 (unread (gnus-sequence-of-unread-articles group)))
3310     ;; Remove entries for this group.
3311     (nnmail-purge-split-history (gnus-group-real-name group))
3314 	(gnus-message 1 "Can't catch up %s; non-active group" group)
3315       (gnus-update-read-articles group nil)
3318 	(gnus-request-set-mark group (list (list (cdr (assq 'tick marks))
3322 	(setq unread (gnus-range-add (gnus-range-add
3325 	(gnus-add-marked-articles group 'tick nil nil 'force)
3326 	(gnus-add-marked-articles group 'dormant nil nil 'force))
3328       (when (gnus-group-auto-expirable-p group)
3329         (gnus-range-map (lambda (article)
3330                           (gnus-add-marked-articles group 'expire (list article))
3331                           (gnus-request-set-mark group (list (list (list article) 'add '(expire)))))
3333       (let ((gnus-newsgroup-name group))
3334 	(gnus-run-hooks 'gnus-group-catchup-group-hook))
3337 (defun gnus-group-expire-articles (&optional n)
3341   (let ((groups (gnus-group-process-prefix n))
3342 	group)
3343     (unless groups
3344       (error "No groups to expire"))
3345     (while (setq group (pop groups))
3346       (gnus-group-remove-mark group)
3347       (gnus-group-expire-articles-1 group)
3348       (gnus-dribble-touch)
3349       (gnus-group-position-point))))
3351 (defun gnus-group-expire-articles-1 (group)
3352   (when (gnus-check-backend-function 'request-expire-articles group)
3353     (gnus-message 6 "Expiring articles in %s..."
3354 		  (gnus-group-decoded-name group))
3355     (let* ((info (gnus-get-info group))
3356 	   (expirable (if (gnus-group-total-expirable-p group)
3357 			  (cons nil (gnus-list-of-read-articles group))
3358 			(assq 'expire (gnus-info-marks info))))
3359 	   (expiry-wait (gnus-group-find-parameter group 'expiry-wait))
3361 	    (or (gnus-group-find-parameter group 'expiry-target)
3364 	(gnus-check-group group)
3367 	 (gnus-compress-sequence
3369 	      ;; We set the expiry variables to the group
3373 		(gnus-request-expire-articles
3374 		 (gnus-uncompress-sequence (cdr expirable)) group))
3376 	    (gnus-request-expire-articles
3377 	     (gnus-uncompress-sequence (cdr expirable)) group))))
3378 	(gnus-close-group group))
3379       (gnus-message 6 "Expiring articles in %s...done"
3380 		    (gnus-group-decoded-name group))
3384 (defun gnus-group-expire-all-groups ()
3388     (gnus-message 5 "Expiring...")
3389     (let ((gnus-group-marked (mapcar (lambda (info) (gnus-info-group info))
3390 				     (cdr gnus-newsrc-alist))))
3391       (gnus-group-expire-articles nil)))
3392   (gnus-group-position-point)
3393   (gnus-message 5 "Expiring...done"))
3395 (defun gnus-group-set-current-level (n level)
3396   "Set the level of the next N groups to LEVEL."
3401       (unless (gnus-group-process-prefix current-prefix-arg)
3402 	(error "No group on the current line"))
3406 			 (or (gnus-group-group-level)
3407 			     gnus-level-default-subscribed)))))
3409 	     (int-to-string (or (gnus-group-group-level)
3410 				gnus-level-default-subscribed))
3412   (unless (and (>= level 1) (<= level gnus-level-killed))
3414   (let ((groups (gnus-group-process-prefix n))
3415 	group)
3416     (while (setq group (pop groups))
3417       (gnus-group-remove-mark group)
3418       (gnus-message 6 "Changed level of %s from %d to %d"
3419 		    (gnus-group-decoded-name group)
3420 		    (or (gnus-group-group-level) gnus-level-killed)
3422       (gnus-group-change-level
3423        group level (or (gnus-group-group-level) gnus-level-killed))
3424       (gnus-group-update-group-line)))
3425   (gnus-group-position-point))
3427 (defun gnus-group-unsubscribe (&optional n)
3428   "Unsubscribe the current group."
3430   (gnus-group-unsubscribe-current-group n 'unsubscribe))
3432 (defun gnus-group-subscribe (&optional n)
3433   "Subscribe the current group."
3435   (gnus-group-unsubscribe-current-group n 'subscribe))
3437 (defun gnus-group-unsubscribe-current-group (&optional n do-sub)
3438   "Toggle subscription of the current group.
3439 If given numerical prefix, toggle the N next groups."
3441   (dolist (group (gnus-group-process-prefix n))
3442     (gnus-group-remove-mark group)
3443     (gnus-group-unsubscribe-group
3444      group
3447        gnus-level-default-unsubscribed)
3449        gnus-level-default-subscribed)
3450       ((<= (gnus-group-group-level) gnus-level-subscribed)
3451        gnus-level-default-unsubscribed)
3453        gnus-level-default-subscribed))
3455     (gnus-group-update-group-line))
3456   (gnus-group-next-group 1))
3458 (defun gnus-group-unsubscribe-group (group &optional level silent)
3461 group line."
3464 	  "Group: " gnus-active-hashtb nil
3465 	  (gnus-read-active-file-p)
3467 	  'gnus-group-history)))
3468   (let ((newsrc (gnus-gethash group gnus-newsrc-hashtb)))
3470      ((string-match "^[ \t]*$" group)
3471       (error "Empty group name"))
3474       (gnus-group-change-level
3475        newsrc (if level level (if (<= (gnus-info-level (nth 2 newsrc))
3476 				      gnus-level-subscribed)
3477 				  (1+ gnus-level-subscribed)
3478 				gnus-level-default-subscribed)))
3480 	(gnus-group-update-group group)))
3481      ((and (stringp group)
3482 	   (or (not (gnus-read-active-file-p))
3483 	       (gnus-active group)))
3485       (gnus-group-change-level
3486        group
3487        (if level level gnus-level-default-subscribed)
3488        (or (and (member group gnus-zombie-list)
3489 		gnus-level-zombie)
3490 	   gnus-level-killed)
3491        (when (gnus-group-group-name)
3492 	 (gnus-gethash (gnus-group-group-name) gnus-newsrc-hashtb)))
3494 	(gnus-group-update-group group)))
3495      (t (error "No such newsgroup: %s" group)))
3496     (gnus-group-position-point)))
3498 (defun gnus-group-transpose-groups (n)
3503   (unless (gnus-group-group-name)
3504     (error "No group on current line"))
3505   (gnus-group-kill-group 1)
3508     (gnus-group-yank-group)
3509     (gnus-group-position-point)))
3511 (defun gnus-group-kill-all-zombies (&optional dummy)
3514   (interactive (list (not (gnus-yes-or-no-p "Really kill all zombies? "))))
3516     (setq gnus-killed-list (nconc gnus-zombie-list gnus-killed-list))
3517     (setq gnus-zombie-list nil)
3518     (gnus-dribble-touch)
3519     (gnus-group-list-groups)))
3521 (defun gnus-group-kill-region (begin end)
3523 The killed newsgroups can be yanked by using \\[gnus-group-yank-group]."
3539     (gnus-group-kill-group lines)))
3541 (defun gnus-group-kill-group (&optional n discard)
3542   "Kill the next N groups.
3543 The killed newsgroups can be yanked by using \\[gnus-group-yank-group].
3544 However, only groups that were alive can be yanked; already killed
3545 groups or zombie groups can't be yanked.
3546 The return value is the name of the group that was killed, or a list
3547 of groups killed."
3550 	(groups (gnus-group-process-prefix n))
3551 	group entry level out)
3552     (if (< (length groups) 10)
3553 	;; This is faster when there are few groups.
3554 	(while groups
3555 	  (push (setq group (pop groups)) out)
3556 	  (gnus-group-remove-mark group)
3557 	  (setq level (gnus-group-group-level))
3558 	  (gnus-delete-line)
3560 		     (setq entry (gnus-gethash group gnus-newsrc-hashtb)))
3561 	    (gnus-undo-register
3563 		 (gnus-group-goto-group ,(gnus-group-group-name))
3564 		 (gnus-group-yank-group)))
3566 		  gnus-list-of-killed-groups))
3567 	  (gnus-group-change-level
3568 	   (if entry entry group) gnus-level-killed (if entry nil level))
3569 	  (message "Killed group %s" (gnus-group-decoded-name group)))
3570       ;; If there are lots and lots of groups to be killed, we use
3572       (dolist (group (nreverse groups))
3573 	(gnus-group-remove-mark group)
3574 	(gnus-delete-line)
3575 	(push group gnus-killed-list)
3576 	(setq gnus-newsrc-alist
3577 	      (delq (assoc group gnus-newsrc-alist)
3578 		    gnus-newsrc-alist))
3579 	(when gnus-group-change-level-function
3580 	  (funcall gnus-group-change-level-function
3581 		   group gnus-level-killed 3))
3583 	 ((setq entry (gnus-gethash group gnus-newsrc-hashtb))
3585 		gnus-list-of-killed-groups)
3587 	 ((member group gnus-zombie-list)
3588 	  (setq gnus-zombie-list (delete group gnus-zombie-list))))
3590 	(while (gnus-group-goto-group group)
3591 	  (gnus-delete-line)))
3592       (gnus-make-hashtable-from-newsrc-alist))
3594     (gnus-group-position-point)
3597 (defun gnus-group-yank-group (&optional arg)
3598   "Yank the last newsgroups killed with \\[gnus-group-kill-group], inserting it before the current newsgroup.
3600 name of the newsgroup yanked is returned, or (if several groups are
3601 yanked) a list of yanked groups is returned."
3604   (let (info group prev out)
3606       (when (not (setq info (pop gnus-list-of-killed-groups)))
3608       (push (setq group (nth 1 info)) out)
3613       (setq prev (gnus-group-group-name))
3614       (gnus-group-change-level
3615        info (gnus-info-level (cdr info)) gnus-level-killed
3616        (and prev (gnus-gethash prev gnus-newsrc-hashtb))
3618       (gnus-group-insert-group-line-info group)
3619       (gnus-undo-register
3620 	`(when (gnus-group-goto-group ,group)
3621 	   (gnus-group-kill-group 1))))
3623     (gnus-group-position-point)
3626 (defun gnus-group-kill-level (level)
3627   "Kill all groups that is on a certain LEVEL."
3628   (interactive "nKill all groups on level: ")
3630    ((= level gnus-level-zombie)
3631     (setq gnus-killed-list
3632 	  (nconc gnus-zombie-list gnus-killed-list))
3633     (setq gnus-zombie-list nil))
3634    ((and (< level gnus-level-zombie)
3636 	 (or gnus-expert-user
3637 	     (gnus-yes-or-no-p
3639 	       "Do you really want to kill all groups on level %d? "
3641     (let* ((prev gnus-newsrc-alist)
3644 	(if (= (gnus-info-level (car alist)) level)
3646 	      (push (gnus-info-group (car alist)) gnus-killed-list)
3650       (gnus-make-hashtable-from-newsrc-alist)
3651       (gnus-group-list-groups)))
3655 (defun gnus-group-list-all-groups (&optional arg)
3657 Default is `gnus-level-unsubscribed', which lists all subscribed and most
3658 unsubscribed groups."
3660   (gnus-group-list-groups (or arg gnus-level-unsubscribed) t))
3662 ;; Redefine this to list ALL killed groups if prefix arg used.
3664 (defun gnus-group-list-killed (&optional arg)
3665   "List all killed newsgroups in the group buffer.
3666 If ARG is non-nil, list ALL killed groups known to Gnus.  This may
3667 entail asking the server for the groups."
3671     (gnus-get-killed-groups))
3672   (if (not gnus-killed-list)
3673       (gnus-message 6 "No killed groups")
3674     (let (gnus-group-list-mode)
3675       (funcall gnus-group-prepare-function
3676 	       gnus-level-killed t gnus-level-killed))
3678   (gnus-group-position-point))
3680 (defun gnus-group-list-zombies ()
3681   "List all zombie newsgroups in the group buffer."
3683   (if (not gnus-zombie-list)
3684       (gnus-message 6 "No zombie groups")
3685     (let (gnus-group-list-mode)
3686       (funcall gnus-group-prepare-function
3687 	       gnus-level-zombie t gnus-level-zombie))
3689   (gnus-group-position-point))
3691 (defun gnus-group-list-active ()
3692   "List all groups that are available from the server(s)."
3695   (unless (gnus-read-active-file-p)
3696     (let ((gnus-read-active-file t)
3697 	  (gnus-agent gnus-plugged)); If we're actually plugged, store the active file in the agent.
3698       (gnus-read-active-file)))
3699   ;; Find all groups and sort them.
3700   (let ((groups
3701 	 (sort
3708 	     gnus-active-hashtb)
3712 	group)
3714     (while groups
3715       (setq group (pop groups))
3716       (gnus-add-text-properties
3719 			 (gnus-group-decoded-name group)
3721        (list 'gnus-group (gnus-intern-safe group gnus-active-hashtb)
3722 	     'gnus-unread t
3723 	     'gnus-level (inline (gnus-group-level group)))))
3726 (defun gnus-activate-all-groups (level)
3727   "Activate absolutely all groups."
3728   (interactive (list gnus-level-unsubscribed))
3729   (let ((gnus-activate-level level)
3730 	(gnus-activate-foreign-newsgroups level))
3731     (gnus-group-get-new-news)))
3733 (defun gnus-group-get-new-news (&optional arg)
3740   (let ((gnus-inhibit-demon t)
3744     (gnus-run-hooks 'gnus-get-top-new-news-hook)
3745     (gnus-run-hooks 'gnus-get-new-news-hook)
3748     (unless gnus-slave
3749       (gnus-master-read-slave-newsrc))
3752     (when (and gnus-use-nocem
3753 	       (or (and (numberp gnus-use-nocem)
3755 			(>= arg gnus-use-nocem))
3757       (gnus-nocem-scan-groups))
3760       (let ((gnus-read-active-file t))
3761 	(gnus-read-active-file))
3764       ;; If the user wants it, we scan for new groups.
3765       (when (eq gnus-check-new-newsgroups 'always)
3766 	(gnus-find-new-newsgroups)))
3768     (setq arg (gnus-group-default-level arg t))
3769     (if (and gnus-read-active-file (not arg))
3771 	  (gnus-read-active-file)
3772 	  (gnus-get-unread-articles arg))
3773       (let ((gnus-read-active-file (if arg nil gnus-read-active-file)))
3774 	(gnus-get-unread-articles arg)))
3775     (gnus-run-hooks 'gnus-after-getting-new-news-hook)
3776     (gnus-group-list-groups (and (numberp arg)
3777 				 (max (car gnus-group-list-mode) arg)))))
3779 (defun gnus-group-get-new-news-this-group (&optional n dont-scan)
3780   "Check for newly arrived news in the current group (and the N-1 next groups).
3782 If N is negative, this group and the N-1 previous groups will be checked.
3783 If DONT-SCAN is non-nil, scan non-activated groups as well."
3785   (let* ((groups (gnus-group-process-prefix n))
3786 	 (ret (if (numberp n) (- n (length groups)) 0))
3789 	 group method
3790 	 (gnus-inhibit-demon t)
3794     (gnus-run-hooks 'gnus-get-new-news-hook)
3795     (while (setq group (pop groups))
3796       (gnus-group-remove-mark group)
3798       (gnus-remove-denial (setq method (gnus-find-method-for-group group)))
3799       (if (gnus-activate-group group (if dont-scan nil 'scan))
3801 	    (gnus-get-unread-articles-in-group
3802 	     (gnus-get-info group) (gnus-active group) t)
3803 	    (unless (gnus-virtual-group-p group)
3804 	      (gnus-close-group group))
3805 	    (when gnus-agent
3806 	      (gnus-agent-save-group-info
3807 	       method (gnus-group-real-name group) (gnus-active group)))
3808 	    (gnus-group-update-group group))
3809 	(if (eq (gnus-server-status (gnus-find-method-for-group group))
3811 	    (gnus-error 3 "Server denied access")
3812 	  (gnus-error 3 "%s error: %s" group (gnus-status-message group)))))
3815     (when gnus-goto-next-group-when-activating
3816       (gnus-group-next-unread-group 1 t))
3817     (gnus-summary-position-point)
3820 (defun gnus-group-fetch-faq (group &optional faq-dir)
3821   "Fetch the FAQ for the current group.
3826     (gnus-group-group-name)
3829        "FAQ dir: " (and (listp gnus-group-faq-directory)
3831 				gnus-group-faq-directory))))))
3832   (unless group
3833     (error "No group name given"))
3834   (let ((dirs (or faq-dir gnus-group-faq-directory))
3840       (let ((name (gnus-group-real-name group)))
3843 	  (gnus-message 1 "No such file: %s" file)
3848 (defun gnus-group-fetch-charter (group)
3849   "Fetch the charter for the current group.
3850 If given a prefix argument, prompt for a group."
3853 	       (completing-read "Group: " gnus-active-hashtb))
3854 	     (gnus-group-group-name)
3855 	     gnus-newsgroup-name)))
3856   (unless group
3857     (error "No group name given"))
3860   (let ((name (mm-url-form-encode-xwfu (gnus-group-real-name group)))
3864       (if (and (setq url (cdr (assoc hierarchy gnus-group-charter-alist)))
3874 	  (gnus-group-fetch-control group))))))
3876 (defun gnus-group-fetch-control (group)
3877   "Fetch the archived control messages for the current group.
3878 If given a prefix argument, prompt for a group."
3881 	       (completing-read "Group: " gnus-active-hashtb))
3882 	     (gnus-group-group-name)
3883 	     gnus-newsgroup-name)))
3884   (unless group
3885     (error "No group name given"))
3886   (let ((name (gnus-group-real-name group))
3890       (if gnus-group-fetch-control-use-browse-url
3894 	  (gnus-group-read-ephemeral-group
3895 	   group
3896 	   `(nndoc ,group (nndoc-address
3902 (defun gnus-group-describe-group (force &optional group)
3904   (interactive (list current-prefix-arg (gnus-group-group-name)))
3905   (let* ((method (gnus-find-method-for-group group))
3906 	 (mname (gnus-group-prefixed-name "" method))
3909 	       gnus-description-hashtb)
3910       (gnus-sethash mname nil gnus-description-hashtb))
3911     (unless group
3912       (error "No group name given"))
3913     (when (or (and gnus-description-hashtb
3914 		   ;; We check whether this group's method has been
3916 		   (gnus-gethash mname gnus-description-hashtb))
3917 	      (setq desc (gnus-group-get-description group))
3918 	      (gnus-read-descriptions-file method))
3919       (gnus-message 1
3920 		    (or desc (gnus-gethash group gnus-description-hashtb)
3924 (defun gnus-group-describe-all-groups (&optional force)
3928     (setq gnus-description-hashtb nil))
3929   (when (not (or gnus-description-hashtb
3930 		 (gnus-read-all-descriptions-files)))
3936      (lambda (group)
3938        (let ((charset (gnus-group-name-charset nil (symbol-name group))))
3940 			 (gnus-group-name-decode
3941 			  (symbol-name group) charset)
3942 			 (gnus-group-name-decode
3943 			  (symbol-value group) charset))))
3944        (gnus-add-text-properties
3945 	b (1+ b) (list 'gnus-group group
3946 		       'gnus-unread t 'gnus-marked nil
3947 		       'gnus-level (1+ gnus-level-subscribed))))
3948      gnus-description-hashtb)
3950     (gnus-group-position-point)))
3953 (defun gnus-group-apropos (regexp &optional search-description)
3958 	groups des)
3961      (lambda (group)
3962        (and (symbol-name group)
3963 	    (string-match regexp (symbol-name group))
3964 	    (symbol-value group)
3965 	    (push (symbol-name group) groups)))
3966      gnus-active-hashtb)
3970        (lambda (group)
3971 	 (and (string-match regexp (symbol-value group))
3972 	      (push (symbol-name group) groups)))
3973        gnus-description-hashtb))
3974     (if (not groups)
3975 	(gnus-message 3 "No groups matched \"%s\"." regexp)
3976       ;; Print out all the groups.
3981 	(setq groups (sort groups 'string<))
3982 	(while groups
3983 	  ;; Groups may be entered twice into the list of groups.
3984 	  (when (not (string= (car groups) prev))
3985 	    (setq prev (car groups))
3986 	    (let ((charset (gnus-group-name-charset nil prev)))
3987 	      (insert (gnus-group-name-decode prev charset) "\n")
3988 	      (when (and gnus-description-hashtb
3989 			 (setq des (gnus-gethash (car groups)
3990 						 gnus-description-hashtb)))
3991 		(insert "  " (gnus-group-name-decode des charset) "\n"))))
3992 	  (setq groups (cdr groups)))
3996 (defun gnus-group-description-apropos (regexp)
3999   (when (not (or gnus-description-hashtb
4000 		 (gnus-read-all-descriptions-files)))
4002   (gnus-group-apropos regexp t))
4005 (defun gnus-group-list-matching (level regexp &optional all lowest)
4006   "List all groups with unread articles that match REGEXP.
4008 level to cut off listing groups.
4009 If ALL, also list groups with no unread articles.
4010 If LOWEST, don't list groups with level lower than LOWEST.
4016 	     (> (prefix-numeric-value level) gnus-level-killed))
4017     (gnus-get-killed-groups))
4018   (funcall gnus-group-prepare-function
4019    (or level gnus-level-subscribed) (and all t) (or lowest 1) regexp)
4021   (gnus-group-position-point))
4023 (defun gnus-group-list-all-matching (level regexp &optional lowest)
4024   "List all groups that match REGEXP.
4026 level to cut off listing groups.
4027 If LOWEST, don't list groups with level lower than LOWEST."
4031   (gnus-group-list-matching (or level gnus-level-killed) regexp t lowest))
4034 (defun gnus-group-save-newsrc (&optional force)
4038   (gnus-save-newsrc-file force))
4040 (defun gnus-group-restart (&optional arg)
4043   (when (gnus-yes-or-no-p
4045     (gnus-save-newsrc-file)
4046     (gnus-clear-system)
4047     (gnus)))
4049 (defun gnus-group-read-init-file ()
4052   (gnus-read-init-file)
4053   (gnus-message 5 "Read %s" gnus-init-file))
4055 (defun gnus-group-check-bogus-groups (&optional silent)
4058 group."
4060   (gnus-check-bogus-newsgroups (and (not silent) (not gnus-expert-user)))
4061   (gnus-group-list-groups))
4063 (defun gnus-group-find-new-groups (&optional arg)
4064   "Search for new groups and add them.
4065 Each new group will be treated with `gnus-subscribe-newsgroup-method'.
4067 groups.
4069 for new groups, and subscribe the new groups as zombies."
4071   (gnus-find-new-newsgroups (or arg 1))
4072   (gnus-group-list-groups))
4074 (defun gnus-group-edit-global-kill (&optional article group)
4078   (setq gnus-current-kill-article article)
4079   (gnus-kill-file-edit-file group)
4080   (gnus-message
4083     (format "Editing a %s kill file (Type \\[gnus-kill-file-exit] to exit)"
4084 	    (if group "local" "global")))))
4086 (defun gnus-group-edit-local-kill (article group)
4088   (interactive (list nil (gnus-group-group-name)))
4089   (gnus-group-edit-global-kill article group))
4091 (defun gnus-group-force-update ()
4094   (gnus-save-newsrc-file))
4096 (defvar gnus-backlog-articles)
4098 (defun gnus-group-suspend ()
4100 In fact, cleanup buffers except for group mode buffer.
4101 The hook `gnus-suspend-gnus-hook' is called before actually suspending."
4103   (gnus-run-hooks 'gnus-suspend-gnus-hook)
4104   (gnus-offer-save-summaries)
4105   ;; Kill Gnus buffers except for group mode buffer.
4106   (let ((group-buf (get-buffer gnus-group-buffer)))
4108 	      (unless (or (member buf (list group-buf gnus-dribble-buffer))
4113 		(gnus-kill-buffer buf)))
4114 	    (gnus-buffers))
4115     (setq gnus-backlog-articles nil)
4116     (gnus-kill-gnus-frames)
4117     (when group-buf
4118       (bury-buffer group-buf)
4119       (delete-windows-on group-buf t))))
4121 (defun gnus-group-clear-dribble ()
4124   (gnus-dribble-clear)
4125   (gnus-message 7 "Cleared dribble buffer"))
4127 (defun gnus-group-exit ()
4129 The hook `gnus-exit-gnus-hook' is called before actually exiting."
4132       (or noninteractive		;For gnus-batch-kill
4133 	  (not gnus-interactive-exit)	;Without confirmation
4134 	  gnus-expert-user
4135 	  (gnus-y-or-n-p "Are you sure you want to quit reading news? "))
4136     (gnus-run-hooks 'gnus-exit-gnus-hook)
4138     (gnus-offer-save-summaries)
4140     (gnus-save-newsrc-file)
4142     (gnus-close-backends)
4144     (gnus-clear-system)
4146     (gnus-run-hooks 'gnus-after-exiting-gnus-hook)))
4148 (defun gnus-group-quit ()
4150 The hook `gnus-exit-gnus-hook' is called before actually exiting."
4152   (when (or noninteractive		;For gnus-batch-kill
4154 	    (not (gnus-server-opened gnus-select-method))
4155 	    gnus-expert-user
4156 	    (not gnus-current-startup-file)
4157 	    (gnus-yes-or-no-p
4159 		     (file-name-nondirectory gnus-current-startup-file))))
4160     (gnus-run-hooks 'gnus-exit-gnus-hook)
4161     (gnus-configure-windows 'group t)
4162     (when (and (gnus-buffer-live-p gnus-dribble-buffer)
4164 			    (set-buffer gnus-dribble-buffer)
4166       (gnus-dribble-enter
4168     (gnus-dribble-save)
4169     (gnus-close-backends)
4170     (gnus-clear-system)
4171     (gnus-kill-buffer gnus-group-buffer)
4173     (gnus-run-hooks 'gnus-after-exiting-gnus-hook)))
4175 (defun gnus-group-describe-briefly ()
4176   "Give a one line description of the group mode commands."
4178   (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")))
4180 (defun gnus-group-browse-foreign-server (method)
4189 		     (append gnus-valid-select-methods gnus-server-alist)
4190 		     nil t (cons "nntp" 0) 'gnus-method-history)))
4193 	   (if (assoc how gnus-valid-select-methods)
4199 			      gnus-secondary-servers)))
4202   (gnus-browse-foreign-server method))
4204 (defun gnus-group-set-info (info &optional method-only-group part)
4206     (let* ((entry (gnus-gethash
4207 		   (or method-only-group (gnus-info-group info))
4208 		   gnus-newsrc-hashtb))
4210 	   (info (if method-only-group (nth 2 entry) info))
4212       (when method-only-group
4214 	  (error "Trying to change non-existent group %s" method-only-group))
4215 	;; We have received parts of the actual group info - either the
4216 	;; select method or the group parameters.  We first check
4226 	;; This is a new group, so we just create it.
4228 	  (set-buffer gnus-group-buffer)
4229 	  (setq method (gnus-info-method info))
4230 	  (when (gnus-server-equal method "native")
4233 	    (set-buffer gnus-group-buffer)
4235 		;; It's a foreign group...
4236 		(gnus-group-make-group
4237 		 (gnus-group-real-name (gnus-info-group info))
4241 		      (nth 1 (gnus-info-method info))))
4242 	      ;; It's a native group.
4243 	      (gnus-group-make-group (gnus-info-group info))))
4244 	  (gnus-message 6 "Note: New group created")
4246 		(gnus-gethash (gnus-group-prefixed-name
4247 			       (gnus-group-real-name (gnus-info-group info))
4248 			       (or (gnus-info-method info) gnus-select-method))
4249 			      gnus-newsrc-hashtb))))
4250       ;; Whether it was a new group or not, we now have the entry, so we
4256 		       (gnus-active (gnus-info-group info)))
4258 			     (gnus-list-of-unread-articles (car info))))))
4259 	(error "No such group: %s" (gnus-info-group info))))))
4261 (defun gnus-group-set-method-info (group select-method)
4262   (gnus-group-set-info select-method group 'method))
4264 (defun gnus-group-set-params-info (group params)
4265   (gnus-group-set-info params group 'params))
4267 (defun gnus-add-marked-articles (group type articles &optional info force)
4271   (let ((info (or info (gnus-get-info group)))
4277 			 (list (list (cons type (gnus-compress-sequence
4282 			 (cons (cons type (gnus-compress-sequence articles t) )
4287 			(gnus-delete-alist type (car marked)))
4288 	      (setcdr m (gnus-compress-sequence articles t)))
4289 	  (setcdr m (gnus-compress-sequence
4290 		     (sort (nconc (gnus-uncompress-range (cdr m))
4293 (defun gnus-add-mark (group mark article)
4294   "Mark ARTICLE in GROUP with MARK, whether the group is displayed or not."
4295   (let ((buffer (gnus-summary-buffer-name group)))
4296     (if (gnus-buffer-live-p buffer)
4299 	  (gnus-summary-add-mark article mark))
4300       (gnus-add-marked-articles group (cdr (assq mark gnus-article-mark-lists))
4307 (defun gnus-group-set-timestamp ()
4308   "Change the timestamp of the current group to the current time.
4309 This function can be used in hooks like `gnus-select-group-hook'
4310 or `gnus-group-catchup-group-hook'."
4311   (when gnus-newsgroup-name
4314       (gnus-group-set-parameter gnus-newsgroup-name 'timestamp time))))
4316 (defsubst gnus-group-timestamp (group)
4318   (gnus-group-get-parameter group 'timestamp t))
4320 (defun gnus-group-timestamp-delta (group)
4322   (let* ((time (or (gnus-group-timestamp group)
4328 (defun gnus-group-timestamp-string (group)
4330   (let ((time (gnus-group-timestamp group)))
4333       (gnus-time-iso8601 time))))
4335 (defun gnus-group-list-cached (level &optional lowest)
4336   "List all groups with cached articles.
4338 level to cut off listing groups.
4339 If LOWEST, don't list groups with level lower than LOWEST.
4345   (when (or (not level) (>= level gnus-level-zombie))
4346     (gnus-cache-open))
4347   (funcall gnus-group-prepare-function
4348 	   (or level gnus-level-subscribed)
4350 	       (let ((marks (gnus-info-marks info)))
4353 	   #'(lambda (group)
4354 	       (or (gnus-gethash group
4355 				 gnus-cache-active-hashtb)
4358 		   (gnus-gethash
4360 			       (split-string group ":")
4362 		    gnus-cache-active-hashtb))))
4364   (gnus-group-position-point))
4366 (defun gnus-group-list-dormant (level &optional lowest)
4367   "List all groups with dormant articles.
4369 level to cut off listing groups.
4370 If LOWEST, don't list groups with level lower than LOWEST.
4376   (when (or (not level) (>= level gnus-level-zombie))
4377     (gnus-cache-open))
4378   (funcall gnus-group-prepare-function
4379 	   (or level gnus-level-subscribed)
4381 	       (let ((marks (gnus-info-marks info)))
4386   (gnus-group-position-point))
4388 (defun gnus-group-listed-groups ()
4389   "Return a list of listed groups."
4390   (let (point groups)
4393 					      'gnus-group nil))
4395       (push (symbol-name (get-text-property point 'gnus-group)) groups)
4397     groups))
4399 (defun gnus-group-list-plus (&optional args)
4400   "List groups plus the current selection."
4402   (let ((gnus-group-listed-groups (gnus-group-listed-groups))
4403 	(gnus-group-list-mode gnus-group-list-mode) ;; Save it.
4409     (let (gnus-pick-mode keys)
4419 (defun gnus-group-list-flush (&optional args)
4420   "Flush groups from the current selection."
4422   (let ((gnus-group-list-option 'flush))
4423     (gnus-group-list-plus args)))
4425 (defun gnus-group-list-limit (&optional args)
4426   "List groups limited within the current selection."
4428   (let ((gnus-group-list-option 'limit))
4429     (gnus-group-list-plus args)))
4431 (defun gnus-group-mark-article-read (group article)
4433   (let ((buffer (gnus-summary-buffer-name group))
4434 	(mark gnus-read-mark)
4438 	  (setq active gnus-newsgroup-active)
4439 	  (gnus-activate-group group)
4440 	  (when gnus-newsgroup-prepared
4441 	    (when (and gnus-newsgroup-auto-expire
4442 		       (memq mark gnus-auto-expirable-marks))
4443 	      (setq mark gnus-expirable-mark))
4444 	    (setq mark (gnus-request-update-mark
4445 			group article mark))
4446 	    (gnus-mark-article-as-read article mark)
4447 	    (setq gnus-newsgroup-active (gnus-active group))
4450 	      (while (<= n (cdr gnus-newsgroup-active))
4452 		  (push n gnus-newsgroup-unselected))
4454 	      (setq gnus-newsgroup-unselected
4455 		    (nreverse gnus-newsgroup-unselected)))))
4456       (gnus-activate-group group)
4457       (gnus-group-make-articles-read group (list article))
4458       (when (gnus-group-auto-expirable-p group)
4459 	(gnus-add-marked-articles
4460 	 group 'expire (list article))))))
4462 (provide 'gnus-group)
4465 ;;; gnus-group.el ends here