/[emacs]/emacs/lisp/gnus/gnus-group.el
ViewVC logotype

Diff of /emacs/lisp/gnus/gnus-group.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.19.2.2 by miles, Tue Oct 14 23:34:50 2003 UTC revision 1.19.2.3 by miles, Thu Sep 16 00:12:15 2004 UTC
# Line 1  Line 1 
1  ;;; gnus-group.el --- group mode commands for Gnus  ;;; gnus-group.el --- group mode commands for Gnus
2  ;; Copyright (C) 1996, 1997, 1998, 1999, 2000  ;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004
3  ;;        Free Software Foundation, Inc.  ;;        Free Software Foundation, Inc.
4    
5  ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>  ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
# Line 26  Line 26 
26    
27  ;;; Code:  ;;; Code:
28    
29  (eval-when-compile (require 'cl))  (eval-when-compile
30      (require 'cl)
31      (defvar tool-bar-map))
32    
33  (require 'gnus)  (require 'gnus)
34  (require 'gnus-start)  (require 'gnus-start)
# Line 37  Line 39 
39  (require 'gnus-win)  (require 'gnus-win)
40  (require 'gnus-undo)  (require 'gnus-undo)
41  (require 'time-date)  (require 'time-date)
42    (require 'gnus-ems)
43    
44    (eval-when-compile (require 'mm-url))
45    
46  (defcustom gnus-group-archive-directory  (defcustom gnus-group-archive-directory
47    "*ftp@ftp.hpc.uh.edu:/pub/emacs/ding-list/"    "*ftp@ftp.hpc.uh.edu:/pub/emacs/ding-list/"
# Line 117  This function will be called with group Line 122  This function will be called with group
122  for the groups to be sorted.  Pre-made functions include  for the groups to be sorted.  Pre-made functions include
123  `gnus-group-sort-by-alphabet', `gnus-group-sort-by-real-name',  `gnus-group-sort-by-alphabet', `gnus-group-sort-by-real-name',
124  `gnus-group-sort-by-unread', `gnus-group-sort-by-level',  `gnus-group-sort-by-unread', `gnus-group-sort-by-level',
125  `gnus-group-sort-by-score', `gnus-group-sort-by-method', and  `gnus-group-sort-by-score', `gnus-group-sort-by-method',
126  `gnus-group-sort-by-rank'.  `gnus-group-sort-by-server', and `gnus-group-sort-by-rank'.
127    
128  This variable can also be a list of sorting functions.  In that case,  This variable can also be a list of sorting functions.  In that case,
129  the most significant sort function should be the last function in the  the most significant sort function should be the last function in the
130  list."  list."
131    :group 'gnus-group-listing    :group 'gnus-group-listing
132    :link '(custom-manual "(gnus)Sorting Groups")    :link '(custom-manual "(gnus)Sorting Groups")
133    :type '(radio (function-item gnus-group-sort-by-alphabet)    :type '(repeat :value-to-internal (lambda (widget value)
134                  (function-item gnus-group-sort-by-real-name)                                        (if (listp value) value (list value)))
135                  (function-item gnus-group-sort-by-unread)                   :match (lambda (widget value)
136                  (function-item gnus-group-sort-by-level)                            (or (symbolp value)
137                  (function-item gnus-group-sort-by-score)                                (widget-editable-list-match widget value)))
138                  (function-item gnus-group-sort-by-method)                   (choice (function-item gnus-group-sort-by-alphabet)
139                  (function-item gnus-group-sort-by-rank)                           (function-item gnus-group-sort-by-real-name)
140                  (function :tag "other" nil)))                           (function-item gnus-group-sort-by-unread)
141                             (function-item gnus-group-sort-by-level)
142                             (function-item gnus-group-sort-by-score)
143                             (function-item gnus-group-sort-by-method)
144                             (function-item gnus-group-sort-by-server)
145                             (function-item gnus-group-sort-by-rank)
146                             (function :tag "other" nil))))
147    
148  (defcustom gnus-group-line-format "%M\%S\%p\%P\%5y: %(%g%)%l\n"  (defcustom gnus-group-line-format "%M\%S\%p\%P\%5y:%B%(%g%)%l %O\n"
149    "*Format of group lines.    "*Format of group lines.
150  It works along the same lines as a normal formatting string,  It works along the same lines as a normal formatting string,
151  with some simple extensions.  with some simple extensions.
# Line 147  with some simple extensions. Line 158  with some simple extensions.
158  %i    Number of ticked and dormant (integer)  %i    Number of ticked and dormant (integer)
159  %T    Number of ticked articles (integer)  %T    Number of ticked articles (integer)
160  %R    Number of read articles (integer)  %R    Number of read articles (integer)
161    %U    Number of unseen articles (integer)
162  %t    Estimated total number of articles (integer)  %t    Estimated total number of articles (integer)
163  %y    Number of unread, unticked articles (integer)  %y    Number of unread, unticked articles (integer)
164  %G    Group name (string)  %G    Group name (string)
165  %g    Qualified group name (string)  %g    Qualified group name (string)
166    %c    Short (collapsed) group name.  See `gnus-group-uncollapsed-levels'.
167    %C    Group comment (string)
168  %D    Group description (string)  %D    Group description (string)
169  %s    Select method (string)  %s    Select method (string)
170  %o    Moderated group (char, \"m\")  %o    Moderated group (char, \"m\")
171  %p    Process mark (char)  %p    Process mark (char)
172    %B    Whether a summary buffer for the group is open (char, \"*\")
173  %O    Moderated group (string, \"(m)\" or \"\")  %O    Moderated group (string, \"(m)\" or \"\")
174  %P    Topic indentation (string)  %P    Topic indentation (string)
175  %m    Whether there is new(ish) mail in the group (char, \"%\")  %m    Whether there is new(ish) mail in the group (char, \"%\")
# Line 165  with some simple extensions. Line 180  with some simple extensions.
180  %E    Icon as defined by `gnus-group-icon-list'.  %E    Icon as defined by `gnus-group-icon-list'.
181  %u    User defined specifier.  The next character in the format string should  %u    User defined specifier.  The next character in the format string should
182        be a letter.  Gnus will call the function gnus-user-format-function-X,        be a letter.  Gnus will call the function gnus-user-format-function-X,
183        where X is the letter following %u.  The function will be passed the        where X is the letter following %u.  The function will be passed a
184        current header as argument.  The function should return a string, which        single dummy parameter as argument.  The function should return a
185        will be inserted into the buffer just like information from any other        string, which will be inserted into the buffer just like information
186        group specifier.        from any other group specifier.
   
 Text between %( and %) will be highlighted with `gnus-mouse-face' when  
 the mouse point move inside the area.  There can only be one such area.  
187    
188  Note that this format specification is not always respected.  For  Note that this format specification is not always respected.  For
189  reasons of efficiency, when listing killed groups, this specification  reasons of efficiency, when listing killed groups, this specification
# Line 183  If you use %o or %O, reading the active Line 195  If you use %o or %O, reading the active
195  a bit of extra memory will be used.  %D will also worsen performance.  a bit of extra memory will be used.  %D will also worsen performance.
196  Also note that if you change the format specification to include any  Also note that if you change the format specification to include any
197  of these specs, you must probably re-start Gnus to see them go into  of these specs, you must probably re-start Gnus to see them go into
198  effect."  effect.
199    
200    General format specifiers can also be used.
201    See Info node `(gnus)Formatting Variables'."
202      :link '(custom-manual "(gnus)Formatting Variables")
203    :group 'gnus-group-visual    :group 'gnus-group-visual
204    :type 'string)    :type 'string)
205    
# Line 198  with some simple extensions: Line 214  with some simple extensions:
214    :group 'gnus-group-visual    :group 'gnus-group-visual
215    :type 'string)    :type 'string)
216    
217  (defcustom gnus-group-mode-hook nil  ;; Extracted from gnus-xmas-redefine in order to preserve user settings
218    "Hook for Gnus group mode."  (when (featurep 'xemacs)
219    :group 'gnus-group-various    (add-hook 'gnus-group-mode-hook 'gnus-xmas-group-menu-add)
220    :options '(gnus-topic-mode)    (add-hook 'gnus-group-mode-hook 'gnus-xmas-setup-group-toolbar))
   :type 'hook)  
221    
222  (defcustom gnus-group-menu-hook nil  (defcustom gnus-group-menu-hook nil
223    "Hook run after the creation of the group mode menu."    "Hook run after the creation of the group mode menu."
# Line 288  variable." Line 303  variable."
303                         (sexp :tag "Method"))))                         (sexp :tag "Method"))))
304    
305  (defcustom gnus-group-highlight  (defcustom gnus-group-highlight
306    '(;; News.    '(;; Mail.
307      ((and (= unread 0) (not mailp) (eq level 1)) .      ((and mailp (= unread 0) (eq level 1)) .
308         gnus-group-mail-1-empty-face)
309        ((and mailp (eq level 1)) .
310         gnus-group-mail-1-face)
311        ((and mailp (= unread 0) (eq level 2)) .
312         gnus-group-mail-2-empty-face)
313        ((and mailp (eq level 2)) .
314         gnus-group-mail-2-face)
315        ((and mailp (= unread 0) (eq level 3)) .
316         gnus-group-mail-3-empty-face)
317        ((and mailp (eq level 3)) .
318         gnus-group-mail-3-face)
319        ((and mailp (= unread 0)) .
320         gnus-group-mail-low-empty-face)
321        ((and mailp) .
322         gnus-group-mail-low-face)
323        ;; News.
324        ((and (= unread 0) (eq level 1)) .
325       gnus-group-news-1-empty-face)       gnus-group-news-1-empty-face)
326      ((and (not mailp) (eq level 1)) .      ((and (eq level 1)) .
327       gnus-group-news-1-face)       gnus-group-news-1-face)
328      ((and (= unread 0) (not mailp) (eq level 2)) .      ((and (= unread 0) (eq level 2)) .
329       gnus-group-news-2-empty-face)       gnus-group-news-2-empty-face)
330      ((and (not mailp) (eq level 2)) .      ((and (eq level 2)) .
331       gnus-group-news-2-face)       gnus-group-news-2-face)
332      ((and (= unread 0) (not mailp) (eq level 3)) .      ((and (= unread 0) (eq level 3)) .
333       gnus-group-news-3-empty-face)       gnus-group-news-3-empty-face)
334      ((and (not mailp) (eq level 3)) .      ((and (eq level 3)) .
335       gnus-group-news-3-face)       gnus-group-news-3-face)
336      ((and (= unread 0) (not mailp) (eq level 4)) .      ((and (= unread 0) (eq level 4)) .
337       gnus-group-news-4-empty-face)       gnus-group-news-4-empty-face)
338      ((and (not mailp) (eq level 4)) .      ((and (eq level 4)) .
339       gnus-group-news-4-face)       gnus-group-news-4-face)
340      ((and (= unread 0) (not mailp) (eq level 5)) .      ((and (= unread 0) (eq level 5)) .
341       gnus-group-news-5-empty-face)       gnus-group-news-5-empty-face)
342      ((and (not mailp) (eq level 5)) .      ((and (eq level 5)) .
343       gnus-group-news-5-face)       gnus-group-news-5-face)
344      ((and (= unread 0) (not mailp) (eq level 6)) .      ((and (= unread 0) (eq level 6)) .
345       gnus-group-news-6-empty-face)       gnus-group-news-6-empty-face)
346      ((and (not mailp) (eq level 6)) .      ((and (eq level 6)) .
347       gnus-group-news-6-face)       gnus-group-news-6-face)
348      ((and (= unread 0) (not mailp)) .      ((and (= unread 0)) .
349       gnus-group-news-low-empty-face)       gnus-group-news-low-empty-face)
     ((and (not mailp)) .  
      gnus-group-news-low-face)  
     ;; Mail.  
     ((and (= unread 0) (eq level 1)) .  
      gnus-group-mail-1-empty-face)  
     ((eq level 1) .  
      gnus-group-mail-1-face)  
     ((and (= unread 0) (eq level 2)) .  
      gnus-group-mail-2-empty-face)  
     ((eq level 2) .  
      gnus-group-mail-2-face)  
     ((and (= unread 0) (eq level 3)) .  
      gnus-group-mail-3-empty-face)  
     ((eq level 3) .  
      gnus-group-mail-3-face)  
     ((= unread 0) .  
      gnus-group-mail-low-empty-face)  
350      (t .      (t .
351         gnus-group-mail-low-face))       gnus-group-news-low-face))
352    "*Controls the highlighting of group buffer lines.    "*Controls the highlighting of group buffer lines.
353    
354  Below is a list of `Form'/`Face' pairs.  When deciding how a a  Below is a list of `Form'/`Face' pairs.  When deciding how a a
# Line 395  ticked: The number of ticked articles." Line 410  ticked: The number of ticked articles."
410    :type '(repeat (cons (sexp :tag "Form") file)))    :type '(repeat (cons (sexp :tag "Form") file)))
411    
412  (defcustom gnus-group-name-charset-method-alist nil  (defcustom gnus-group-name-charset-method-alist nil
413    "*Alist of method and the charset for group names.    "Alist of method and the charset for group names.
414    
415  For example:  For example:
416      (((nntp \"news.com.cn\") . cn-gb-2312))      (((nntp \"news.com.cn\") . cn-gb-2312))"
 "  
417    :version "21.1"    :version "21.1"
418    :group 'gnus-charset    :group 'gnus-charset
419    :type '(repeat (cons (sexp :tag "Method") (symbol :tag "Charset"))))    :type '(repeat (cons (sexp :tag "Method") (symbol :tag "Charset"))))
420    
421  (defcustom gnus-group-name-charset-group-alist nil  (defcustom gnus-group-name-charset-group-alist
422    "*Alist of group regexp and the charset for group names.    (if (or (and (fboundp 'find-coding-system) (find-coding-system 'utf-8))
423              (mm-coding-system-p 'utf-8))
424          '((".*" . utf-8))
425        nil)
426      "Alist of group regexp and the charset for group names.
427    
428  For example:  For example:
429      ((\"\\.com\\.cn:\" . cn-gb-2312))      ((\"\\.com\\.cn:\" . cn-gb-2312))"
 "  
430    :group 'gnus-charset    :group 'gnus-charset
431    :type '(repeat (cons (regexp :tag "Group") (symbol :tag "Charset"))))    :type '(repeat (cons (regexp :tag "Group") (symbol :tag "Charset"))))
432    
433    (defcustom gnus-group-jump-to-group-prompt nil
434      "Default prompt for `gnus-group-jump-to-group'.
435    If non-nil, the value should be a string, e.g. \"nnml:\",
436    in which case `gnus-group-jump-to-group' offers \"Group: nnml:\"
437    in the minibuffer prompt."
438      :group 'gnus-group-various
439      :type '(choice (string :tag "Prompt string")
440                     (const :tag "Empty" nil)))
441    
442    (defvar gnus-group-listing-limit 1000
443      "*A limit of the number of groups when listing.
444    If the number of groups is larger than the limit, list them in a
445    simple manner.")
446    
447  ;;; Internal variables  ;;; Internal variables
448    
449    (defvar gnus-group-is-exiting-p nil)
450    (defvar gnus-group-is-exiting-without-update-p nil)
451  (defvar gnus-group-sort-alist-function 'gnus-group-sort-flat  (defvar gnus-group-sort-alist-function 'gnus-group-sort-flat
452    "Function for sorting the group buffer.")    "Function for sorting the group buffer.")
453    
# Line 441  For example: Line 474  For example:
474                     (gnus-range-length (cdr (assq 'tick gnus-tmp-marked))))))                     (gnus-range-length (cdr (assq 'tick gnus-tmp-marked))))))
475                (t number)) ?s)                (t number)) ?s)
476      (?R gnus-tmp-number-of-read ?s)      (?R gnus-tmp-number-of-read ?s)
477        (?U (gnus-number-of-unseen-articles-in-group gnus-tmp-group) ?d)
478      (?t gnus-tmp-number-total ?d)      (?t gnus-tmp-number-total ?d)
479      (?y gnus-tmp-number-of-unread ?s)      (?y gnus-tmp-number-of-unread ?s)
480      (?I (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked))) ?d)      (?I (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked))) ?d)
# Line 450  For example: Line 484  For example:
484      (?g gnus-tmp-group ?s)      (?g gnus-tmp-group ?s)
485      (?G gnus-tmp-qualified-group ?s)      (?G gnus-tmp-qualified-group ?s)
486      (?c (gnus-short-group-name gnus-tmp-group) ?s)      (?c (gnus-short-group-name gnus-tmp-group) ?s)
487        (?C gnus-tmp-comment ?s)
488      (?D gnus-tmp-newsgroup-description ?s)      (?D gnus-tmp-newsgroup-description ?s)
489      (?o gnus-tmp-moderated ?c)      (?o gnus-tmp-moderated ?c)
490      (?O gnus-tmp-moderated-string ?s)      (?O gnus-tmp-moderated-string ?s)
# Line 458  For example: Line 493  For example:
493      (?n gnus-tmp-news-method ?s)      (?n gnus-tmp-news-method ?s)
494      (?P gnus-group-indentation ?s)      (?P gnus-group-indentation ?s)
495      (?E gnus-tmp-group-icon ?s)      (?E gnus-tmp-group-icon ?s)
496        (?B gnus-tmp-summary-live ?c)
497      (?l gnus-tmp-grouplens ?s)      (?l gnus-tmp-grouplens ?s)
498      (?z gnus-tmp-news-method-string ?s)      (?z gnus-tmp-news-method-string ?s)
499      (?m (gnus-group-new-mail gnus-tmp-group) ?c)      (?m (gnus-group-new-mail gnus-tmp-group) ?c)
# Line 483  For example: Line 519  For example:
519    
520  (defvar gnus-group-icon-cache nil)  (defvar gnus-group-icon-cache nil)
521    
522    (defvar gnus-group-listed-groups nil)
523    (defvar gnus-group-list-option nil)
524    
525  ;;;  ;;;
526  ;;; Gnus group mode  ;;; Gnus group mode
527  ;;;  ;;;
528    
529  (put 'gnus-group-mode 'mode-class 'special)  (put 'gnus-group-mode 'mode-class 'special)
530    
531  (when t  (gnus-define-keys gnus-group-mode-map
532    (gnus-define-keys gnus-group-mode-map    " " gnus-group-read-group
533      " " gnus-group-read-group    "=" gnus-group-select-group
534      "=" gnus-group-select-group    "\r" gnus-group-select-group
535      "\r" gnus-group-select-group    "\M-\r" gnus-group-quick-select-group
536      "\M-\r" gnus-group-quick-select-group    "\M- " gnus-group-visible-select-group
537      "\M- " gnus-group-visible-select-group    [(meta control return)] gnus-group-select-group-ephemerally
538      [(meta control return)] gnus-group-select-group-ephemerally    "j" gnus-group-jump-to-group
539      "j" gnus-group-jump-to-group    "n" gnus-group-next-unread-group
540      "n" gnus-group-next-unread-group    "p" gnus-group-prev-unread-group
541      "p" gnus-group-prev-unread-group    "\177" gnus-group-prev-unread-group
542      "\177" gnus-group-prev-unread-group    [delete] gnus-group-prev-unread-group
543      [delete] gnus-group-prev-unread-group    [backspace] gnus-group-prev-unread-group
544      [backspace] gnus-group-prev-unread-group    "N" gnus-group-next-group
545      "N" gnus-group-next-group    "P" gnus-group-prev-group
546      "P" gnus-group-prev-group    "\M-n" gnus-group-next-unread-group-same-level
547      "\M-n" gnus-group-next-unread-group-same-level    "\M-p" gnus-group-prev-unread-group-same-level
548      "\M-p" gnus-group-prev-unread-group-same-level    "," gnus-group-best-unread-group
549      "," gnus-group-best-unread-group    "." gnus-group-first-unread-group
550      "." gnus-group-first-unread-group    "u" gnus-group-unsubscribe-current-group
551      "u" gnus-group-unsubscribe-current-group    "U" gnus-group-unsubscribe-group
552      "U" gnus-group-unsubscribe-group    "c" gnus-group-catchup-current
553      "c" gnus-group-catchup-current    "C" gnus-group-catchup-current-all
554      "C" gnus-group-catchup-current-all    "\M-c" gnus-group-clear-data
555      "\M-c" gnus-group-clear-data    "l" gnus-group-list-groups
556      "l" gnus-group-list-groups    "L" gnus-group-list-all-groups
557      "L" gnus-group-list-all-groups    "m" gnus-group-mail
558      "m" gnus-group-mail    "i" gnus-group-news
559      "g" gnus-group-get-new-news    "g" gnus-group-get-new-news
560      "\M-g" gnus-group-get-new-news-this-group    "\M-g" gnus-group-get-new-news-this-group
561      "R" gnus-group-restart    "R" gnus-group-restart
562      "r" gnus-group-read-init-file    "r" gnus-group-read-init-file
563      "B" gnus-group-browse-foreign-server    "B" gnus-group-browse-foreign-server
564      "b" gnus-group-check-bogus-groups    "b" gnus-group-check-bogus-groups
565      "F" gnus-group-find-new-groups    "F" gnus-group-find-new-groups
566      "\C-c\C-d" gnus-group-describe-group    "\C-c\C-d" gnus-group-describe-group
567      "\M-d" gnus-group-describe-all-groups    "\M-d" gnus-group-describe-all-groups
568      "\C-c\C-a" gnus-group-apropos    "\C-c\C-a" gnus-group-apropos
569      "\C-c\M-\C-a" gnus-group-description-apropos    "\C-c\M-\C-a" gnus-group-description-apropos
570      "a" gnus-group-post-news    "a" gnus-group-post-news
571      "\ek" gnus-group-edit-local-kill    "\ek" gnus-group-edit-local-kill
572      "\eK" gnus-group-edit-global-kill    "\eK" gnus-group-edit-global-kill
573      "\C-k" gnus-group-kill-group    "\C-k" gnus-group-kill-group
574      "\C-y" gnus-group-yank-group    "\C-y" gnus-group-yank-group
575      "\C-w" gnus-group-kill-region    "\C-w" gnus-group-kill-region
576      "\C-x\C-t" gnus-group-transpose-groups    "\C-x\C-t" gnus-group-transpose-groups
577      "\C-c\C-l" gnus-group-list-killed    "\C-c\C-l" gnus-group-list-killed
578      "\C-c\C-x" gnus-group-expire-articles    "\C-c\C-x" gnus-group-expire-articles
579      "\C-c\M-\C-x" gnus-group-expire-all-groups    "\C-c\M-\C-x" gnus-group-expire-all-groups
580      "V" gnus-version    "V" gnus-version
581      "s" gnus-group-save-newsrc    "s" gnus-group-save-newsrc
582      "z" gnus-group-suspend    "z" gnus-group-suspend
583      "q" gnus-group-exit    "q" gnus-group-exit
584      "Q" gnus-group-quit    "Q" gnus-group-quit
585      "?" gnus-group-describe-briefly    "?" gnus-group-describe-briefly
586      "\C-c\C-i" gnus-info-find-node    "\C-c\C-i" gnus-info-find-node
587      "\M-e" gnus-group-edit-group-method    "\M-e" gnus-group-edit-group-method
588      "^" gnus-group-enter-server-mode    "^" gnus-group-enter-server-mode
589      gnus-mouse-2 gnus-mouse-pick-group    gnus-mouse-2 gnus-mouse-pick-group
590      "<" beginning-of-buffer    "<" beginning-of-buffer
591      ">" end-of-buffer    ">" end-of-buffer
592      "\C-c\C-b" gnus-bug    "\C-c\C-b" gnus-bug
593      "\C-c\C-s" gnus-group-sort-groups    "\C-c\C-s" gnus-group-sort-groups
594      "t" gnus-topic-mode    "t" gnus-topic-mode
595      "\C-c\M-g" gnus-activate-all-groups    "\C-c\M-g" gnus-activate-all-groups
596      "\M-&" gnus-group-universal-argument    "\M-&" gnus-group-universal-argument
597      "#" gnus-group-mark-group    "#" gnus-group-mark-group
598      "\M-#" gnus-group-unmark-group)    "\M-#" gnus-group-unmark-group)
599    
600    (gnus-define-keys (gnus-group-mark-map "M" gnus-group-mode-map)  (gnus-define-keys (gnus-group-mark-map "M" gnus-group-mode-map)
601      "m" gnus-group-mark-group    "m" gnus-group-mark-group
602      "u" gnus-group-unmark-group    "u" gnus-group-unmark-group
603      "w" gnus-group-mark-region    "w" gnus-group-mark-region
604      "b" gnus-group-mark-buffer    "b" gnus-group-mark-buffer
605      "r" gnus-group-mark-regexp    "r" gnus-group-mark-regexp
606      "U" gnus-group-unmark-all-groups)    "U" gnus-group-unmark-all-groups)
607    
608    (gnus-define-keys (gnus-group-group-map "G" gnus-group-mode-map)  (gnus-define-keys (gnus-group-sieve-map "D" gnus-group-mode-map)
609      "d" gnus-group-make-directory-group    "u" gnus-sieve-update
610      "h" gnus-group-make-help-group    "g" gnus-sieve-generate)
611      "u" gnus-group-make-useful-group  
612      "a" gnus-group-make-archive-group  (gnus-define-keys (gnus-group-group-map "G" gnus-group-mode-map)
613      "k" gnus-group-make-kiboze-group    "d" gnus-group-make-directory-group
614      "l" gnus-group-nnimap-edit-acl    "h" gnus-group-make-help-group
615      "m" gnus-group-make-group    "u" gnus-group-make-useful-group
616      "E" gnus-group-edit-group    "a" gnus-group-make-archive-group
617      "e" gnus-group-edit-group-method    "k" gnus-group-make-kiboze-group
618      "p" gnus-group-edit-group-parameters    "l" gnus-group-nnimap-edit-acl
619      "v" gnus-group-add-to-virtual    "m" gnus-group-make-group
620      "V" gnus-group-make-empty-virtual    "E" gnus-group-edit-group
621      "D" gnus-group-enter-directory    "e" gnus-group-edit-group-method
622      "f" gnus-group-make-doc-group    "p" gnus-group-edit-group-parameters
623      "w" gnus-group-make-web-group    "v" gnus-group-add-to-virtual
624      "r" gnus-group-rename-group    "V" gnus-group-make-empty-virtual
625      "c" gnus-group-customize    "D" gnus-group-enter-directory
626      "x" gnus-group-nnimap-expunge    "f" gnus-group-make-doc-group
627      "\177" gnus-group-delete-group    "w" gnus-group-make-web-group
628      [delete] gnus-group-delete-group)    "M" gnus-group-read-ephemeral-group
629      "r" gnus-group-rename-group
630    (gnus-define-keys (gnus-group-soup-map "s" gnus-group-group-map)    "R" gnus-group-make-rss-group
631      "b" gnus-group-brew-soup    "c" gnus-group-customize
632      "w" gnus-soup-save-areas    "x" gnus-group-nnimap-expunge
633      "s" gnus-soup-send-replies    "\177" gnus-group-delete-group
634      "p" gnus-soup-pack-packet    [delete] gnus-group-delete-group)
635      "r" nnsoup-pack-replies)  
636    (gnus-define-keys (gnus-group-soup-map "s" gnus-group-group-map)
637    (gnus-define-keys (gnus-group-sort-map "S" gnus-group-group-map)    "b" gnus-group-brew-soup
638      "s" gnus-group-sort-groups    "w" gnus-soup-save-areas
639      "a" gnus-group-sort-groups-by-alphabet    "s" gnus-soup-send-replies
640      "u" gnus-group-sort-groups-by-unread    "p" gnus-soup-pack-packet
641      "l" gnus-group-sort-groups-by-level    "r" nnsoup-pack-replies)
642      "v" gnus-group-sort-groups-by-score  
643      "r" gnus-group-sort-groups-by-rank  (gnus-define-keys (gnus-group-sort-map "S" gnus-group-group-map)
644      "m" gnus-group-sort-groups-by-method)    "s" gnus-group-sort-groups
645      "a" gnus-group-sort-groups-by-alphabet
646    (gnus-define-keys (gnus-group-sort-selected-map "P" gnus-group-group-map)    "u" gnus-group-sort-groups-by-unread
647      "s" gnus-group-sort-selected-groups    "l" gnus-group-sort-groups-by-level
648      "a" gnus-group-sort-selected-groups-by-alphabet    "v" gnus-group-sort-groups-by-score
649      "u" gnus-group-sort-selected-groups-by-unread    "r" gnus-group-sort-groups-by-rank
650      "l" gnus-group-sort-selected-groups-by-level    "m" gnus-group-sort-groups-by-method
651      "v" gnus-group-sort-selected-groups-by-score    "n" gnus-group-sort-groups-by-real-name)
652      "r" gnus-group-sort-selected-groups-by-rank  
653      "m" gnus-group-sort-selected-groups-by-method)  (gnus-define-keys (gnus-group-sort-selected-map "P" gnus-group-group-map)
654      "s" gnus-group-sort-selected-groups
655    (gnus-define-keys (gnus-group-list-map "A" gnus-group-mode-map)    "a" gnus-group-sort-selected-groups-by-alphabet
656      "k" gnus-group-list-killed    "u" gnus-group-sort-selected-groups-by-unread
657      "z" gnus-group-list-zombies    "l" gnus-group-sort-selected-groups-by-level
658      "s" gnus-group-list-groups    "v" gnus-group-sort-selected-groups-by-score
659      "u" gnus-group-list-all-groups    "r" gnus-group-sort-selected-groups-by-rank
660      "A" gnus-group-list-active    "m" gnus-group-sort-selected-groups-by-method
661      "a" gnus-group-apropos    "n" gnus-group-sort-selected-groups-by-real-name)
662      "d" gnus-group-description-apropos  
663      "m" gnus-group-list-matching  (gnus-define-keys (gnus-group-list-map "A" gnus-group-mode-map)
664      "M" gnus-group-list-all-matching    "k" gnus-group-list-killed
665      "l" gnus-group-list-level    "z" gnus-group-list-zombies
666      "c" gnus-group-list-cached    "s" gnus-group-list-groups
667      "?" gnus-group-list-dormant)    "u" gnus-group-list-all-groups
668      "A" gnus-group-list-active
669    (gnus-define-keys (gnus-group-score-map "W" gnus-group-mode-map)    "a" gnus-group-apropos
670      "f" gnus-score-flush-cache)    "d" gnus-group-description-apropos
671      "m" gnus-group-list-matching
672    (gnus-define-keys (gnus-group-help-map "H" gnus-group-mode-map)    "M" gnus-group-list-all-matching
673      "d" gnus-group-describe-group    "l" gnus-group-list-level
674      "f" gnus-group-fetch-faq    "c" gnus-group-list-cached
675      "v" gnus-version)    "?" gnus-group-list-dormant)
676    
677    (gnus-define-keys (gnus-group-sub-map "S" gnus-group-mode-map)  (gnus-define-keys (gnus-group-list-limit-map "/" gnus-group-list-map)
678      "l" gnus-group-set-current-level    "k"  gnus-group-list-limit
679      "t" gnus-group-unsubscribe-current-group    "z"  gnus-group-list-limit
680      "s" gnus-group-unsubscribe-group    "s"  gnus-group-list-limit
681      "k" gnus-group-kill-group    "u"  gnus-group-list-limit
682      "y" gnus-group-yank-group    "A"  gnus-group-list-limit
683      "w" gnus-group-kill-region    "m"  gnus-group-list-limit
684      "\C-k" gnus-group-kill-level    "M"  gnus-group-list-limit
685      "z" gnus-group-kill-all-zombies))    "l"  gnus-group-list-limit
686      "c"  gnus-group-list-limit
687      "?"  gnus-group-list-limit)
688    
689    (gnus-define-keys (gnus-group-list-flush-map "f" gnus-group-list-map)
690      "k"  gnus-group-list-flush
691      "z"  gnus-group-list-flush
692      "s"  gnus-group-list-flush
693      "u"  gnus-group-list-flush
694      "A"  gnus-group-list-flush
695      "m"  gnus-group-list-flush
696      "M"  gnus-group-list-flush
697      "l"  gnus-group-list-flush
698      "c"  gnus-group-list-flush
699      "?"  gnus-group-list-flush)
700    
701    (gnus-define-keys (gnus-group-list-plus-map "p" gnus-group-list-map)
702      "k"  gnus-group-list-plus
703      "z"  gnus-group-list-plus
704      "s"  gnus-group-list-plus
705      "u"  gnus-group-list-plus
706      "A"  gnus-group-list-plus
707      "m"  gnus-group-list-plus
708      "M"  gnus-group-list-plus
709      "l"  gnus-group-list-plus
710      "c"  gnus-group-list-plus
711      "?"  gnus-group-list-plus)
712    
713    (gnus-define-keys (gnus-group-score-map "W" gnus-group-mode-map)
714      "f" gnus-score-flush-cache)
715    
716    (gnus-define-keys (gnus-group-help-map "H" gnus-group-mode-map)
717      "c" gnus-group-fetch-charter
718      "C" gnus-group-fetch-control
719      "d" gnus-group-describe-group
720      "f" gnus-group-fetch-faq
721      "v" gnus-version)
722    
723    (gnus-define-keys (gnus-group-sub-map "S" gnus-group-mode-map)
724      "l" gnus-group-set-current-level
725      "t" gnus-group-unsubscribe-current-group
726      "s" gnus-group-unsubscribe-group
727      "k" gnus-group-kill-group
728      "y" gnus-group-yank-group
729      "w" gnus-group-kill-region
730      "\C-k" gnus-group-kill-level
731      "z" gnus-group-kill-all-zombies)
732    
733    (defun gnus-topic-mode-p ()
734      "Return non-nil in `gnus-topic-mode'."
735      (and (boundp 'gnus-topic-mode)
736           (symbol-value 'gnus-topic-mode)))
737    
738  (defun gnus-group-make-menu-bar ()  (defun gnus-group-make-menu-bar ()
739    (gnus-turn-off-edit-menu 'group)    (gnus-turn-off-edit-menu 'group)
# Line 651  For example: Line 741  For example:
741    
742      (easy-menu-define      (easy-menu-define
743       gnus-group-reading-menu gnus-group-mode-map ""       gnus-group-reading-menu gnus-group-mode-map ""
744       '("Group"       `("Group"
745         ["Read" gnus-group-read-group (gnus-group-group-name)]         ["Read" gnus-group-read-group
746         ["Select" gnus-group-select-group (gnus-group-group-name)]          :included (not (gnus-topic-mode-p))
747            :active (gnus-group-group-name)]
748           ["Read " gnus-topic-read-group
749            :included (gnus-topic-mode-p)]
750           ["Select" gnus-group-select-group
751            :included (not (gnus-topic-mode-p))
752            :active (gnus-group-group-name)]
753           ["Select " gnus-topic-select-group
754            :included (gnus-topic-mode-p)]
755         ["See old articles" (gnus-group-select-group 'all)         ["See old articles" (gnus-group-select-group 'all)
756          :keys "C-u SPC" :active (gnus-group-group-name)]          :keys "C-u SPC" :active (gnus-group-group-name)]
757         ["Catch up" gnus-group-catchup-current :active (gnus-group-group-name)         ["Catch up" gnus-group-catchup-current
758          :help "Mark unread articles in the current group as read"]          :included (not (gnus-topic-mode-p))
759            :active (gnus-group-group-name)
760            ,@(if (featurep 'xemacs) nil
761                '(:help "Mark unread articles in the current group as read"))]
762           ["Catch up " gnus-topic-catchup-articles
763            :included (gnus-topic-mode-p)
764            ,@(if (featurep 'xemacs) nil
765                '(:help "Mark unread articles in the current group or topic as read"))]
766         ["Catch up all articles" gnus-group-catchup-current-all         ["Catch up all articles" gnus-group-catchup-current-all
767          (gnus-group-group-name)]          (gnus-group-group-name)]
768         ["Check for new articles" gnus-group-get-new-news-this-group         ["Check for new articles" gnus-group-get-new-news-this-group
769            :included (not (gnus-topic-mode-p))
770          :active (gnus-group-group-name)          :active (gnus-group-group-name)
771          :help "Check for new messages in current group"]          ,@(if (featurep 'xemacs) nil
772                '(:help "Check for new messages in current group"))]
773           ["Check for new articles " gnus-topic-get-new-news-this-topic
774            :included (gnus-topic-mode-p)
775            ,@(if (featurep 'xemacs) nil
776                '(:help "Check for new messages in current group or topic"))]
777         ["Toggle subscription" gnus-group-unsubscribe-current-group         ["Toggle subscription" gnus-group-unsubscribe-current-group
778          (gnus-group-group-name)]          (gnus-group-group-name)]
779         ["Kill" gnus-group-kill-group :active (gnus-group-group-name)         ["Kill" gnus-group-kill-group :active (gnus-group-group-name)
780          :help "Kill (remove) current group"]          ,@(if (featurep 'xemacs) nil
781                  '(:help "Kill (remove) current group"))]
782         ["Yank" gnus-group-yank-group gnus-list-of-killed-groups]         ["Yank" gnus-group-yank-group gnus-list-of-killed-groups]
783         ["Describe" gnus-group-describe-group :active (gnus-group-group-name)         ["Describe" gnus-group-describe-group :active (gnus-group-group-name)
784          :help "Display description of the current group"]          ,@(if (featurep 'xemacs) nil
785                '(:help "Display description of the current group"))]
786         ["Fetch FAQ" gnus-group-fetch-faq (gnus-group-group-name)]         ["Fetch FAQ" gnus-group-fetch-faq (gnus-group-group-name)]
787           ["Fetch charter" gnus-group-fetch-charter
788            :active (gnus-group-group-name)
789            ,@(if (featurep 'xemacs) nil
790                '(:help "Display the charter of the current group"))]
791           ["Fetch control message" gnus-group-fetch-control
792            :active (gnus-group-group-name)
793            ,@(if (featurep 'xemacs) nil
794                '(:help "Display the archived control message for the current group"))]
795         ;; Actually one should check, if any of the marked groups gives t for         ;; Actually one should check, if any of the marked groups gives t for
796         ;; (gnus-check-backend-function 'request-expire-articles ...)         ;; (gnus-check-backend-function 'request-expire-articles ...)
797         ["Expire articles" gnus-group-expire-articles         ["Expire articles" gnus-group-expire-articles
798          (or (and (gnus-group-group-name)          :included (not (gnus-topic-mode-p))
799                   (gnus-check-backend-function          :active (or (and (gnus-group-group-name)
800                    'request-expire-articles                           (gnus-check-backend-function
801                    (gnus-group-group-name))) gnus-group-marked)]                            'request-expire-articles
802         ["Set group level" gnus-group-set-current-level                            (gnus-group-group-name))) gnus-group-marked)]
803           ["Expire articles " gnus-topic-expire-articles
804            :included (gnus-topic-mode-p)]
805           ["Set group level..." gnus-group-set-current-level
806          (gnus-group-group-name)]          (gnus-group-group-name)]
807         ["Select quick" gnus-group-quick-select-group (gnus-group-group-name)]         ["Select quick" gnus-group-quick-select-group (gnus-group-group-name)]
808         ["Customize" gnus-group-customize (gnus-group-group-name)]         ["Customize" gnus-group-customize (gnus-group-group-name)]
809         ("Edit"         ("Edit"
810          ["Parameters" gnus-group-edit-group-parameters          ["Parameters" gnus-group-edit-group-parameters
811           (gnus-group-group-name)]           :included (not (gnus-topic-mode-p))
812             :active (gnus-group-group-name)]
813            ["Parameters " gnus-topic-edit-parameters
814             :included (gnus-topic-mode-p)]
815          ["Select method" gnus-group-edit-group-method          ["Select method" gnus-group-edit-group-method
816           (gnus-group-group-name)]           (gnus-group-group-name)]
817          ["Info" gnus-group-edit-group (gnus-group-group-name)]          ["Info" gnus-group-edit-group (gnus-group-group-name)]
# Line 715  For example: Line 842  For example:
842          ["Sort by score" gnus-group-sort-groups-by-score t]          ["Sort by score" gnus-group-sort-groups-by-score t]
843          ["Sort by level" gnus-group-sort-groups-by-level t]          ["Sort by level" gnus-group-sort-groups-by-level t]
844          ["Sort by unread" gnus-group-sort-groups-by-unread t]          ["Sort by unread" gnus-group-sort-groups-by-unread t]
845          ["Sort by name" gnus-group-sort-groups-by-alphabet t])          ["Sort by name" gnus-group-sort-groups-by-alphabet t]
846            ["Sort by real name" gnus-group-sort-groups-by-real-name t])
847         ("Sort process/prefixed"         ("Sort process/prefixed"
848          ["Default sort" gnus-group-sort-selected-groups          ["Default sort" gnus-group-sort-selected-groups
849           (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))]           (not (gnus-topic-mode-p))]
850          ["Sort by method" gnus-group-sort-selected-groups-by-method          ["Sort by method" gnus-group-sort-selected-groups-by-method
851           (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))]           (not (gnus-topic-mode-p))]
852          ["Sort by rank" gnus-group-sort-selected-groups-by-rank          ["Sort by rank" gnus-group-sort-selected-groups-by-rank
853           (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))]           (not (gnus-topic-mode-p))]
854          ["Sort by score" gnus-group-sort-selected-groups-by-score          ["Sort by score" gnus-group-sort-selected-groups-by-score
855           (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))]           (not (gnus-topic-mode-p))]
856          ["Sort by level" gnus-group-sort-selected-groups-by-level          ["Sort by level" gnus-group-sort-selected-groups-by-level
857           (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))]           (not (gnus-topic-mode-p))]
858          ["Sort by unread" gnus-group-sort-selected-groups-by-unread          ["Sort by unread" gnus-group-sort-selected-groups-by-unread
859           (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))]           (not (gnus-topic-mode-p))]
860          ["Sort by name" gnus-group-sort-selected-groups-by-alphabet          ["Sort by name" gnus-group-sort-selected-groups-by-alphabet
861           (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))])           (not (gnus-topic-mode-p))]
862            ["Sort by real name" gnus-group-sort-selected-groups-by-real-name
863             (not (gnus-topic-mode-p))])
864         ("Mark"         ("Mark"
865          ["Mark group" gnus-group-mark-group          ["Mark group" gnus-group-mark-group
866           (and (gnus-group-group-name)           (and (gnus-group-group-name)
# Line 740  For example: Line 870  For example:
870                (memq (gnus-group-group-name) gnus-group-marked))]                (memq (gnus-group-group-name) gnus-group-marked))]
871          ["Unmark all" gnus-group-unmark-all-groups gnus-group-marked]          ["Unmark all" gnus-group-unmark-all-groups gnus-group-marked]
872          ["Mark regexp..." gnus-group-mark-regexp t]          ["Mark regexp..." gnus-group-mark-regexp t]
873          ["Mark region" gnus-group-mark-region t]          ["Mark region" gnus-group-mark-region :active (gnus-mark-active-p)]
874          ["Mark buffer" gnus-group-mark-buffer t]          ["Mark buffer" gnus-group-mark-buffer t]
875          ["Execute command" gnus-group-universal-argument          ["Execute command" gnus-group-universal-argument
876           (or gnus-group-marked (gnus-group-group-name))])           (or gnus-group-marked (gnus-group-group-name))])
877         ("Subscribe"         ("Subscribe"
878          ["Subscribe to a group" gnus-group-unsubscribe-group t]          ["Subscribe to a group..." gnus-group-unsubscribe-group t]
879          ["Kill all newsgroups in region" gnus-group-kill-region t]          ["Kill all newsgroups in region" gnus-group-kill-region
880             :active (gnus-mark-active-p)]
881          ["Kill all zombie groups" gnus-group-kill-all-zombies          ["Kill all zombie groups" gnus-group-kill-all-zombies
882           gnus-zombie-list]           gnus-zombie-list]
883          ["Kill all groups on level..." gnus-group-kill-level t])          ["Kill all groups on level..." gnus-group-kill-level t])
884         ("Foreign groups"         ("Foreign groups"
885          ["Make a foreign group" gnus-group-make-group t]          ["Make a foreign group..." gnus-group-make-group t]
886          ["Add a directory group" gnus-group-make-directory-group t]          ["Add a directory group..." gnus-group-make-directory-group t]
887          ["Add the help group" gnus-group-make-help-group t]          ["Add the help group" gnus-group-make-help-group t]
888          ["Add the archive group" gnus-group-make-archive-group t]          ["Add the archive group" gnus-group-make-archive-group t]
889          ["Make a doc group" gnus-group-make-doc-group t]          ["Make a doc group..." gnus-group-make-doc-group t]
890          ["Make a web group" gnus-group-make-web-group t]          ["Make a web group..." gnus-group-make-web-group t]
891          ["Make a kiboze group" gnus-group-make-kiboze-group t]          ["Make a kiboze group..." gnus-group-make-kiboze-group t]
892          ["Make a virtual group" gnus-group-make-empty-virtual t]          ["Make a virtual group..." gnus-group-make-empty-virtual t]
893          ["Add a group to a virtual" gnus-group-add-to-virtual t]          ["Add a group to a virtual..." gnus-group-add-to-virtual t]
894          ["Rename group" gnus-group-rename-group          ["Make an ephemeral group..." gnus-group-read-ephemeral-group t]
895            ["Make an RSS group..." gnus-group-make-rss-group t]
896            ["Rename group..." gnus-group-rename-group
897           (gnus-check-backend-function           (gnus-check-backend-function
898            'request-rename-group (gnus-group-group-name))]            'request-rename-group (gnus-group-group-name))]
899          ["Delete group" gnus-group-delete-group          ["Delete group" gnus-group-delete-group
# Line 774  For example: Line 907  For example:
907          ["Next unread same level" gnus-group-next-unread-group-same-level t]          ["Next unread same level" gnus-group-next-unread-group-same-level t]
908          ["Previous unread same level"          ["Previous unread same level"
909           gnus-group-prev-unread-group-same-level t]           gnus-group-prev-unread-group-same-level t]
910          ["Jump to group" gnus-group-jump-to-group t]          ["Jump to group..." gnus-group-jump-to-group t]
911          ["First unread group" gnus-group-first-unread-group t]          ["First unread group" gnus-group-first-unread-group t]
912          ["Best unread group" gnus-group-best-unread-group t])          ["Best unread group" gnus-group-best-unread-group t])
913           ("Sieve"
914            ["Generate" gnus-sieve-generate t]
915            ["Generate and update" gnus-sieve-update t])
916         ["Delete bogus groups" gnus-group-check-bogus-groups t]         ["Delete bogus groups" gnus-group-check-bogus-groups t]
917         ["Find new newsgroups" gnus-group-find-new-groups t]         ["Find new newsgroups" gnus-group-find-new-groups t]
918         ["Transpose" gnus-group-transpose-groups         ["Transpose" gnus-group-transpose-groups
# Line 785  For example: Line 921  For example:
921    
922      (easy-menu-define      (easy-menu-define
923       gnus-group-misc-menu gnus-group-mode-map ""       gnus-group-misc-menu gnus-group-mode-map ""
924       '("Misc"       `("Gnus"
925         ("SOUP"         ("SOUP"
926          ["Pack replies" nnsoup-pack-replies (fboundp 'nnsoup-request-group)]          ["Pack replies" nnsoup-pack-replies (fboundp 'nnsoup-request-group)]
927          ["Send replies" gnus-soup-send-replies          ["Send replies" gnus-soup-send-replies
# Line 794  For example: Line 930  For example:
930          ["Save areas" gnus-soup-save-areas (fboundp 'gnus-soup-pack-packet)]          ["Save areas" gnus-soup-save-areas (fboundp 'gnus-soup-pack-packet)]
931          ["Brew SOUP" gnus-group-brew-soup (fboundp 'gnus-soup-pack-packet)])          ["Brew SOUP" gnus-group-brew-soup (fboundp 'gnus-soup-pack-packet)])
932         ["Send a mail" gnus-group-mail t]         ["Send a mail" gnus-group-mail t]
933         ["Post an article..." gnus-group-post-news t]         ["Send a message (mail or news)" gnus-group-post-news t]
934           ["Create a local message" gnus-group-news t]
935         ["Check for new news" gnus-group-get-new-news         ["Check for new news" gnus-group-get-new-news
936          :help "Get newly arrived articles"]          ,@(if (featurep 'xemacs) '(t)
937                '(:help "Get newly arrived articles"))
938            ]
939           ["Send queued messages" gnus-delay-send-queue
940            ,@(if (featurep 'xemacs) '(t)
941                '(:help "Send all messages that are scheduled to be sent now"))
942            ]
943         ["Activate all groups" gnus-activate-all-groups t]         ["Activate all groups" gnus-activate-all-groups t]
944         ["Restart Gnus" gnus-group-restart t]         ["Restart Gnus" gnus-group-restart t]
945         ["Read init file" gnus-group-read-init-file t]         ["Read init file" gnus-group-read-init-file t]
946         ["Browse foreign server" gnus-group-browse-foreign-server t]         ["Browse foreign server..." gnus-group-browse-foreign-server t]
947         ["Enter server buffer" gnus-group-enter-server-mode t]         ["Enter server buffer" gnus-group-enter-server-mode t]
948         ["Expire all expirable articles" gnus-group-expire-all-groups t]         ["Expire all expirable articles" gnus-group-expire-all-groups t]
949         ["Generate any kiboze groups" nnkiboze-generate-groups t]         ["Generate any kiboze groups" nnkiboze-generate-groups t]
# Line 813  For example: Line 956  For example:
956         ["Toggle topics" gnus-topic-mode t]         ["Toggle topics" gnus-topic-mode t]
957         ["Send a bug report" gnus-bug t]         ["Send a bug report" gnus-bug t]
958         ["Exit from Gnus" gnus-group-exit         ["Exit from Gnus" gnus-group-exit
959          :help "Quit reading news"]          ,@(if (featurep 'xemacs) '(t)
960                '(:help "Quit reading news"))]
961         ["Exit without saving" gnus-group-quit t]))         ["Exit without saving" gnus-group-quit t]))
962    
963      (gnus-run-hooks 'gnus-group-menu-hook)))      (gnus-run-hooks 'gnus-group-menu-hook)))
# Line 828  For example: Line 972  For example:
972         (default-value 'tool-bar-mode)         (default-value 'tool-bar-mode)
973         (not gnus-group-toolbar-map))         (not gnus-group-toolbar-map))
974        (setq gnus-group-toolbar-map        (setq gnus-group-toolbar-map
975              (let ((tool-bar-map (make-sparse-keymap)))              (let ((tool-bar-map (make-sparse-keymap))
976                      (load-path (mm-image-load-path)))
977                (tool-bar-add-item-from-menu                (tool-bar-add-item-from-menu
978                 'gnus-group-get-new-news "get-news" gnus-group-mode-map)                 'gnus-group-get-new-news "get-news" gnus-group-mode-map)
979                (tool-bar-add-item-from-menu                (tool-bar-add-item-from-menu
# Line 891  The following commands are available: Line 1036  The following commands are available:
1036  (defun gnus-update-group-mark-positions ()  (defun gnus-update-group-mark-positions ()
1037    (save-excursion    (save-excursion
1038      (let ((gnus-process-mark ?\200)      (let ((gnus-process-mark ?\200)
1039              (gnus-group-update-hook nil)
1040            (gnus-group-marked '("dummy.group"))            (gnus-group-marked '("dummy.group"))
1041            (gnus-active-hashtb (make-vector 10 0))            (gnus-active-hashtb (make-vector 10 0))
1042            (topic ""))            (topic ""))
# Line 932  The following commands are available: Line 1078  The following commands are available:
1078      (when gnus-carpal      (when gnus-carpal
1079        (gnus-carpal-setup-buffer 'group))))        (gnus-carpal-setup-buffer 'group))))
1080    
1081  (defsubst gnus-group-name-charset (method group)  (defun gnus-group-name-charset (method group)
1082    (if (null method)    (if (null method)
1083        (setq method (gnus-find-method-for-group group)))        (setq method (gnus-find-method-for-group group)))
1084    (let ((item (assoc method gnus-group-name-charset-method-alist))    (let ((item (assoc method gnus-group-name-charset-method-alist))
# Line 946  The following commands are available: Line 1092  The following commands are available:
1092                    result (cdr item))))                    result (cdr item))))
1093        result)))        result)))
1094    
1095  (defsubst gnus-group-name-decode (string charset)  (defun gnus-group-name-decode (string charset)
1096      ;; Fixme: Don't decode in unibyte mode.
1097    (if (and string charset (featurep 'mule))    (if (and string charset (featurep 'mule))
1098        (mm-decode-coding-string string charset)        (mm-decode-coding-string string charset)
1099      string))      string))
# Line 1028  If ALL (the prefix), also list groups th Line 1175  If ALL (the prefix), also list groups th
1175    (interactive "nList groups on level: \nP")    (interactive "nList groups on level: \nP")
1176    (gnus-group-list-groups level all level))    (gnus-group-list-groups level all level))
1177    
1178  (defun gnus-group-prepare-flat (level &optional all lowest regexp)  (defun gnus-group-prepare-logic (group test)
1179      (or (and gnus-group-listed-groups
1180               (null gnus-group-list-option)
1181               (member group gnus-group-listed-groups))
1182          (cond
1183           ((null gnus-group-listed-groups) test)
1184           ((null gnus-group-list-option) test)
1185           (t (and (member group gnus-group-listed-groups)
1186                   (if (eq gnus-group-list-option 'flush)
1187                       (not test)
1188                     test))))))
1189    
1190    (defun gnus-group-prepare-flat (level &optional predicate lowest regexp)
1191    "List all newsgroups with unread articles of level LEVEL or lower.    "List all newsgroups with unread articles of level LEVEL or lower.
1192  If ALL is non-nil, list groups that have no unread articles.  If PREDICATE is a function, list groups that the function returns non-nil;
1193    if it is t, list groups that have no unread articles.
1194  If LOWEST is non-nil, list all newsgroups of level LOWEST or higher.  If LOWEST is non-nil, list all newsgroups of level LOWEST or higher.
1195  If REGEXP, only list groups matching REGEXP."  If REGEXP is a function, list dead groups that the function returns non-nil;
1196    if it is a string, only list groups matching REGEXP."
1197    (set-buffer gnus-group-buffer)    (set-buffer gnus-group-buffer)
1198    (let ((buffer-read-only nil)    (let ((buffer-read-only nil)
1199          (newsrc (cdr gnus-newsrc-alist))          (newsrc (cdr gnus-newsrc-alist))
1200          (lowest (or lowest 1))          (lowest (or lowest 1))
1201            (not-in-list (and gnus-group-listed-groups
1202                              (copy-sequence gnus-group-listed-groups)))
1203          info clevel unread group params)          info clevel unread group params)
1204      (erase-buffer)      (erase-buffer)
1205      (when (< lowest gnus-level-zombie)      (when (or (< lowest gnus-level-zombie)
1206                  gnus-group-listed-groups)
1207        ;; List living groups.        ;; List living groups.
1208        (while newsrc        (while newsrc
1209          (setq info (car newsrc)          (setq info (car newsrc)
# Line 1047  If REGEXP, only list groups matching REG Line 1211  If REGEXP, only list groups matching REG
1211                params (gnus-info-params info)                params (gnus-info-params info)
1212                newsrc (cdr newsrc)                newsrc (cdr newsrc)
1213                unread (car (gnus-gethash group gnus-newsrc-hashtb)))                unread (car (gnus-gethash group gnus-newsrc-hashtb)))
1214          (and unread                     ; This group might be unchecked          (when not-in-list
1215               (or (not regexp)            (setq not-in-list (delete group not-in-list)))
1216                   (string-match regexp group))          (when (gnus-group-prepare-logic
1217               (<= (setq clevel (gnus-info-level info)) level)                 group
1218               (>= clevel lowest)                 (and unread              ; This group might be unchecked
1219               (or all                    ; We list all groups?                      (or (not (stringp regexp))
1220                   (if (eq unread t)      ; Unactivated?                          (string-match regexp group))
1221                       gnus-group-list-inactive-groups ; We list unactivated                      (<= (setq clevel (gnus-info-level info)) level)
1222                     (> unread 0))        ; We list groups with unread articles                      (>= clevel lowest)
1223                   (and gnus-list-groups-with-ticked-articles                      (cond
1224                        (cdr (assq 'tick (gnus-info-marks info))))                       ((functionp predicate)
1225                          (funcall predicate info))
1226                         (predicate t)      ; We list all groups?
1227                         (t
1228                          (or
1229                           (if (eq unread t) ; Unactivated?
1230                               gnus-group-list-inactive-groups
1231                                            ; We list unactivated
1232                             (> unread 0))
1233                                            ; We list groups with unread articles
1234                           (and gnus-list-groups-with-ticked-articles
1235                                (cdr (assq 'tick (gnus-info-marks info))))
1236                                          ; And groups with tickeds                                          ; And groups with tickeds
1237                   ;; Check for permanent visibility.                         ;; Check for permanent visibility.
1238                   (and gnus-permanently-visible-groups                         (and gnus-permanently-visible-groups
1239                        (string-match gnus-permanently-visible-groups                              (string-match gnus-permanently-visible-groups
1240                                      group))                                            group))
1241                   (memq 'visible params)                         (memq 'visible params)
1242                   (cdr (assq 'visible params)))                         (cdr (assq 'visible params)))))))
1243               (gnus-group-insert-group-line            (gnus-group-insert-group-line
1244                group (gnus-info-level info)             group (gnus-info-level info)
1245                (gnus-info-marks info) unread (gnus-info-method info)))))             (gnus-info-marks info) unread (gnus-info-method info)))))
1246    
1247      ;; List dead groups.      ;; List dead groups.
1248      (and (>= level gnus-level-zombie) (<= lowest gnus-level-zombie)      (when (or gnus-group-listed-groups
1249           (gnus-group-prepare-flat-list-dead                (and (>= level gnus-level-zombie)
1250            (setq gnus-zombie-list (sort gnus-zombie-list 'string<))                     (<= lowest gnus-level-zombie)))
1251            gnus-level-zombie ?Z        (gnus-group-prepare-flat-list-dead
1252            regexp))         (setq gnus-zombie-list (sort gnus-zombie-list 'string<))
1253      (and (>= level gnus-level-killed) (<= lowest gnus-level-killed)         gnus-level-zombie ?Z
1254           (gnus-group-prepare-flat-list-dead         regexp))
1255            (setq gnus-killed-list (sort gnus-killed-list 'string<))      (when not-in-list
1256            gnus-level-killed ?K regexp))        (dolist (group gnus-zombie-list)
1257            (setq not-in-list (delete group not-in-list))))
1258        (when (or gnus-group-listed-groups
1259                  (and (>= level gnus-level-killed) (<= lowest gnus-level-killed)))
1260          (gnus-group-prepare-flat-list-dead
1261           (gnus-union
1262            not-in-list
1263            (setq gnus-killed-list (sort gnus-killed-list 'string<)))
1264           gnus-level-killed ?K regexp))
1265    
1266      (gnus-group-set-mode-line)      (gnus-group-set-mode-line)
1267      (setq gnus-group-list-mode (cons level all))      (setq gnus-group-list-mode (cons level predicate))
1268      (gnus-run-hooks 'gnus-group-prepare-hook)      (gnus-run-hooks 'gnus-group-prepare-hook)
1269      t))      t))
1270    
# Line 1090  If REGEXP, only list groups matching REG Line 1273  If REGEXP, only list groups matching REG
1273    ;; suggested by Jack Vinson <vinson@unagi.cis.upenn.edu>.  It does    ;; suggested by Jack Vinson <vinson@unagi.cis.upenn.edu>.  It does
1274    ;; this by ignoring the group format specification altogether.    ;; this by ignoring the group format specification altogether.
1275    (let (group)    (let (group)
1276      (if regexp      (if (> (length groups) gnus-group-listing-limit)
         ;; This loop is used when listing groups that match some  
         ;; regexp.  
1277          (while groups          (while groups
1278            (setq group (pop groups))            (setq group (pop groups))
1279            (when (string-match regexp group)            (when (gnus-group-prepare-logic
1280                     group
1281                     (or (not regexp)
1282                         (and (stringp regexp) (string-match regexp group))
1283                         (and (functionp regexp) (funcall regexp group))))
1284              (gnus-add-text-properties              (gnus-add-text-properties
1285               (point) (prog1 (1+ (point))               (point) (prog1 (1+ (point))
1286                         (insert " " mark "     *: "                         (insert " " mark "     *: "
1287                                 (gnus-group-name-decode group                                 (gnus-group-decoded-name group)
                                                        (gnus-group-name-charset  
                                                         nil group))  
1288                                 "\n"))                                 "\n"))
1289               (list 'gnus-group (gnus-intern-safe group gnus-active-hashtb)               (list 'gnus-group (gnus-intern-safe group gnus-active-hashtb)
1290                     'gnus-unread t                     'gnus-unread t
1291                     'gnus-level level))))                     'gnus-level level))))
       ;; This loop is used when listing all groups.  
1292        (while groups        (while groups
1293          (setq group (pop groups))          (setq group (pop groups))
1294          (gnus-add-text-properties          (when (gnus-group-prepare-logic
1295           (point) (prog1 (1+ (point))                 group
1296                     (insert " " mark "     *: "                 (or (not regexp)
1297                             (gnus-group-name-decode group                     (and (stringp regexp) (string-match regexp group))
1298                                                     (gnus-group-name-charset                     (and (functionp regexp) (funcall regexp group))))
1299                                                      nil group))            (gnus-group-insert-group-line
1300                             "\n"))             group level nil
1301           (list 'gnus-group (gnus-intern-safe group gnus-active-hashtb)             (let ((active (gnus-active group)))
1302                 'gnus-unread t               (if active
1303                 'gnus-level level))))))                   (if (zerop (cdr active))
1304                         0
1305                       (- (1+ (cdr active)) (car active)))
1306                   nil))
1307               (gnus-method-simplify (gnus-find-method-for-group group))))))))
1308    
1309  (defun gnus-group-update-group-line ()  (defun gnus-group-update-group-line ()
1310    "Update the current line in the group buffer."    "Update the current line in the group buffer."
# Line 1161  If REGEXP, only list groups matching REG Line 1347  If REGEXP, only list groups matching REG
1347                 0                 0
1348               (- (1+ (cdr active)) (car active)))               (- (1+ (cdr active)) (car active)))
1349           nil)           nil)
1350         nil))))         (gnus-method-simplify (gnus-find-method-for-group group))))))
1351    
1352    (defun gnus-number-of-unseen-articles-in-group (group)
1353      (let* ((info (nth 2 (gnus-group-entry group)))
1354             (marked (gnus-info-marks info))
1355             (seen (cdr (assq 'seen marked)))
1356             (active (gnus-active group)))
1357        (if (not active)
1358            0
1359          (length (gnus-uncompress-range
1360                   (gnus-range-difference
1361                    (gnus-range-difference (list active) (gnus-info-read info))
1362                    seen))))))
1363    
1364  (defun gnus-group-insert-group-line (gnus-tmp-group gnus-tmp-level  (defun gnus-group-insert-group-line (gnus-tmp-group gnus-tmp-level
1365                                                      gnus-tmp-marked number                                                      gnus-tmp-marked number
# Line 1191  If REGEXP, only list groups matching REG Line 1389  If REGEXP, only list groups matching REG
1389           (gnus-tmp-qualified-group           (gnus-tmp-qualified-group
1390            (gnus-group-name-decode (gnus-group-real-name gnus-tmp-group)            (gnus-group-name-decode (gnus-group-real-name gnus-tmp-group)
1391                                    group-name-charset))                                    group-name-charset))
1392             (gnus-tmp-comment
1393              (or (gnus-group-get-parameter gnus-tmp-group 'comment t)
1394                  gnus-tmp-group))
1395           (gnus-tmp-newsgroup-description           (gnus-tmp-newsgroup-description
1396            (if gnus-description-hashtb            (if gnus-description-hashtb
1397                (or (gnus-group-name-decode                (or (gnus-group-name-decode
# Line 1215  If REGEXP, only list groups matching REG Line 1416  If REGEXP, only list groups matching REG
1416                     (zerop number)                     (zerop number)
1417                     (cdr (assq 'tick gnus-tmp-marked)))                     (cdr (assq 'tick gnus-tmp-marked)))
1418                ?* ? ))                ?* ? ))
1419             (gnus-tmp-summary-live
1420              (if (and (not gnus-group-is-exiting-p)
1421                       (gnus-buffer-live-p (gnus-summary-buffer-name
1422                                            gnus-tmp-group)))
1423                  ?* ? ))
1424           (gnus-tmp-process-marked           (gnus-tmp-process-marked
1425            (if (member gnus-tmp-group gnus-group-marked)            (if (member gnus-tmp-group gnus-group-marked)
1426                gnus-process-mark ? ))                gnus-process-mark ? ))
# Line 1229  If REGEXP, only list groups matching REG Line 1435  If REGEXP, only list groups matching REG
1435       (point)       (point)
1436       (prog1 (1+ (point))       (prog1 (1+ (point))
1437         ;; Insert the text.         ;; Insert the text.
1438         (eval gnus-group-line-format-spec))         (let ((gnus-tmp-group (gnus-group-name-decode
1439                                  gnus-tmp-group group-name-charset)))
1440             (eval gnus-group-line-format-spec)))
1441       `(gnus-group ,(gnus-intern-safe gnus-tmp-group gnus-active-hashtb)       `(gnus-group ,(gnus-intern-safe gnus-tmp-group gnus-active-hashtb)
1442                    gnus-unread ,(if (numberp number)                    gnus-unread ,(if (numberp number)
1443                                     (string-to-int gnus-tmp-number-of-unread)                                     (string-to-int gnus-tmp-number-of-unread)
# Line 1248  If REGEXP, only list groups matching REG Line 1456  If REGEXP, only list groups matching REG
1456    "Highlight the current line according to `gnus-group-highlight'."    "Highlight the current line according to `gnus-group-highlight'."
1457    (let* ((list gnus-group-highlight)    (let* ((list gnus-group-highlight)
1458           (p (point))           (p (point))
1459           (end (progn (end-of-line) (point)))           (end (gnus-point-at-eol))
1460           ;; now find out where the line starts and leave point there.           ;; now find out where the line starts and leave point there.
1461           (beg (progn (beginning-of-line) (point)))           (beg (progn (beginning-of-line) (point)))
1462           (group (gnus-group-group-name))           (group (gnus-group-group-name))
# Line 1257  If REGEXP, only list groups matching REG Line 1465  If REGEXP, only list groups matching REG
1465           (active (gnus-active group))           (active (gnus-active group))
1466           (total (if active (1+ (- (cdr active) (car active))) 0))           (total (if active (1+ (- (cdr active) (car active))) 0))
1467           (info (nth 2 entry))           (info (nth 2 entry))
1468           (method (gnus-server-get-method group (gnus-info-method info)))           (method (inline (gnus-server-get-method group (gnus-info-method info))))
1469           (marked (gnus-info-marks info))           (marked (gnus-info-marks info))
1470           (mailp (memq 'mail (assoc (symbol-name           (mailp (apply 'append
1471                                      (car (or method gnus-select-method)))                         (mapcar
1472                                     gnus-valid-select-methods)))                          (lambda (x)
1473                              (memq x (assoc (symbol-name
1474                                              (car (or method gnus-select-method)))
1475                                             gnus-valid-select-methods)))
1476                            '(mail post-mail))))
1477           (level (or (gnus-info-level info) gnus-level-killed))           (level (or (gnus-info-level info) gnus-level-killed))
1478           (score (or (gnus-info-score info) 0))           (score (or (gnus-info-score info) 0))
1479           (ticked (gnus-range-length (cdr (assq 'tick marked))))           (ticked (gnus-range-length (cdr (assq 'tick marked))))
# Line 1526  If UNMARK, remove the mark instead." Line 1738  If UNMARK, remove the mark instead."
1738    (interactive "sMark (regexp): ")    (interactive "sMark (regexp): ")
1739    (let ((alist (cdr gnus-newsrc-alist))    (let ((alist (cdr gnus-newsrc-alist))
1740          group)          group)
1741      (while alist      (save-excursion
1742        (when (string-match regexp (setq group (gnus-info-group (pop alist))))        (while alist
1743          (gnus-group-set-mark group))))          (when (string-match regexp (setq group (gnus-info-group (pop alist))))
1744              (gnus-group-jump-to-group group)
1745              (gnus-group-set-mark group)))))
1746    (gnus-group-position-point))    (gnus-group-position-point))
1747    
1748  (defun gnus-group-remove-mark (group &optional test-marked)  (defun gnus-group-remove-mark (group &optional test-marked)
# Line 1582  Take into consideration N (the prefix) a Line 1796  Take into consideration N (the prefix) a
1796            (setq n (1- n))            (setq n (1- n))
1797            (gnus-group-next-group way)))            (gnus-group-next-group way)))
1798        (nreverse groups)))        (nreverse groups)))
1799     ((gnus-region-active-p)     ((and (gnus-region-active-p) (mark))
1800      ;; Work on the region between point and mark.      ;; Work on the region between point and mark.
1801      (let ((max (max (point) (mark)))      (let ((max (max (point) (mark)))
1802            groups)            groups)
# Line 1667  group." Line 1881  group."
1881  (defun gnus-group-select-group (&optional all)  (defun gnus-group-select-group (&optional all)
1882    "Select this newsgroup.    "Select this newsgroup.
1883  No article is selected automatically.  No article is selected automatically.
1884    If the group is opened, just switch the summary buffer.
1885  If ALL is non-nil, already read articles become readable.  If ALL is non-nil, already read articles become readable.
1886  If ALL is a number, fetch this number of articles."  If ALL is a number, fetch this number of articles."
1887    (interactive "P")    (interactive "P")
1888      (when (and (eobp) (not (gnus-group-group-name)))
1889        (forward-line -1))
1890    (gnus-group-read-group all t))    (gnus-group-read-group all t))
1891    
1892  (defun gnus-group-quick-select-group (&optional all)  (defun gnus-group-quick-select-group (&optional all)
# Line 1712  be permanent." Line 1929  be permanent."
1929       (gnus-group-prefixed-name group method) method)))       (gnus-group-prefixed-name group method) method)))
1930    
1931  ;;;###autoload  ;;;###autoload
1932  (defun gnus-fetch-group (group)  (defun gnus-fetch-group (group &optional articles)
1933    "Start Gnus if necessary and enter GROUP.    "Start Gnus if necessary and enter GROUP.
1934  Returns whether the fetching was successful or not."  Returns whether the fetching was successful or not."
1935    (interactive (list (completing-read "Group name: " gnus-active-hashtb)))    (interactive (list (completing-read "Group name: " gnus-active-hashtb)))
1936    (unless (get-buffer gnus-group-buffer)    (unless (get-buffer gnus-group-buffer)
1937      (gnus-no-server))      (gnus-no-server))
1938    (gnus-group-read-group nil nil group))    (gnus-group-read-group articles nil group))
1939    
1940  ;;;###autoload  ;;;###autoload
1941  (defun gnus-fetch-group-other-frame (group)  (defun gnus-fetch-group-other-frame (group)
# Line 1735  Returns whether the fetching was success Line 1952  Returns whether the fetching was success
1952    
1953  (defvar gnus-ephemeral-group-server 0)  (defvar gnus-ephemeral-group-server 0)
1954    
1955    (defcustom gnus-large-ephemeral-newsgroup 200
1956      "The number of articles which indicates a large ephemeral newsgroup.
1957    Same as `gnus-large-newsgroup', but only used for ephemeral newsgroups.
1958    
1959    If the number of articles in a newsgroup is greater than this value,
1960    confirmation is required for selecting the newsgroup.  If it is nil, no
1961    confirmation is required."
1962      :group 'gnus-group-select
1963      :type '(choice (const :tag "No limit" nil)
1964                     integer))
1965    
1966    (defcustom gnus-fetch-old-ephemeral-headers nil
1967      "Same as `gnus-fetch-old-headers', but only used for ephemeral newsgroups."
1968      :group 'gnus-thread
1969      :type '(choice (const :tag "off" nil)
1970                     (const some)
1971                     number
1972                     (sexp :menu-tag "other" t)))
1973    
1974  ;; Enter a group that is not in the group buffer.  Non-nil is returned  ;; Enter a group that is not in the group buffer.  Non-nil is returned
1975  ;; if selection was successful.  ;; if selection was successful.
1976  (defun gnus-group-read-ephemeral-group (group method &optional activate  (defun gnus-group-read-ephemeral-group (group method &optional activate
1977                                                quit-config request-only                                                quit-config request-only
1978                                                select-articles)                                                select-articles
1979                                                  parameters)
1980    "Read GROUP from METHOD as an ephemeral group.    "Read GROUP from METHOD as an ephemeral group.
1981  If ACTIVATE, request the group first.  If ACTIVATE, request the group first.
1982  If QUIT-CONFIG, use that window configuration when exiting from the  If QUIT-CONFIG, use that window configuration when exiting from the
1983  ephemeral group.  ephemeral group.
1984  If REQUEST-ONLY, don't actually read the group; just request it.  If REQUEST-ONLY, don't actually read the group; just request it.
1985  If SELECT-ARTICLES, only select those articles.  If SELECT-ARTICLES, only select those articles.
1986    If PARAMETERS, use those as the group parameters.
1987    
1988  Return the name of the group if selection was successful."  Return the name of the group if selection was successful."
1989      (interactive
1990       (list
1991        ;; (gnus-read-group "Group name: ")
1992        (completing-read
1993         "Group: " gnus-active-hashtb
1994         nil nil nil
1995         'gnus-group-history)
1996        (gnus-read-method "From method: ")))
1997    ;; Transform the select method into a unique server.    ;; Transform the select method into a unique server.
1998    (when (stringp method)    (when (stringp method)
1999      (setq method (gnus-server-to-method method)))      (setq method (gnus-server-to-method method)))
# Line 1756  Return the name of the group if selectio Line 2002  Return the name of the group if selectio
2002            (,(intern (format "%s-address" (car method))) ,(cadr method))            (,(intern (format "%s-address" (car method))) ,(cadr method))
2003            ,@(cddr method)))            ,@(cddr method)))
2004    (let ((group (if (gnus-group-foreign-p group) group    (let ((group (if (gnus-group-foreign-p group) group
2005                   (gnus-group-prefixed-name group method))))                   (gnus-group-prefixed-name (gnus-group-real-name group)
2006                                               method))))
2007      (gnus-sethash      (gnus-sethash
2008       group       group
2009       `(-1 nil (,group       `(-1 nil (,group
2010                 ,gnus-level-default-subscribed nil nil ,method                 ,gnus-level-default-subscribed nil nil ,method
2011                 ((quit-config .                 ,(cons
2012                               ,(if quit-config quit-config                   (if quit-config
2013                                  (cons gnus-summary-buffer                       (cons 'quit-config quit-config)
2014                                        gnus-current-window-configuration))))))                     (cons 'quit-config
2015                             (cons gnus-summary-buffer
2016                                   gnus-current-window-configuration)))
2017                     parameters)))
2018       gnus-newsrc-hashtb)       gnus-newsrc-hashtb)
2019      (push method gnus-ephemeral-servers)      (push method gnus-ephemeral-servers)
2020      (set-buffer gnus-group-buffer)      (set-buffer gnus-group-buffer)
# Line 1778  Return the name of the group if selectio Line 2028  Return the name of the group if selectio
2028      (if request-only      (if request-only
2029          group          group
2030        (condition-case ()        (condition-case ()
2031            (when (gnus-group-read-group t t group select-articles)            (when (let ((gnus-large-newsgroup gnus-large-ephemeral-newsgroup)
2032                          (gnus-fetch-old-headers
2033                           gnus-fetch-old-ephemeral-headers))
2034                      (gnus-group-read-group t t group select-articles))
2035              group)              group)
2036          ;;(error nil)          ;;(error nil)
2037          (quit          (quit
# Line 1788  Return the name of the group if selectio Line 2041  Return the name of the group if selectio
2041  (defun gnus-group-jump-to-group (group)  (defun gnus-group-jump-to-group (group)
2042    "Jump to newsgroup GROUP."    "Jump to newsgroup GROUP."
2043    (interactive    (interactive
2044     (list (completing-read     (list (mm-string-make-unibyte
2045            "Group: " gnus-active-hashtb nil            (completing-read
2046            (gnus-read-active-file-p)             "Group: " gnus-active-hashtb nil
2047            nil             (gnus-read-active-file-p)
2048            'gnus-group-history)))             gnus-group-jump-to-group-prompt
2049               'gnus-group-history))))
2050    
2051    (when (equal group "")    (when (equal group "")
2052      (error "Empty group name"))      (error "Empty group name"))
# Line 1937  If EXCLUDE-GROUP, do not go to that grou Line 2191  If EXCLUDE-GROUP, do not go to that grou
2191        (forward-line 1))        (forward-line 1))
2192      (when best-point      (when best-point
2193        (goto-char best-point))        (goto-char best-point))
2194      (gnus-summary-position-point)      (gnus-group-position-point)
2195      (and best-point (gnus-group-group-name))))      (and best-point (gnus-group-group-name))))
2196    
2197  (defun gnus-group-first-unread-group ()  (defun gnus-group-first-unread-group ()
# Line 2000  ADDRESS." Line 2254  ADDRESS."
2254      (forward-line -1)      (forward-line -1)
2255      (gnus-group-position-point)      (gnus-group-position-point)
2256    
2257      ;; Load the backend and try to make the backend create      ;; Load the back end and try to make the back end create
2258      ;; the group as well.      ;; the group as well.
2259      (when (assoc (symbol-name (setq backend (car (gnus-server-get-method      (when (assoc (symbol-name (setq backend (car (gnus-server-get-method
2260                                                    nil meth))))                                                    nil meth))))
# Line 2008  ADDRESS." Line 2262  ADDRESS."
2262        (require backend))        (require backend))
2263      (gnus-check-server meth)      (gnus-check-server meth)
2264      (when (gnus-check-backend-function 'request-create-group nname)      (when (gnus-check-backend-function 'request-create-group nname)
2265        (gnus-request-create-group nname nil args))        (unless (gnus-request-create-group nname nil args)
2266            (error "Could not create group on server: %s"
2267                   (nnheader-get-report backend))))
2268      t))      t))
2269    
2270  (defun gnus-group-delete-groups (&optional arg)  (defun gnus-group-delete-groups (&optional arg)
# Line 2023  ADDRESS." Line 2279  ADDRESS."
2279          (lambda (group)          (lambda (group)
2280            (gnus-group-delete-group group nil t))))))            (gnus-group-delete-group group nil t))))))
2281    
2282    (defvar gnus-cache-active-altered)
2283    
2284  (defun gnus-group-delete-group (group &optional force no-prompt)  (defun gnus-group-delete-group (group &optional force no-prompt)
2285    "Delete the current group.  Only meaningful with editable groups.    "Delete the current group.  Only meaningful with editable groups.
2286  If FORCE (the prefix) is non-nil, all the articles in the group will  If FORCE (the prefix) is non-nil, all the articles in the group will
2287  be deleted.  This is \"deleted\" as in \"removed forever from the face  be deleted.  This is \"deleted\" as in \"removed forever from the face
2288  of the Earth\".  There is no undo.  The user will be prompted before  of the Earth\".  There is no undo.  The user will be prompted before
2289  doing the deletion."  doing the deletion.
2290    Note that you also have to specify FORCE if you want the group to
2291    be removed from the server, even when it's empty."
2292    (interactive    (interactive
2293     (list (gnus-group-group-name)     (list (gnus-group-group-name)
2294           current-prefix-arg))           current-prefix-arg))
2295    (unless group    (unless group
2296      (error "No group to rename"))      (error "No group to delete"))
2297    (unless (gnus-check-backend-function 'request-delete-group group)    (unless (gnus-check-backend-function 'request-delete-group group)
2298      (error "This backend does not support group deletion"))      (error "This back end does not support group deletion"))
2299    (prog1    (prog1
2300        (if (and (not no-prompt)        (if (and (not no-prompt)
2301                 (not (gnus-yes-or-no-p                 (not (gnus-yes-or-no-p
# Line 2050  doing the deletion." Line 2310  doing the deletion."
2310            (gnus-group-goto-group group)            (gnus-group-goto-group group)
2311            (gnus-group-kill-group 1 t)            (gnus-group-kill-group 1 t)
2312            (gnus-sethash group nil gnus-active-hashtb)            (gnus-sethash group nil gnus-active-hashtb)
2313              (if (boundp 'gnus-cache-active-hashtb)
2314                  (when gnus-cache-active-hashtb
2315                    (gnus-sethash group nil gnus-cache-active-hashtb)
2316                    (setq gnus-cache-active-altered t)))
2317            t))            t))
2318      (gnus-group-position-point)))      (gnus-group-position-point)))
2319    
# Line 2063  and NEW-NAME will be prompted for." Line 2327  and NEW-NAME will be prompted for."
2327      (progn      (progn
2328        (unless (gnus-check-backend-function        (unless (gnus-check-backend-function
2329                 'request-rename-group (gnus-group-group-name))                 'request-rename-group (gnus-group-group-name))
2330          (error "This backend does not support renaming groups"))          (error "This back end does not support renaming groups"))
2331        (gnus-read-group "Rename group to: "        (gnus-read-group "Rename group to: "
2332                         (gnus-group-real-name (gnus-group-group-name))))))                         (gnus-group-real-name (gnus-group-group-name))))))
2333    
2334    (unless (gnus-check-backend-function 'request-rename-group group)    (unless (gnus-check-backend-function 'request-rename-group group)
2335      (error "This backend does not support renaming groups"))      (error "This back end does not support renaming groups"))
2336    (unless group    (unless group
2337      (error "No group to rename"))      (error "No group to rename"))
2338    (when (equal (gnus-group-real-name group) new-name)    (when (equal (gnus-group-real-name group) new-name)
# Line 2084  and NEW-NAME will be prompted for." Line 2348  and NEW-NAME will be prompted for."
2348             (gnus-group-real-name new-name)             (gnus-group-real-name new-name)
2349             (gnus-info-method (gnus-get-info group)))))             (gnus-info-method (gnus-get-info group)))))
2350    
2351      (when (gnus-active new-name)
2352        (error "The group %s already exists" new-name))
2353    
2354    (gnus-message 6 "Renaming group %s to %s..." group new-name)    (gnus-message 6 "Renaming group %s to %s..." group new-name)
2355    (prog1    (prog1
2356        (if (progn        (if (progn
# Line 2132  and NEW-NAME will be prompted for." Line 2399  and NEW-NAME will be prompted for."
2399         (t "group info"))         (t "group info"))
2400        (gnus-group-decoded-name group))        (gnus-group-decoded-name group))
2401       `(lambda (form)       `(lambda (form)
2402          (gnus-group-edit-group-done ',part ,group form)))))          (gnus-group-edit-group-done ',part ,group form)))
2403        (local-set-key
2404         "\C-c\C-i"
2405         (gnus-create-info-command
2406          (cond
2407           ((eq part 'method)
2408            "(gnus)Select Methods")
2409           ((eq part 'params)
2410            "(gnus)Group Parameters")
2411           (t
2412            "(gnus)Group Info"))))))
2413    
2414  (defun gnus-group-edit-group-method (group)  (defun gnus-group-edit-group-method (group)
2415    "Edit the select method of GROUP."    "Edit the select method of GROUP."
# Line 2193  and NEW-NAME will be prompted for." Line 2470  and NEW-NAME will be prompted for."
2470        (setcar entry (eval (cadar entry)))))        (setcar entry (eval (cadar entry)))))
2471    (gnus-group-make-group group method))    (gnus-group-make-group group method))
2472    
2473  (defun gnus-group-make-help-group ()  (defun gnus-group-make-help-group (&optional noerror)
2474    "Create the Gnus documentation group."    "Create the Gnus documentation group.
2475    Optional argument NOERROR modifies the behavior of this function when the
2476    group already exists:
2477    - if not given, and error is signaled,
2478    - if t, stay silent,
2479    - if anything else, just print a message."
2480    (interactive)    (interactive)
2481    (let ((name (gnus-group-prefixed-name "gnus-help" '(nndoc "gnus-help")))    (let ((name (gnus-group-prefixed-name "gnus-help" '(nndoc "gnus-help")))
2482          (file (nnheader-find-etc-directory "gnus-tut.txt" t)))          (file (nnheader-find-etc-directory "gnus-tut.txt" t)))
2483      (when (gnus-gethash name gnus-newsrc-hashtb)      (if (gnus-gethash name gnus-newsrc-hashtb)
2484        (error "Documentation group already exists"))          (cond ((eq noerror nil)
2485      (if (not file)                 (error "Documentation group already exists"))
2486          (gnus-message 1 "Couldn't find doc group")                ((eq noerror t)
2487        (gnus-group-make-group                 ;; stay silent
2488         (gnus-group-real-name name)                 )
2489         (list 'nndoc "gnus-help"                (t
2490               (list 'nndoc-address file)                 (gnus-message 1 "Documentation group already exists")))
2491               (list 'nndoc-article-type 'mbox)))))        ;; else:
2492          (if (not file)
2493              (gnus-message 1 "Couldn't find doc group")
2494            (gnus-group-make-group
2495             (gnus-group-real-name name)
2496             (list 'nndoc "gnus-help"
2497                   (list 'nndoc-address file)
2498                   (list 'nndoc-article-type 'mbox))))
2499          ))
2500    (gnus-group-position-point))    (gnus-group-position-point))
2501    
2502  (defun gnus-group-make-doc-group (file type)  (defun gnus-group-make-doc-group (file type)
# Line 2271  If SOLID (the prefix), create a solid gr Line 2561  If SOLID (the prefix), create a solid gr
2561                    (nnweb-type ,(intern type))                    (nnweb-type ,(intern type))
2562                    (nnweb-ephemeral-p t))))                    (nnweb-ephemeral-p t))))
2563      (if solid      (if solid
2564          (gnus-group-make-group group "nnweb" "" `(,(intern type) ,search))          (progn
2565              (gnus-pull 'nnweb-ephemeral-p method)
2566              (gnus-group-make-group group method))
2567        (gnus-group-read-ephemeral-group        (gnus-group-read-ephemeral-group
2568         group method t         group method t
2569         (cons (current-buffer)         (cons (current-buffer)
2570               (if (eq major-mode 'gnus-summary-mode) 'summary 'group))))))               (if (eq major-mode 'gnus-summary-mode) 'summary 'group))))))
2571    
2572    (eval-when-compile
2573      (defvar nnrss-group-alist)
2574      (defun nnrss-discover-feed (arg))
2575      (defun nnrss-save-server-data (arg)))
2576    (defun gnus-group-make-rss-group (&optional url)
2577      "Given a URL, discover if there is an RSS feed.
2578    If there is, use Gnus to create an nnrss group"
2579      (interactive)
2580      (require 'nnrss)
2581      (if (not url)
2582          (setq url (read-from-minibuffer "URL to Search for RSS: ")))
2583      (let ((feedinfo (nnrss-discover-feed url)))
2584        (if feedinfo
2585            (let ((title (read-from-minibuffer "Title: "
2586                                               (cdr (assoc 'title
2587                                                           feedinfo))))
2588                  (desc  (read-from-minibuffer "Description: "
2589                                               (cdr (assoc 'description
2590                                                           feedinfo))))
2591                  (href (cdr (assoc 'href feedinfo))))
2592              (push (list title href desc)
2593                    nnrss-group-alist)
2594              (gnus-group-unsubscribe-group
2595               (concat "nnrss:" title))
2596              (nnrss-save-server-data nil))
2597          (error "No feeds found for %s" url))))
2598    
2599  (defvar nnwarchive-type-definition)  (defvar nnwarchive-type-definition)
2600  (defvar gnus-group-warchive-type-history nil)  (defvar gnus-group-warchive-type-history nil)
2601  (defvar gnus-group-warchive-login-history nil)  (defvar gnus-group-warchive-login-history nil)
# Line 2353  mail messages or news articles in files Line 2672  mail messages or news articles in files
2672       (gnus-group-real-name group)       (gnus-group-real-name group)
2673       (list 'nndir (gnus-group-real-name group) (list 'nndir-directory dir)))))       (list 'nndir (gnus-group-real-name group) (list 'nndir-directory dir)))))
2674    
2675  (eval-when-compile (defvar nnkiboze-score-file))  (defvar nnkiboze-score-file)
2676  (defun gnus-group-make-kiboze-group (group address scores)  (defun gnus-group-make-kiboze-group (group address scores)
2677    "Create an nnkiboze group.    "Create an nnkiboze group.
2678  The user will be prompted for a name, a regexp to match groups, and  The user will be prompted for a name, a regexp to match groups, and
# Line 2384  score file entries for articles to inclu Line 2703  score file entries for articles to inclu
2703        (make-directory score-dir))        (make-directory score-dir))
2704      (with-temp-file score-file      (with-temp-file score-file
2705        (let (emacs-lisp-mode-hook)        (let (emacs-lisp-mode-hook)
2706          (pp scores (current-buffer))))))          (gnus-pp scores)))))
2707    
2708  (defun gnus-group-add-to-virtual (n vgroup)  (defun gnus-group-add-to-virtual (n vgroup)
2709    "Add the current group to a virtual group."    "Add the current group to a virtual group."
# Line 2504  If REVERSE (the prefix), reverse the sor Line 2823  If REVERSE (the prefix), reverse the sor
2823    (interactive (list gnus-group-sort-function current-prefix-arg))    (interactive (list gnus-group-sort-function current-prefix-arg))
2824    (funcall gnus-group-sort-alist-function    (funcall gnus-group-sort-alist-function
2825             (gnus-make-sort-function func) reverse)             (gnus-make-sort-function func) reverse)
2826      (gnus-group-unmark-all-groups)
2827    (gnus-group-list-groups)    (gnus-group-list-groups)
2828    (gnus-dribble-touch))    (gnus-dribble-touch))
2829    
# Line 2526  If REVERSE, sort in reverse order." Line 2846  If REVERSE, sort in reverse order."
2846    (interactive "P")    (interactive "P")
2847    (gnus-group-sort-groups 'gnus-group-sort-by-alphabet reverse))    (gnus-group-sort-groups 'gnus-group-sort-by-alphabet reverse))
2848    
2849    (defun gnus-group-sort-groups-by-real-name (&optional reverse)
2850      "Sort the group buffer alphabetically by real (unprefixed) group name.
2851    If REVERSE, sort in reverse order."
2852      (interactive "P")
2853      (gnus-group-sort-groups 'gnus-group-sort-by-real-name reverse))
2854    
2855  (defun gnus-group-sort-groups-by-unread (&optional reverse)  (defun gnus-group-sort-groups-by-unread (&optional reverse)
2856    "Sort the group buffer by number of unread articles.    "Sort the group buffer by number of unread articles.
2857  If REVERSE, sort in reverse order."  If REVERSE, sort in reverse order."
# Line 2551  If REVERSE, sort in reverse order." Line 2877  If REVERSE, sort in reverse order."
2877    (gnus-group-sort-groups 'gnus-group-sort-by-rank reverse))    (gnus-group-sort-groups 'gnus-group-sort-by-rank reverse))
2878    
2879  (defun gnus-group-sort-groups-by-method (&optional reverse)  (defun gnus-group-sort-groups-by-method (&optional reverse)
2880    "Sort the group buffer alphabetically by backend name.    "Sort the group buffer alphabetically by back end name.
2881  If REVERSE, sort in reverse order."  If REVERSE, sort in reverse order."
2882    (interactive "P")    (interactive "P")
2883    (gnus-group-sort-groups 'gnus-group-sort-by-method reverse))    (gnus-group-sort-groups 'gnus-group-sort-by-method reverse))
2884    
2885    (defun gnus-group-sort-groups-by-server (&optional reverse)
2886      "Sort the group buffer alphabetically by server name.
2887    If REVERSE, sort in reverse order."
2888      (interactive "P")
2889      (gnus-group-sort-groups 'gnus-group-sort-by-server reverse))
2890    
2891  ;;; Selected group sorting.  ;;; Selected group sorting.
2892    
2893  (defun gnus-group-sort-selected-groups (n func &optional reverse)  (defun gnus-group-sort-selected-groups (n func &optional reverse)
# Line 2564  If REVERSE, sort in reverse order." Line 2896  If REVERSE, sort in reverse order."
2896    (let ((groups (gnus-group-process-prefix n)))    (let ((groups (gnus-group-process-prefix n)))
2897      (funcall gnus-group-sort-selected-function      (funcall gnus-group-sort-selected-function
2898               groups (gnus-make-sort-function func) reverse)               groups (gnus-make-sort-function func) reverse)
2899      (gnus-group-list-groups)))      (gnus-group-unmark-all-groups)
2900        (gnus-group-list-groups)
2901        (gnus-dribble-touch)))
2902    
2903  (defun gnus-group-sort-selected-flat (groups func reverse)  (defun gnus-group-sort-selected-flat (groups func reverse)
2904    (let (entries infos)    (let (entries infos)
# Line 2596  sort in reverse order." Line 2930  sort in reverse order."
2930    (interactive (gnus-interactive "P\ny"))    (interactive (gnus-interactive "P\ny"))
2931    (gnus-group-sort-selected-groups n 'gnus-group-sort-by-alphabet reverse))    (gnus-group-sort-selected-groups n 'gnus-group-sort-by-alphabet reverse))
2932    
2933    (defun gnus-group-sort-selected-groups-by-real-name (&optional n reverse)
2934      "Sort the group buffer alphabetically by real group name.
2935    Obeys the process/prefix convention.  If REVERSE (the symbolic prefix),
2936    sort in reverse order."
2937      (interactive (gnus-interactive "P\ny"))
2938      (gnus-group-sort-selected-groups n 'gnus-group-sort-by-real-name reverse))
2939    
2940  (defun gnus-group-sort-selected-groups-by-unread (&optional n reverse)  (defun gnus-group-sort-selected-groups-by-unread (&optional n reverse)
2941    "Sort the group buffer by number of unread articles.    "Sort the group buffer by number of unread articles.
2942  Obeys the process/prefix convention.  If REVERSE (the symbolic prefix),  Obeys the process/prefix convention.  If REVERSE (the symbolic prefix),
# Line 2625  sort in reverse order." Line 2966  sort in reverse order."
2966    (gnus-group-sort-selected-groups n 'gnus-group-sort-by-rank reverse))    (gnus-group-sort-selected-groups n 'gnus-group-sort-by-rank reverse))
2967    
2968  (defun gnus-group-sort-selected-groups-by-method (&optional n reverse)  (defun gnus-group-sort-selected-groups-by-method (&optional n reverse)
2969    "Sort the group buffer alphabetically by backend name.    "Sort the group buffer alphabetically by back end name.
2970  Obeys the process/prefix convention.  If REVERSE (the symbolic prefix),  Obeys the process/prefix convention.  If REVERSE (the symbolic prefix),
2971  sort in reverse order."  sort in reverse order."
2972    (interactive (gnus-interactive "P\ny"))    (interactive (gnus-interactive "P\ny"))
# Line 2654  sort in reverse order." Line 2995  sort in reverse order."
2995    (< (gnus-info-level info1) (gnus-info-level info2)))    (< (gnus-info-level info1) (gnus-info-level info2)))
2996    
2997  (defun gnus-group-sort-by-method (info1 info2)  (defun gnus-group-sort-by-method (info1 info2)
2998    "Sort alphabetically by backend name."    "Sort alphabetically by back end name."
2999    (string< (symbol-name (car (gnus-find-method-for-group    (string< (car (gnus-find-method-for-group
3000                                (gnus-info-group info1) info1)))                   (gnus-info-group info1) info1))
3001             (symbol-name (car (gnus-find-method-for-group             (car (gnus-find-method-for-group
3002                                (gnus-info-group info2) info2)))))                   (gnus-info-group info2) info2))))
3003    
3004    (defun gnus-group-sort-by-server (info1 info2)
3005      "Sort alphabetically by server name."
3006      (string< (gnus-method-to-full-server-name
3007                (gnus-find-method-for-group
3008                 (gnus-info-group info1) info1))
3009               (gnus-method-to-full-server-name
3010                (gnus-find-method-for-group
3011                 (gnus-info-group info2) info2))))
3012    
3013  (defun gnus-group-sort-by-score (info1 info2)  (defun gnus-group-sort-by-score (info1 info2)
3014    "Sort by group score."    "Sort by group score."
3015    (< (gnus-info-score info1) (gnus-info-score info2)))    (> (gnus-info-score info1) (gnus-info-score info2)))
3016    
3017  (defun gnus-group-sort-by-rank (info1 info2)  (defun gnus-group-sort-by-rank (info1 info2)
3018    "Sort by level and score."    "Sort by level and score."
# Line 2702  sort in reverse order." Line 3052  sort in reverse order."
3052    
3053  (defun gnus-info-clear-data (info)  (defun gnus-info-clear-data (info)
3054    "Clear all marks and read ranges from INFO."    "Clear all marks and read ranges from INFO."
3055    (let ((group (gnus-info-group info)))    (let ((group (gnus-info-group info))
3056            action)
3057        (dolist (el (gnus-info-marks info))
3058          (push `(,(cdr el) add (,(car el))) action))
3059        (push `(,(gnus-info-read info) add (read)) action)
3060      (gnus-undo-register      (gnus-undo-register
3061        `(progn        `(progn
3062             (gnus-request-set-mark ,group ',action)
3063           (gnus-info-set-marks ',info ',(gnus-info-marks info) t)           (gnus-info-set-marks ',info ',(gnus-info-marks info) t)
3064           (gnus-info-set-read ',info ',(gnus-info-read info))           (gnus-info-set-read ',info ',(gnus-info-read info))
3065           (when (gnus-group-goto-group ,group)           (when (gnus-group-goto-group ,group)
3066               (gnus-get-unread-articles-in-group ',info ',(gnus-active group) t)
3067             (gnus-group-update-group-line))))             (gnus-group-update-group-line))))
3068        (setq action (mapcar (lambda (el) (list (nth 0 el) 'del (nth 2 el)))
3069                             action))
3070        (gnus-request-set-mark group action)
3071      (gnus-info-set-read info nil)      (gnus-info-set-read info nil)
3072      (when (gnus-info-marks info)      (when (gnus-info-marks info)
3073        (gnus-info-set-marks info nil))))        (gnus-info-set-marks info nil))))
# Line 2768  If ALL is non-nil, all articles are mark Line 3127  If ALL is non-nil, all articles are mark
3127  The return value is the number of articles that were marked as read,  The return value is the number of articles that were marked as read,
3128  or nil if no action could be taken."  or nil if no action could be taken."
3129    (let* ((entry (gnus-gethash group gnus-newsrc-hashtb))    (let* ((entry (gnus-gethash group gnus-newsrc-hashtb))
3130           (num (car entry)))           (num (car entry))
3131             (marks (nth 3 (nth 2 entry)))
3132             (unread (gnus-list-of-unread-articles group)))
3133      ;; Remove entries for this group.      ;; Remove entries for this group.
3134      (nnmail-purge-split-history (gnus-group-real-name group))      (nnmail-purge-split-history (gnus-group-real-name group))
3135      ;; Do the updating only if the newsgroup isn't killed.      ;; Do the updating only if the newsgroup isn't killed.
3136      (if (not (numberp (car entry)))      (if (not (numberp (car entry)))
3137          (gnus-message 1 "Can't catch up %s; non-active group" group)          (gnus-message 1 "Can't catch up %s; non-active group" group)
3138          (gnus-update-read-articles group nil)
3139          (when all
3140            ;; Nix out the lists of marks and dormants.
3141            (gnus-request-set-mark group (list (list (cdr (assq 'tick marks))
3142                                                     'del '(tick))
3143                                               (list (cdr (assq 'dormant marks))
3144                                                     'del '(dormant))))
3145            (setq unread (gnus-uncompress-range
3146                          (gnus-range-add (gnus-range-add
3147                                           unread (cdr (assq 'dormant marks)))
3148                                          (cdr (assq 'tick marks)))))
3149            (gnus-add-marked-articles group 'tick nil nil 'force)
3150            (gnus-add-marked-articles group 'dormant nil nil 'force))
3151        ;; Do auto-expirable marks if that's required.        ;; Do auto-expirable marks if that's required.
3152        (when (gnus-group-auto-expirable-p group)        (when (gnus-group-auto-expirable-p group)
3153          (gnus-add-marked-articles          (gnus-add-marked-articles group 'expire unread)
3154           group 'expire (gnus-list-of-unread-articles group))          (gnus-request-set-mark group (list (list unread 'add '(expire)))))
3155          (when all        (let ((gnus-newsgroup-name group))
3156            (let ((marks (nth 3 (nth 2 entry))))          (gnus-run-hooks 'gnus-group-catchup-group-hook))
3157              (gnus-add-marked-articles        num)))
              group 'expire (gnus-uncompress-range (cdr (assq 'tick marks))))  
             (gnus-add-marked-articles  
              group 'expire (gnus-uncompress-range (cdr (assq 'tick marks)))))))  
       (when entry  
         (gnus-update-read-articles group nil)  
         ;; Also nix out the lists of marks and dormants.  
         (when all  
           (gnus-add-marked-articles group 'tick nil nil 'force)  
           (gnus-add-marked-articles group 'dormant nil nil 'force))  
         (let ((gnus-newsgroup-name group))  
           (gnus-run-hooks 'gnus-group-catchup-group-hook))  
         num))))  
3158    
3159  (defun gnus-group-expire-articles (&optional n)  (defun gnus-group-expire-articles (&optional n)
3160    "Expire all expirable articles in the current newsgroup."    "Expire all expirable articles in the current newsgroup.
3161    Uses the process/prefix convention."
3162    (interactive "P")    (interactive "P")
3163    (let ((groups (gnus-group-process-prefix n))    (let ((groups (gnus-group-process-prefix n))
3164          group)          group)
# Line 2854  or nil if no action could be taken." Line 3217  or nil if no action could be taken."
3217    (interactive    (interactive
3218     (list     (list
3219      current-prefix-arg      current-prefix-arg
3220      (string-to-int      (progn
3221       (let ((s (read-string        (unless (gnus-group-process-prefix current-prefix-arg)
3222                 (format "Level (default %s): "          (error "No group on the current line"))
3223                         (or (gnus-group-group-level)        (string-to-int
3224                             gnus-level-default-subscribed)))))         (let ((s (read-string
3225         (if (string-match "^\\s-*$" s)                   (format "Level (default %s): "
3226             (int-to-string (or (gnus-group-group-level)                           (or (gnus-group-group-level)
3227                                gnus-level-default-subscribed))                               gnus-level-default-subscribed)))))
3228           s)))))           (if (string-match "^\\s-*$" s)
3229                 (int-to-string (or (gnus-group-group-level)
3230                                    gnus-level-default-subscribed))
3231               s))))))
3232    (unless (and (>= level 1) (<= level gnus-level-killed))    (unless (and (>= level 1) (<= level gnus-level-killed))
3233      (error "Invalid level: %d" level))      (error "Invalid level: %d" level))
3234    (let ((groups (gnus-group-process-prefix n))    (let ((groups (gnus-group-process-prefix n))
# Line 2891  or nil if no action could be taken." Line 3257  or nil if no action could be taken."
3257    "Toggle subscription of the current group.    "Toggle subscription of the current group.
3258  If given numerical prefix, toggle the N next groups."  If given numerical prefix, toggle the N next groups."
3259    (interactive "P")    (interactive "P")
3260    (let ((groups (gnus-group-process-prefix n))    (dolist (group (gnus-group-process-prefix n))
3261          group)      (gnus-group-remove-mark group)
3262      (while groups      (gnus-group-unsubscribe-group
3263        (setq group (car groups)       group
3264              groups (cdr groups))       (cond
3265        (gnus-group-remove-mark group)        ((eq do-sub 'unsubscribe)
3266        (gnus-group-unsubscribe-group         gnus-level-default-unsubscribed)
3267         group        ((eq do-sub 'subscribe)
3268         (cond         gnus-level-default-subscribed)
3269          ((eq do-sub 'unsubscribe)        ((<= (gnus-group-group-level) gnus-level-subscribed)
3270           gnus-level-default-unsubscribed)         gnus-level-default-unsubscribed)
3271          ((eq do-sub 'subscribe)        (t
3272           gnus-level-default-subscribed)         gnus-level-default-subscribed))
3273          ((<= (gnus-group-group-level) gnus-level-subscribed)       t)
3274           gnus-level-default-unsubscribed)      (gnus-group-update-group-line))
3275          (t    (gnus-group-next-group 1))
          gnus-level-default-subscribed))  
        t)  
       (gnus-group-update-group-line))  
     (gnus-group-next-group 1)))  
3276    
3277  (defun gnus-group-unsubscribe-group (group &optional level silent)  (defun gnus-group-unsubscribe-group (group &optional level silent)
3278    "Toggle subscription to GROUP.    "Toggle subscription to GROUP.
# Line 3026  of groups killed." Line 3388  of groups killed."
3388            (message "Killed group %s" group))            (message "Killed group %s" group))
3389        ;; If there are lots and lots of groups to be killed, we use        ;; If there are lots and lots of groups to be killed, we use
3390        ;; this thing instead.        ;; this thing instead.
3391        (let (entry)        (dolist (group (nreverse groups))
3392          (setq groups (nreverse groups))          (gnus-group-remove-mark group)
3393          (while groups          (gnus-delete-line)
3394            (gnus-group-remove-mark (setq group (pop groups)))          (push group gnus-killed-list)
3395            (gnus-delete-line)          (setq gnus-newsrc-alist
3396            (push group gnus-killed-list)                (delq (assoc group gnus-newsrc-alist)
3397            (setq gnus-newsrc-alist                      gnus-newsrc-alist))
3398                  (delq (assoc group gnus-newsrc-alist)          (when gnus-group-change-level-function
3399                        gnus-newsrc-alist))            (funcall gnus-group-change-level-function
3400            (when gnus-group-change-level-function                     group gnus-level-killed 3))
3401              (funcall gnus-group-change-level-function          (cond
3402                       group gnus-level-killed 3))           ((setq entry (gnus-gethash group gnus-newsrc-hashtb))
3403            (cond            (push (cons (car entry) (nth 2 entry))
3404             ((setq entry (gnus-gethash group gnus-newsrc-hashtb))                  gnus-list-of-killed-groups)
3405              (push (cons (car entry) (nth 2 entry))            (setcdr (cdr entry) (cdddr entry)))
3406                    gnus-list-of-killed-groups)           ((member group gnus-zombie-list)
3407              (setcdr (cdr entry) (cdddr entry)))            (setq gnus-zombie-list (delete group gnus-zombie-list))))
3408             ((member group gnus-zombie-list)          ;; There may be more than one instance displayed.
3409              (setq gnus-zombie-list (delete group gnus-zombie-list))))          (while (gnus-group-goto-group group)
3410            ;; There may be more than one instance displayed.            (gnus-delete-line)))
3411            (while (gnus-group-goto-group group)        (gnus-make-hashtable-from-newsrc-alist))
             (gnus-delete-line)))  
         (gnus-make-hashtable-from-newsrc-alist)))  
3412    
3413      (gnus-group-position-point)      (gnus-group-position-point)
3414      (if (< (length out) 2) (car out) (nreverse out))))      (if (< (length out) 2) (car out) (nreverse out))))
# Line 3113  yanked) a list of yanked groups is retur Line 3473  yanked) a list of yanked groups is retur
3473    
3474  (defun gnus-group-list-all-groups (&optional arg)  (defun gnus-group-list-all-groups (&optional arg)
3475    "List all newsgroups with level ARG or lower.    "List all newsgroups with level ARG or lower.
3476  Default is gnus-level-unsubscribed, which lists all subscribed and most  Default is `gnus-level-unsubscribed', which lists all subscribed and most
3477  unsubscribed groups."  unsubscribed groups."
3478    (interactive "P")    (interactive "P")
3479    (gnus-group-list-groups (or arg gnus-level-unsubscribed) t))    (gnus-group-list-groups (or arg gnus-level-unsubscribed) t))
# Line 3175  entail asking the server for the groups. Line 3535  entail asking the server for the groups.
3535        (gnus-add-text-properties        (gnus-add-text-properties
3536         (point) (prog1 (1+ (point))         (point) (prog1 (1+ (point))
3537                   (insert "       *: "                   (insert "       *: "
3538                           (gnus-group-name-decode group                           (gnus-group-decoded-name group)
                                                  (gnus-group-name-charset  
                                                   nil group))  
3539                           "\n"))                           "\n"))
3540         (list 'gnus-group (gnus-intern-safe group gnus-active-hashtb)         (list 'gnus-group (gnus-intern-safe group gnus-active-hashtb)
3541               'gnus-unread t               'gnus-unread t
# Line 3202  re-scanning.  If ARG is non-nil and not Line 3560  re-scanning.  If ARG is non-nil and not
3560          ;; Binding this variable will inhibit multiple fetchings          ;; Binding this variable will inhibit multiple fetchings
3561          ;; of the same mail source.          ;; of the same mail source.
3562          (nnmail-fetched-sources (list t)))          (nnmail-fetched-sources (list t)))
3563        (gnus-run-hooks 'gnus-get-top-new-news-hook)
3564      (gnus-run-hooks 'gnus-get-new-news-hook)      (gnus-run-hooks 'gnus-get-new-news-hook)
3565    
3566      ;; Read any slave files.      ;; Read any slave files.
# Line 3301  to use." Line 3660  to use."
3660            (find-file file)            (find-file file)
3661            (setq found t))))))            (setq found t))))))
3662    
3663    (defun gnus-group-fetch-charter (group)
3664      "Fetch the charter for the current group.
3665    If given a prefix argument, prompt for a group."
3666      (interactive
3667       (list (or (when current-prefix-arg
3668                   (completing-read "Group: " gnus-active-hashtb))
3669                 (gnus-group-group-name)
3670                 gnus-newsgroup-name)))
3671      (unless group
3672        (error "No group name given"))
3673      (require 'mm-url)
3674      (condition-case nil (require 'url-http) (error nil))
3675      (let ((name (mm-url-form-encode-xwfu (gnus-group-real-name group)))
3676            url hierarchy)
3677        (when (string-match "\\(^[^\\.]+\\)\\..*" name)
3678          (setq hierarchy (match-string 1 name))
3679          (if (and (setq url (cdr (assoc hierarchy gnus-group-charter-alist)))
3680                   (if (fboundp 'url-http-file-exists-p)
3681                       (url-http-file-exists-p (eval url))
3682                     t))
3683              (browse-url (eval url))
3684            (setq url (concat "http://" hierarchy
3685                              ".news-admin.org/charters/" name))
3686            (if (and (fboundp 'url-http-file-exists-p)
3687                     (url-http-file-exists-p url))
3688                (browse-url url)
3689              (gnus-group-fetch-control group))))))
3690    
3691    (defun gnus-group-fetch-control (group)
3692      "Fetch the archived control messages for the current group.
3693    If given a prefix argument, prompt for a group."
3694      (interactive
3695       (list (or (when current-prefix-arg
3696                   (completing-read "Group: " gnus-active-hashtb))
3697                 (gnus-group-group-name)
3698                 gnus-newsgroup-name)))
3699      (unless group
3700        (error "No group name given"))
3701      (let ((name (gnus-group-real-name group))
3702            hierarchy)
3703        (when (string-match "\\(^[^\\.]+\\)\\..*" name)
3704          (setq hierarchy (match-string 1 name))
3705          (if gnus-group-fetch-control-use-browse-url
3706              (browse-url (concat "ftp://ftp.isc.org/usenet/control/"
3707                                  hierarchy "/" name ".gz"))
3708            (let ((enable-local-variables nil))
3709              (gnus-group-read-ephemeral-group
3710               group
3711               `(nndoc ,group (nndoc-address
3712                               ,(find-file-noselect
3713                                 (concat "/ftp@ftp.isc.org:/usenet/control/"
3714                                         hierarchy "/" name ".gz")))
3715                       (nndoc-article-type mbox)) t nil nil))))))
3716    
3717  (defun gnus-group-describe-group (force &optional group)  (defun gnus-group-describe-group (force &optional group)
3718    "Display a description of the current newsgroup."    "Display a description of the current newsgroup."
3719    (interactive (list current-prefix-arg (gnus-group-group-name)))    (interactive (list current-prefix-arg (gnus-group-group-name)))
# Line 3396  to use." Line 3809  to use."
3809      (pop-to-buffer obuf)))      (pop-to-buffer obuf)))
3810    
3811  (defun gnus-group-description-apropos (regexp)  (defun gnus-group-description-apropos (regexp)
3812    "List all newsgroups that have names or descriptions that match a regexp."    "List all newsgroups that have names or descriptions that match REGEXP."
3813    (interactive "sGnus description apropos (regexp): ")    (interactive "sGnus description apropos (regexp): ")
3814    (when (not (or gnus-description-hashtb    (when (not (or gnus-description-hashtb
3815                   (gnus-read-all-descriptions-files)))                   (gnus-read-all-descriptions-files)))
# Line 3417  This command may read the active file." Line 3830  This command may read the active file."
3830    (when (and level    (when (and level
3831               (> (prefix-numeric-value level) gnus-level-killed))               (> (prefix-numeric-value level) gnus-level-killed))
3832      (gnus-get-killed-groups))      (gnus-get-killed-groups))
3833    (gnus-group-prepare-flat    (funcall gnus-group-prepare-function
3834     (or level gnus-level-subscribed) all (or lowest 1) regexp)     (or level gnus-level-subscribed) (and all t) (or lowest 1) regexp)
3835    (goto-char (point-min))    (goto-char (point-min))
3836    (gnus-group-position-point))    (gnus-group-position-point))
3837    
# Line 3495  If GROUP, edit that local kill file inst Line 3908  If GROUP, edit that local kill file inst
3908    (interactive)    (interactive)
3909    (gnus-save-newsrc-file))    (gnus-save-newsrc-file))
3910    
3911    (defvar gnus-backlog-articles)
3912    
3913  (defun gnus-group-suspend ()  (defun gnus-group-suspend ()
3914    "Suspend the current Gnus session.    "Suspend the current Gnus session.
3915  In fact, cleanup buffers except for group mode buffer.  In fact, cleanup buffers except for group mode buffer.
3916  The hook gnus-suspend-gnus-hook is called before actually suspending."  The hook `gnus-suspend-gnus-hook' is called before actually suspending."
3917    (interactive)    (interactive)
3918    (gnus-run-hooks 'gnus-suspend-gnus-hook)    (gnus-run-hooks 'gnus-suspend-gnus-hook)
3919      (gnus-offer-save-summaries)
3920    ;; Kill Gnus buffers except for group mode buffer.    ;; Kill Gnus buffers except for group mode buffer.
3921    (let ((group-buf (get-buffer gnus-group-buffer)))    (let ((group-buf (get-buffer gnus-group-buffer)))
3922      (dolist (buf (gnus-buffers))      (mapcar (lambda (buf)
3923        (unless (or (eq buf group-buf) (eq buf gnus-dribble-buffer))                (unless (or (member buf (list group-buf gnus-dribble-buffer))
3924          (kill-buffer buf)))                            (progn
3925                                (save-excursion
3926                                  (set-buffer buf)
3927                                  (eq major-mode 'message-mode))))
3928                    (gnus-kill-buffer buf)))
3929                (gnus-buffers))
3930        (setq gnus-backlog-articles nil)
3931      (gnus-kill-gnus-frames)      (gnus-kill-gnus-frames)
3932      (when group-buf      (when group-buf
3933        (bury-buffer group-buf)        (bury-buffer group-buf)
# Line 3552  The hook `gnus-exit-gnus-hook' is called Line 3974  The hook `gnus-exit-gnus-hook' is called
3974                       (file-name-nondirectory gnus-current-startup-file))))                       (file-name-nondirectory gnus-current-startup-file))))
3975      (gnus-run-hooks 'gnus-exit-gnus-hook)      (gnus-run-hooks 'gnus-exit-gnus-hook)
3976      (gnus-configure-windows 'group t)      (gnus-configure-windows 'group t)
3977        (when (and (gnus-buffer-live-p gnus-dribble-buffer)
3978                   (not (zerop (save-excursion
3979                                (set-buffer gnus-dribble-buffer)
3980                                (buffer-size)))))
3981          (gnus-dribble-enter
3982           ";;; Gnus was exited on purpose without saving the .newsrc files."))
3983      (gnus-dribble-save)      (gnus-dribble-save)
3984      (gnus-close-backends)      (gnus-close-backends)
3985      (gnus-clear-system)      (gnus-clear-system)
# Line 3572  If not, METHOD should be a list where th Line 4000  If not, METHOD should be a list where th
4000  and the second element is the address."  and the second element is the address."
4001    (interactive    (interactive
4002     (list (let ((how (completing-read     (list (let ((how (completing-read
4003                       "Which backend: "                       "Which back end: "
4004                       (append gnus-valid-select-methods gnus-server-alist)                       (append gnus-valid-select-methods gnus-server-alist)
4005                       nil t (cons "nntp" 0) 'gnus-method-history)))                       nil t (cons "nntp" 0) 'gnus-method-history)))
4006             ;; We either got a backend name or a virtual server name.             ;; We either got a back end name or a virtual server name.
4007             ;; If the first, we also need an address.             ;; If the first, we also need an address.
4008             (if (assoc how gnus-valid-select-methods)             (if (assoc how gnus-valid-select-methods)
4009                 (list (intern how)                 (list (intern how)
# Line 3641  and the second element is the address." Line 4069  and the second element is the address."
4069              (setcar (nthcdr 2 entry) info)              (setcar (nthcdr 2 entry) info)
4070              (when (and (not (eq (car entry) t))              (when (and (not (eq (car entry) t))
4071                         (gnus-active (gnus-info-group info)))                         (gnus-active (gnus-info-group info)))
4072                (setcar entry (length (gnus-list-of-unread-articles (car info))))))                (setcar entry (length
4073                                 (gnus-list-of-unread-articles (car info))))))
4074          (error "No such group: %s" (gnus-info-group info))))))          (error "No such group: %s" (gnus-info-group info))))))
4075    
4076  (defun gnus-group-set-method-info (group select-method)  (defun gnus-group-set-method-info (group select-method)
# Line 3676  and the second element is the address." Line 4105  and the second element is the address."
4105                       (sort (nconc (gnus-uncompress-range (cdr m))                       (sort (nconc (gnus-uncompress-range (cdr m))
4106                                    (copy-sequence articles)) '<) t))))))                                    (copy-sequence articles)) '<) t))))))
4107    
4108    (defun gnus-add-mark (group mark article)
4109      "Mark ARTICLE in GROUP with MARK, whether the group is displayed or not."
4110      (let ((buffer (gnus-summary-buffer-name group)))
4111        (if (gnus-buffer-live-p buffer)
4112            (save-excursion
4113              (set-buffer (get-buffer buffer))
4114              (gnus-summary-add-mark article mark))
4115          (gnus-add-marked-articles group (cdr (assq mark gnus-article-mark-lists))
4116                                    (list article)))))
4117    
4118  ;;;  ;;;
4119  ;;; Group timestamps  ;;; Group timestamps
4120  ;;;  ;;;
# Line 3697  or `gnus-group-catchup-group-hook'." Line 4136  or `gnus-group-catchup-group-hook'."
4136    "Return the offset in seconds from the timestamp for GROUP to the current time, as a floating point number."    "Return the offset in seconds from the timestamp for GROUP to the current time, as a floating point number."
4137    (let* ((time (or (gnus-group-timestamp group)    (let* ((time (or (gnus-group-timestamp group)
4138                     (list 0 0)))                     (list 0 0)))
4139           (delta (subtract-time (current-time) time)))           (delta (subtract-time (current-time) time)))
4140      (+ (* (nth 0 delta) 65536.0)      (+ (* (nth 0 delta) 65536.0)
4141         (nth 1 delta))))         (nth 1 delta))))
4142    
# Line 3708  or `gnus-group-catchup-group-hook'." Line 4147  or `gnus-group-catchup-group-hook'."
4147          ""          ""
4148        (gnus-time-iso8601 time))))        (gnus-time-iso8601 time))))
4149    
 (defun gnus-group-prepare-flat-list-dead-predicate  
   (groups level mark predicate)  
   (let (group)  
     (if predicate  
         ;; This loop is used when listing groups that match some  
         ;; regexp.  
         (while (setq group (pop groups))  
           (when (funcall predicate group)  
             (gnus-add-text-properties  
              (point) (prog1 (1+ (point))  
                        (insert " " mark "     *: "  
                                (gnus-group-name-decode group  
                                                        (gnus-group-name-charset  
                                                         nil group))  
                                "\n"))  
              (list 'gnus-group (gnus-intern-safe group gnus-active-hashtb)  
                    'gnus-unread t  
                    'gnus-level level)))))))  
   
 (defun gnus-group-prepare-flat-predicate (level predicate &optional lowest  
                                                 dead-predicate)  
   "List all newsgroups with unread articles of level LEVEL or lower.  
 If LOWEST is non-nil, list all newsgroups of level LOWEST or higher.  
 If PREDICATE, only list groups which PREDICATE returns non-nil.  
 If DEAD-PREDICATE, list dead groups which DEAD-PREDICATE returns non-nil."  
   (set-buffer gnus-group-buffer)  
   (let ((buffer-read-only nil)  
         (newsrc (cdr gnus-newsrc-alist))  
         (lowest (or lowest 1))  
         info clevel unread group params)  
     (erase-buffer)  
     ;; List living groups.  
     (while newsrc  
       (setq info (car newsrc)  
             group (gnus-info-group info)  
             params (gnus-info-params info)  
             newsrc (cdr newsrc)  
             unread (car (gnus-gethash group gnus-newsrc-hashtb)))  
       (and unread                       ; This group might be unchecked  
            (funcall predicate info)  
            (<= (setq clevel (gnus-info-level info)) level)  
            (>= clevel lowest)  
            (gnus-group-insert-group-line  
             group (gnus-info-level info)  
             (gnus-info-marks info) unread (gnus-info-method info))))  
   
     ;; List dead groups.  
     (and (>= level gnus-level-zombie) (<= lowest gnus-level-zombie)  
          (gnus-group-prepare-flat-list-dead-predicate  
           (setq gnus-zombie-list (sort gnus-zombie-list 'string<))  
           gnus-level-zombie ?Z  
           dead-predicate))  
     (and (>= level gnus-level-killed) (<= lowest gnus-level-killed)  
          (gnus-group-prepare-flat-list-dead-predicate  
           (setq gnus-killed-list (sort gnus-killed-list 'string<))  
           gnus-level-killed ?K dead-predicate))  
   
     (gnus-group-set-mode-line)  
     (setq gnus-group-list-mode (cons level t))  
     (gnus-run-hooks 'gnus-group-prepare-hook)  
     t))  
   
4150  (defun gnus-group-list-cached (level &optional lowest)  (defun gnus-group-list-cached (level &optional lowest)
4151    "List all groups with cached articles.    "List all groups with cached articles.
4152  If the prefix LEVEL is non-nil, it should be a number that says which  If the prefix LEVEL is non-nil, it should be a number that says which
# Line 3782  This command may read the active file." Line 4159  This command may read the active file."
4159      (setq level (prefix-numeric-value level)))      (setq level (prefix-numeric-value level)))
4160    (when (or (not level) (>= level gnus-level-zombie))    (when (or (not level) (>= level gnus-level-zombie))
4161      (gnus-cache-open))      (gnus-cache-open))
4162    (gnus-group-prepare-flat-predicate (or level gnus-level-subscribed)    (funcall gnus-group-prepare-function
4163                                  #'(lambda (info)             (or level gnus-level-subscribed)
4164                                      (let ((marks (gnus-info-marks info)))             #'(lambda (info)
4165                                        (assq 'cache marks)))                 (let ((marks (gnus-info-marks info)))
4166                                  lowest                   (assq 'cache marks)))
4167                                  #'(lambda (group)             lowest
4168                                      (or (gnus-gethash group             #'(lambda (group)
4169                                                        gnus-cache-active-hashtb)                 (or (gnus-gethash group
4170                                          ;; Cache active file might use "."                                   gnus-cache-active-hashtb)
4171                                          ;; instead of ":".                     ;; Cache active file might use "."
4172                                          (gnus-gethash                     ;; instead of ":".
4173                                           (mapconcat 'identity                     (gnus-gethash
4174                                                      (split-string group ":")                      (mapconcat 'identity
4175                                                      ".")                                 (split-string group ":")
4176                                           gnus-cache-active-hashtb))))                                 ".")
4177                        gnus-cache-active-hashtb))))
4178    (goto-char (point-min))    (goto-char (point-min))
4179    (gnus-group-position-point))    (gnus-group-position-point))
4180    
# Line 3812  This command may read the active file." Line 4190  This command may read the active file."
4190      (setq level (prefix-numeric-value level)))      (setq level (prefix-numeric-value level)))
4191    (when (or (not level) (>= level gnus-level-zombie))    (when (or (not level) (>= level gnus-level-zombie))
4192      (gnus-cache-open))      (gnus-cache-open))
4193    (gnus-group-prepare-flat-predicate (or level gnus-level-subscribed)    (funcall gnus-group-prepare-function
4194                                  #'(lambda (info)             (or level gnus-level-subscribed)
4195                                      (let ((marks (gnus-info-marks info)))             #'(lambda (info)
4196                                        (assq 'dormant marks)))                 (let ((marks (gnus-info-marks info)))
4197                                  lowest)                   (assq 'dormant marks)))
4198               lowest
4199               'ignore)
4200    (goto-char (point-min))    (goto-char (point-min))
4201    (gnus-group-position-point))    (gnus-group-position-point))
4202    
4203    (defun gnus-group-listed-groups ()
4204      "Return a list of listed groups."
4205      (let (point groups)
4206        (goto-char (point-min))
4207        (while (setq point (text-property-not-all (point) (point-max)
4208                                                  'gnus-group nil))
4209          (goto-char point)
4210          (push (symbol-name (get-text-property point 'gnus-group)) groups)
4211          (forward-char 1))
4212        groups))
4213    
4214    (defun gnus-group-list-plus (&optional args)
4215      "List groups plus the current selection."
4216      (interactive "P")
4217      (let ((gnus-group-listed-groups (gnus-group-listed-groups))
4218            (gnus-group-list-mode gnus-group-list-mode) ;; Save it.
4219            func)
4220        (push last-command-event unread-command-events)
4221        (if (featurep 'xemacs)
4222            (push (make-event 'key-press '(key ?A)) unread-command-events)
4223          (push ?A unread-command-events))
4224        (let (gnus-pick-mode keys)
4225          (setq keys (if (featurep 'xemacs)
4226                         (events-to-keys (read-key-sequence nil))
4227                       (read-key-sequence nil)))
4228          (setq func (lookup-key (current-local-map) keys)))
4229        (if (or (not func)
4230                (numberp func))
4231            (ding)
4232          (call-interactively func))))
4233    
4234    (defun gnus-group-list-flush (&optional args)
4235      "Flush groups from the current selection."
4236      (interactive "P")
4237      (let ((gnus-group-list-option 'flush))
4238        (gnus-group-list-plus args)))
4239    
4240    (defun gnus-group-list-limit (&optional args)
4241      "List groups limited within the current selection."
4242      (interactive "P")
4243      (let ((gnus-group-list-option 'limit))
4244        (gnus-group-list-plus args)))
4245    
4246    (defun gnus-group-mark-article-read (group article)
4247      "Mark ARTICLE read."
4248      (let ((buffer (gnus-summary-buffer-name group))
4249            (mark gnus-read-mark)
4250            active n)
4251        (if (get-buffer buffer)
4252            (with-current-buffer buffer
4253              (setq active gnus-newsgroup-active)
4254              (gnus-activate-group group)
4255              (when gnus-newsgroup-prepared
4256                (when (and gnus-newsgroup-auto-expire
4257                           (memq mark gnus-auto-expirable-marks))
4258                  (setq mark gnus-expirable-mark))
4259                (setq mark (gnus-request-update-mark
4260                            group article mark))
4261                (gnus-mark-article-as-read article mark)
4262                (setq gnus-newsgroup-active (gnus-active group))
4263                (when active
4264                  (setq n (1+ (cdr active)))
4265                  (while (<= n (cdr gnus-newsgroup-active))
4266                    (unless (eq n article)
4267                      (push n gnus-newsgroup-unselected))
4268                    (setq n (1+ n)))
4269                  (setq gnus-newsgroup-unselected
4270                        (nreverse gnus-newsgroup-unselected)))))
4271          (gnus-activate-group group)
4272          (gnus-group-make-articles-read group (list article))
4273          (when (gnus-group-auto-expirable-p group)
4274            (gnus-add-marked-articles
4275             group 'expire (list article))))))
4276    
4277  (provide 'gnus-group)  (provide 'gnus-group)
4278    
4279  ;;; arch-tag: 2eb5440f-0bca-4091-814c-e37817536af6  ;;; arch-tag: 2eb5440f-0bca-4091-814c-e37817536af6

Legend:
Removed from v.1.19.2.2  
changed lines
  Added in v.1.19.2.3

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26