X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fgnus-group.el;h=d9a7bb5af5f9ae4e0eeba9f27d1880de0d3e8800;hb=0bcb697113fbd45da5bc46de153b55b17ff14b00;hp=6f05d2a3ca23952e0216ac44152fa0ba110d951b;hpb=77c2b3c6707324bdf2d5376e1c97cdfff7014c74;p=elisp%2Fgnus.git-

diff --git a/lisp/gnus-group.el b/lisp/gnus-group.el
index 6f05d2a..d9a7bb5 100644
--- a/lisp/gnus-group.el
+++ b/lisp/gnus-group.el
@@ -1,7 +1,7 @@
 ;;; gnus-group.el --- group mode commands for Gnus
-;; Copyright (C) 1996,97 Free Software Foundation, Inc.
+;; Copyright (C) 1996,97,98,99 Free Software Foundation, Inc.
 
-;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;; Keywords: news
 
 ;; This file is part of GNU Emacs.
@@ -35,20 +35,21 @@
 (require 'gnus-range)
 (require 'gnus-win)
 (require 'gnus-undo)
+(require 'time-date)
 
 (defcustom gnus-group-archive-directory
-  "/ftp@ftp.hpc.uh.edu:/pub/emacs/ding-list/"
+  "*ftp@ftp.hpc.uh.edu:/pub/emacs/ding-list/"
   "*The address of the (ding) archives."
   :group 'gnus-group-foreign
   :type 'directory)
 
 (defcustom gnus-group-recent-archive-directory
-  "/ftp@ftp.hpc.uh.edu:/pub/emacs/ding-list-recent/"
+  "*ftp@ftp.hpc.uh.edu:/pub/emacs/ding-list-recent/"
   "*The address of the most recent (ding) articles."
   :group 'gnus-group-foreign
   :type 'directory)
 
-(defcustom gnus-no-groups-message "No news is no news"
+(defcustom gnus-no-groups-message "No gnus is bad news"
   "*Message displayed by Gnus when no groups are available."
   :group 'gnus-start
   :type 'string)
@@ -89,7 +90,7 @@ unread articles in the groups.
 
 If nil, no groups are permanently visible."
   :group 'gnus-group-listing
-  :type 'regexp)
+  :type '(choice regexp (const nil)))
 
 (defcustom gnus-list-groups-with-ticked-articles t
   "*If non-nil, list groups that have only ticked articles.
@@ -261,10 +262,13 @@ variable."
   :type 'hook)
 
 (defcustom gnus-useful-groups
-  `(("(ding) mailing list mirrored at sunsite.auc.dk"
+  '(("(ding) mailing list mirrored at sunsite.auc.dk"
      "emacs.ding"
      (nntp "sunsite.auc.dk"
-			(nntp-address "sunsite.auc.dk")))
+	   (nntp-address "sunsite.auc.dk")))
+    ("gnus-bug archive"
+     "gnus-bug"
+     (nndir "/ftp@ftp.ifi.uio.no:/pub/emacs/gnus/gnus-bug/"))
     ("Gnus help group"
      "gnus-help"
      (nndoc "gnus-help"
@@ -275,7 +279,7 @@ variable."
 		       (unless file
 			 (error "Couldn't find doc group"))
 		       file))))))
-  "Alist of useful group-server pairs."
+  "*Alist of useful group-server pairs."
   :group 'gnus-group-listing
   :type '(repeat (list (string :tag "Description")
 		       (string :tag "Name")
@@ -295,6 +299,18 @@ variable."
      gnus-group-news-3-empty-face)
     ((and (not mailp) (eq level 3)) .
      gnus-group-news-3-face)
+    ((and (= unread 0) (not mailp) (eq level 4)) .
+     gnus-group-news-4-empty-face)
+    ((and (not mailp) (eq level 4)) .
+     gnus-group-news-4-face)
+    ((and (= unread 0) (not mailp) (eq level 5)) .
+     gnus-group-news-5-empty-face)
+    ((and (not mailp) (eq level 5)) .
+     gnus-group-news-5-face)
+    ((and (= unread 0) (not mailp) (eq level 6)) .
+     gnus-group-news-6-empty-face)
+    ((and (not mailp) (eq level 6)) .
+     gnus-group-news-6-face)
     ((and (= unread 0) (not mailp)) .
      gnus-group-news-low-empty-face)
     ((and (not mailp)) .
@@ -316,7 +332,7 @@ variable."
      gnus-group-mail-low-empty-face)
     (t .
      gnus-group-mail-low-face))
-  "Controls the highlighting of group buffer lines.
+  "*Controls the highlighting of group buffer lines.
 
 Below is a list of `Form'/`Face' pairs.  When deciding how a a
 particular group line should be displayed, each form is
@@ -428,6 +444,7 @@ ticked: The number of ticked articles."
     "p" gnus-group-prev-unread-group
     "\177" gnus-group-prev-unread-group
     [delete] gnus-group-prev-unread-group
+    [backspace] gnus-group-prev-unread-group
     "N" gnus-group-next-group
     "P" gnus-group-prev-group
     "\M-n" gnus-group-next-unread-group-same-level
@@ -707,7 +724,7 @@ ticked: The number of ticked articles."
 	 (fboundp 'gnus-soup-pack-packet)]
 	["Pack packet" gnus-soup-pack-packet (fboundp 'gnus-soup-pack-packet)]
 	["Save areas" gnus-soup-save-areas (fboundp 'gnus-soup-pack-packet)]
-	["Brew SOUP" gnus-soup-brew-soup (fboundp 'gnus-soup-pack-packet)])
+	["Brew SOUP" gnus-group-brew-soup (fboundp 'gnus-soup-pack-packet)])
        ["Send a bug report" gnus-bug t]
        ["Send a mail" gnus-group-mail t]
        ["Post an article..." gnus-group-post-news t]
@@ -726,10 +743,11 @@ ticked: The number of ticked articles."
        ["Read manual" gnus-info-find-node t]
        ["Flush score cache" gnus-score-flush-cache t]
        ["Toggle topics" gnus-topic-mode t]
+       ["Send a bug report" gnus-bug t]
        ["Exit from Gnus" gnus-group-exit t]
        ["Exit without saving" gnus-group-quit t]))
 
-    (run-hooks 'gnus-group-menu-hook)))
+    (gnus-run-hooks 'gnus-group-menu-hook)))
 
 (defun gnus-group-mode ()
   "Major mode for reading news.
@@ -758,23 +776,24 @@ The following commands are available:
   (gnus-group-set-mode-line)
   (setq mode-line-process nil)
   (use-local-map gnus-group-mode-map)
-  (buffer-disable-undo (current-buffer))
+  (buffer-disable-undo)
   (setq truncate-lines t)
   (setq buffer-read-only t)
   (gnus-set-default-directory)
   (gnus-update-format-specifications nil 'group 'group-mode)
   (gnus-update-group-mark-positions)
-  (make-local-hook 'post-command-hook)
-  (add-hook 'post-command-hook 'gnus-clear-inboxes-moved nil t)
   (when gnus-use-undo
     (gnus-undo-mode 1))
-  (run-hooks 'gnus-group-mode-hook))
+  (when gnus-slave
+    (gnus-slave-mode))
+  (gnus-run-hooks 'gnus-group-mode-hook))
 
 (defun gnus-update-group-mark-positions ()
   (save-excursion
-    (let ((gnus-process-mark 128)
+    (let ((gnus-process-mark ?\200)
 	  (gnus-group-marked '("dummy.group"))
-	  (gnus-active-hashtb (make-vector 10 0)))
+	  (gnus-active-hashtb (make-vector 10 0))
+	  (topic ""))
       (gnus-set-active "dummy.group" '(0 . 0))
       (gnus-set-work-buffer)
       (gnus-group-insert-group-line "dummy.group" 0 nil 0 nil)
@@ -783,9 +802,6 @@ The following commands are available:
 	    (list (cons 'process (and (search-forward "\200" nil t)
 				      (- (point) 2))))))))
 
-(defun gnus-clear-inboxes-moved ()
-  (setq nnmail-moved-inboxes nil))
-
 (defun gnus-mouse-pick-group (e)
   "Enter the group under the mouse pointer."
   (interactive "e")
@@ -810,9 +826,8 @@ The following commands are available:
     (or level gnus-group-default-list-level gnus-level-subscribed))))
 
 (defun gnus-group-setup-buffer ()
-  (switch-to-buffer (get-buffer-create gnus-group-buffer))
+  (set-buffer (gnus-get-buffer-create gnus-group-buffer))
   (unless (eq major-mode 'gnus-group-mode)
-    (gnus-add-current-to-buffer-list)
     (gnus-group-mode)
     (when gnus-carpal
       (gnus-carpal-setup-buffer 'group))))
@@ -831,8 +846,6 @@ Also see the `gnus-group-use-permanent-levels' variable."
 	    (gnus-group-default-level nil t)
 	    gnus-group-default-list-level
 	    gnus-level-subscribed))))
-  ;; Just do this here, for no particular good reason.
-  (gnus-clear-inboxes-moved)
   (unless level
     (setq level (car gnus-group-list-mode)
 	  unread (cdr gnus-group-list-mode)))
@@ -946,7 +959,7 @@ If REGEXP, only list groups matching REGEXP."
 
     (gnus-group-set-mode-line)
     (setq gnus-group-list-mode (cons level all))
-    (run-hooks 'gnus-group-prepare-hook)
+    (gnus-run-hooks 'gnus-group-prepare-hook)
     t))
 
 (defun gnus-group-prepare-flat-list-dead (groups level mark regexp)
@@ -1088,7 +1101,7 @@ If REGEXP, only list groups matching REGEXP."
 		  gnus-level ,gnus-tmp-level))
     (when (inline (gnus-visual-p 'group-highlight 'highlight))
       (forward-line -1)
-      (run-hooks 'gnus-group-update-hook)
+      (gnus-run-hooks 'gnus-group-update-hook)
       (forward-line))
     ;; Allow XEmacs to remove front-sticky text properties.
     (gnus-group-remove-excess-properties)))
@@ -1111,7 +1124,7 @@ If REGEXP, only list groups matching REGEXP."
 	 (mailp (memq 'mail (assoc (symbol-name
 				    (car (or method gnus-select-method)))
 				   gnus-valid-select-methods)))
-	 (level (or (gnus-info-level info) 9))
+	 (level (or (gnus-info-level info) gnus-level-killed))
 	 (score (or (gnus-info-score info) 0))
 	 (ticked (gnus-range-length (cdr (assq 'tick marked))))
 	 (group-age (gnus-group-timestamp-delta group))
@@ -1122,7 +1135,7 @@ If REGEXP, only list groups matching REGEXP."
       (setq list (cdr list)))
     (let ((face (cdar list)))
       (unless (eq face (get-text-property beg 'face))
-	(gnus-put-text-property
+	(gnus-put-text-property-excluding-characters-with-faces
 	 beg end 'face
 	 (setq face (if (boundp face) (symbol-value face) face)))
 	(gnus-extent-start-open beg)))
@@ -1145,7 +1158,8 @@ already."
 	    found buffer-read-only)
 	;; Enter the current status into the dribble buffer.
 	(let ((entry (gnus-gethash group gnus-newsrc-hashtb)))
-	  (when (and entry (not (gnus-ephemeral-group-p group)))
+	  (when (and entry
+		     (not (gnus-ephemeral-group-p group)))
 	    (gnus-dribble-enter
 	     (concat "(gnus-group-set-info '"
 		     (gnus-prin1-to-string (nth 2 entry))
@@ -1161,7 +1175,7 @@ already."
 	    (gnus-group-insert-group-line-info group)
 	    (save-excursion
 	      (forward-line -1)
-	      (run-hooks 'gnus-group-update-group-hook)))
+	      (gnus-run-hooks 'gnus-group-update-group-hook)))
 	  (setq loc (1+ loc)))
 	(unless (or found visible-only)
 	  ;; No such line in the buffer, find out where it's supposed to
@@ -1183,7 +1197,7 @@ already."
 	    (gnus-group-insert-group-line-info group)
 	    (save-excursion
 	      (forward-line -1)
-	      (run-hooks 'gnus-group-update-group-hook))))
+	      (gnus-run-hooks 'gnus-group-update-group-hook))))
 	(when gnus-group-update-group-function
 	  (funcall gnus-group-update-group-function group))
 	(gnus-group-set-mode-line)))
@@ -1229,7 +1243,8 @@ already."
 (defun gnus-group-group-name ()
   "Get the name of the newsgroup on the current line."
   (let ((group (get-text-property (gnus-point-at-bol) 'gnus-group)))
-    (and group (symbol-name group))))
+    (when group
+      (symbol-name group))))
 
 (defun gnus-group-group-level ()
   "Get the level of the newsgroup on the current line."
@@ -1254,8 +1269,8 @@ already."
 (defun gnus-group-level (group)
   "Return the estimated level of GROUP."
   (or (gnus-info-level (gnus-get-info group))
-      (and (member group gnus-zombie-list) 8)
-      9))
+      (and (member group gnus-zombie-list) gnus-level-zombie)
+      gnus-level-killed))
 
 (defun gnus-group-search-forward (&optional backward all level first-too)
   "Find the next newsgroup with unread articles.
@@ -1318,7 +1333,7 @@ If FIRST-TOO, the current line is also eligible as a target."
 	(beginning-of-line)
 	(forward-char (or (cdr (assq 'process gnus-group-mark-positions)) 2))
 	(subst-char-in-region
-	 (point) (1+ (point)) (following-char)
+	 (point) (1+ (point)) (char-after)
 	 (if unmark
 	     (progn
 	       (setq gnus-group-marked (delete group gnus-group-marked))
@@ -1417,9 +1432,9 @@ Take into consideration N (the prefix) and the list of marked groups."
 	  (n (abs n))
 	  group groups)
       (save-excursion
-	(while (and (> n 0)
-		    (setq group (gnus-group-group-name)))
-	  (push group groups)
+	(while (> n 0)
+	  (if (setq group (gnus-group-group-name))
+	      (push group groups))
 	  (setq n (1- n))
 	  (gnus-group-next-group way)))
       (nreverse groups)))
@@ -1444,6 +1459,8 @@ Take into consideration N (the prefix) and the list of marked groups."
     (let ((group (gnus-group-group-name)))
       (and group (list group))))))
 
+;;; !!!Surely gnus-group-iterate should be a macro instead?  I can't
+;;; imagine why I went through these contortions...
 (eval-and-compile
   (let ((function (make-symbol "gnus-group-iterate-function"))
 	(window (make-symbol "gnus-group-iterate-window"))
@@ -1463,12 +1480,12 @@ and with point over the group in question."
 	    (save-selected-window
 	      (save-excursion
 		(funcall ,function ,group)))))))))
-  
+
 (put 'gnus-group-iterate 'lisp-indent-function 1)
 
 ;; Selecting groups.
 
-(defun gnus-group-read-group (&optional all no-article group)
+(defun gnus-group-read-group (&optional all no-article group select-articles)
   "Read news in this newsgroup.
 If the prefix argument ALL is non-nil, already read articles become
 readable.  IF ALL is a number, fetch this number of articles.  If the
@@ -1499,7 +1516,7 @@ group."
 					  (cdr (assq 'tick marked)))
 				  (gnus-range-length
 				   (cdr (assq 'dormant marked)))))))
-     no-article nil no-display)))
+     no-article nil no-display nil select-articles)))
 
 (defun gnus-group-select-group (&optional all)
   "Select this newsgroup.
@@ -1545,10 +1562,6 @@ be permanent."
 	 gnus-summary-mode-hook gnus-select-group-hook
 	 (group (gnus-group-group-name))
 	 (method (gnus-find-method-for-group group)))
-    (setq method
-	  `(,(car method) ,(concat (cadr method) "-ephemeral")
-	    (,(intern (format "%s-address" (car method))) ,(cadr method))
-	    ,@(cddr method)))
     (gnus-group-read-ephemeral-group
      (gnus-group-prefixed-name group method) method)))
 
@@ -1561,30 +1574,41 @@ Returns whether the fetching was successful or not."
     (gnus-no-server))
   (gnus-group-read-group nil nil group))
 
+;;;###autoload
+(defun gnus-fetch-group-other-frame (group)
+  "Pop up a frame and enter GROUP."
+  (interactive "P")
+  (let ((window (get-buffer-window gnus-group-buffer)))
+    (cond (window
+	   (select-frame (window-frame window)))
+	  ((= (length (frame-list)) 1)
+	   (select-frame (make-frame)))
+	  (t
+	   (other-frame 1))))
+  (gnus-fetch-group group))
+
 (defvar gnus-ephemeral-group-server 0)
 
 ;; Enter a group that is not in the group buffer.  Non-nil is returned
 ;; if selection was successful.
 (defun gnus-group-read-ephemeral-group (group method &optional activate
-					      quit-config request-only)
+					      quit-config request-only
+					      select-articles)
   "Read GROUP from METHOD as an ephemeral group.
 If ACTIVATE, request the group first.
 If QUIT-CONFIG, use that window configuration when exiting from the
 ephemeral group.
 If REQUEST-ONLY, don't actually read the group; just request it.
+If SELECT-ARTICLES, only select those articles.
 
 Return the name of the group is selection was successful."
   ;; Transform the select method into a unique server.
   (when (stringp method)
     (setq method (gnus-server-to-method method)))
-  (let ((saddr (intern (format "%s-address" (car method)))))
-    (setq method (gnus-copy-sequence method))
-    (require (car method))
-    (when (boundp saddr)
-      (unless (assq saddr method)
-	(nconc method `((,saddr ,(cadr method))))
-	(setf (cadr method) (format "%s-%d" (cadr method)
-				    (incf gnus-ephemeral-group-server))))))
+  (setq method
+	`(,(car method) ,(concat (cadr method) "-ephemeral")
+	  (,(intern (format "%s-address" (car method))) ,(cadr method))
+	  ,@(cddr method)))
   (let ((group (if (gnus-group-foreign-p group) group
 		 (gnus-group-prefixed-name group method))))
     (gnus-sethash
@@ -1596,6 +1620,7 @@ Return the name of the group is selection was successful."
 				(cons gnus-summary-buffer
 				      gnus-current-window-configuration))))))
      gnus-newsrc-hashtb)
+    (push method gnus-ephemeral-servers)
     (set-buffer gnus-group-buffer)
     (unless (gnus-check-server method)
       (error "Unable to contact server: %s" (gnus-status-message method)))
@@ -1607,7 +1632,7 @@ Return the name of the group is selection was successful."
     (if request-only
 	group
       (condition-case ()
-	  (when (gnus-group-read-group t t group)
+	  (when (gnus-group-read-group t t group select-articles)
 	    group)
 	;;(error nil)
 	(quit nil)))))
@@ -1782,6 +1807,8 @@ ADDRESS."
     (gnus-read-group "Group name: ")
     (gnus-read-method "From method: ")))
 
+  (when (stringp method)
+    (setq method (or (gnus-server-to-method method) method)))
   (let* ((meth (when (and method
 			  (not (gnus-server-equal method gnus-select-method)))
 		 (if address (list (intern method) address)
@@ -1894,6 +1921,9 @@ and NEW-NAME will be prompted for."
 	(gnus-set-active new-name (gnus-active group))
 	(gnus-message 6 "Renaming group %s to %s...done" group new-name)
 	new-name)
+    (setq gnus-killed-list (delete group gnus-killed-list))
+    (gnus-set-active group nil)
+    (gnus-dribble-touch)
     (gnus-group-position-point)))
 
 (defun gnus-group-edit-group (group &optional part)
@@ -1972,6 +2002,7 @@ and NEW-NAME will be prompted for."
     (gnus-group-position-point)))
 
 (defun gnus-group-make-useful-group (group method)
+  "Create one of the groups described in `gnus-useful-groups'."
   (interactive
    (let ((entry (assoc (completing-read "Create group: " gnus-useful-groups
 					nil t)
@@ -1987,8 +2018,7 @@ and NEW-NAME will be prompted for."
   "Create the Gnus documentation group."
   (interactive)
   (let ((name (gnus-group-prefixed-name "gnus-help" '(nndoc "gnus-help")))
-	(file (nnheader-find-etc-directory "gnus-tut.txt" t))
-	dir)
+	(file (nnheader-find-etc-directory "gnus-tut.txt" t)))
     (when (gnus-gethash name gnus-newsrc-hashtb)
       (error "Documentation group already exists"))
     (if (not file)
@@ -2131,7 +2161,7 @@ score file entries for articles to include in the group."
 	(push (cons header regexps) scores))
       scores)))
   (gnus-group-make-group group "nnkiboze" address)
-  (nnheader-temp-write (gnus-score-file-name (concat "nnkiboze:" group))
+  (with-temp-file (gnus-score-file-name (concat "nnkiboze:" group))
     (let (emacs-lisp-mode-hook)
       (pp scores (current-buffer)))))
 
@@ -2276,46 +2306,52 @@ If REVERSE, sort in reverse order."
     ;; Go through all the infos and replace the old entries
     ;; with the new infos.
     (while infos
-      (setcar entries (pop infos))
+      (setcar (car entries) (pop infos))
       (pop entries))
     ;; Update the hashtable.
     (gnus-make-hashtable-from-newsrc-alist)))
 
-(defun gnus-group-sort-selected-groups-by-alphabet (&optional reverse)
+(defun gnus-group-sort-selected-groups-by-alphabet (&optional n reverse)
   "Sort the group buffer alphabetically by group name.
-If REVERSE, sort in reverse order."
-  (interactive "P")
-  (gnus-group-sort-selected-groups 'gnus-group-sort-by-alphabet reverse))
+Obeys the process/prefix convention.  If REVERSE (the symbolic prefix),
+sort in reverse order."
+  (interactive (gnus-interactive "P\ny"))
+  (gnus-group-sort-selected-groups n 'gnus-group-sort-by-alphabet reverse))
 
-(defun gnus-group-sort-selected-groups-by-unread (&optional reverse)
+(defun gnus-group-sort-selected-groups-by-unread (&optional n reverse)
   "Sort the group buffer by number of unread articles.
-If REVERSE, sort in reverse order."
-  (interactive "P")
-  (gnus-group-sort-selected-groups 'gnus-group-sort-by-unread reverse))
+Obeys the process/prefix convention.  If REVERSE (the symbolic prefix),
+sort in reverse order."
+  (interactive (gnus-interactive "P\ny"))
+  (gnus-group-sort-selected-groups n 'gnus-group-sort-by-unread reverse))
 
-(defun gnus-group-sort-selected-groups-by-level (&optional reverse)
+(defun gnus-group-sort-selected-groups-by-level (&optional n reverse)
   "Sort the group buffer by group level.
-If REVERSE, sort in reverse order."
-  (interactive "P")
-  (gnus-group-sort-selected-groups 'gnus-group-sort-by-level reverse))
+Obeys the process/prefix convention.  If REVERSE (the symbolic prefix),
+sort in reverse order."
+  (interactive (gnus-interactive "P\ny"))
+  (gnus-group-sort-selected-groups n 'gnus-group-sort-by-level reverse))
 
-(defun gnus-group-sort-selected-groups-by-score (&optional reverse)
+(defun gnus-group-sort-selected-groups-by-score (&optional n reverse)
   "Sort the group buffer by group score.
-If REVERSE, sort in reverse order."
-  (interactive "P")
-  (gnus-group-sort-selected-groups 'gnus-group-sort-by-score reverse))
+Obeys the process/prefix convention.  If REVERSE (the symbolic prefix),
+sort in reverse order."
+  (interactive (gnus-interactive "P\ny"))
+  (gnus-group-sort-selected-groups n 'gnus-group-sort-by-score reverse))
 
-(defun gnus-group-sort-selected-groups-by-rank (&optional reverse)
+(defun gnus-group-sort-selected-groups-by-rank (&optional n reverse)
   "Sort the group buffer by group rank.
-If REVERSE, sort in reverse order."
-  (interactive "P")
-  (gnus-group-sort-selected-groups 'gnus-group-sort-by-rank reverse))
+Obeys the process/prefix convention.  If REVERSE (the symbolic prefix),
+sort in reverse order."
+  (interactive (gnus-interactive "P\ny"))
+  (gnus-group-sort-selected-groups n 'gnus-group-sort-by-rank reverse))
 
-(defun gnus-group-sort-selected-groups-by-method (&optional reverse)
+(defun gnus-group-sort-selected-groups-by-method (&optional n reverse)
   "Sort the group buffer alphabetically by backend name.
-If REVERSE, sort in reverse order."
-  (interactive "P")
-  (gnus-group-sort-selected-groups 'gnus-group-sort-by-method reverse))
+Obeys the process/prefix convention.  If REVERSE (the symbolic prefix),
+sort in reverse order."
+  (interactive (gnus-interactive "P\ny"))
+  (gnus-group-sort-selected-groups n 'gnus-group-sort-by-method reverse))
 
 ;;; Sorting predicates.
 
@@ -2381,7 +2417,7 @@ If REVERSE, sort in reverse order."
 	(when (gnus-group-native-p (gnus-info-group info))
 	  (gnus-info-clear-data info)))
       (gnus-get-unread-articles)
-      (gnus-dribble-enter "")
+      (gnus-dribble-touch)
       (when (gnus-y-or-n-p
 	     "Move the cache away to avoid problems in the future? ")
 	(call-interactively 'gnus-cache-move-cache)))))
@@ -2403,16 +2439,16 @@ If REVERSE, sort in reverse order."
 
 (defun gnus-group-catchup-current (&optional n all)
   "Mark all articles not marked as unread in current newsgroup as read.
-If prefix argument N is numeric, the ARG next newsgroups will be
+If prefix argument N is numeric, the next N newsgroups will be
 caught up.  If ALL is non-nil, marked articles will also be marked as
 read.  Cross references (Xref: header) of articles are ignored.
-The difference between N and actual number of newsgroups that were
-caught up is returned."
+The number of newsgroups that this function was unable to catch
+up is returned."
   (interactive "P")
-  (unless (gnus-group-group-name)
-    (error "No group on the current line"))
   (let ((groups (gnus-group-process-prefix n))
-	(ret 0))
+	(ret 0)
+	group)
+    (unless groups (error "No groups selected"))
     (if (not
 	 (or (not gnus-interactive-catchup) ;Without confirmation?
 	     gnus-expert-user
@@ -2425,21 +2461,21 @@ caught up is returned."
 		   (car groups)
 		 (format "these %d groups" (length groups)))))))
 	n
-      (while groups
+      (while (setq group (pop groups))
+	(gnus-group-remove-mark group)
 	;; Virtual groups have to be given special treatment.
-	(let ((method (gnus-find-method-for-group (car groups))))
+	(let ((method (gnus-find-method-for-group group)))
 	  (when (eq 'nnvirtual (car method))
 	    (nnvirtual-catchup-group
-	     (gnus-group-real-name (car groups)) (nth 1 method) all)))
-	(gnus-group-remove-mark (car groups))
-	(if (>= (gnus-group-group-level) gnus-level-zombie)
+	     (gnus-group-real-name group) (nth 1 method) all)))
+	(if (>= (gnus-info-level (gnus-get-info group))
+		gnus-level-zombie)
 	    (gnus-message 2 "Dead groups can't be caught up")
 	  (if (prog1
-		  (gnus-group-goto-group (car groups))
-		(gnus-group-catchup (car groups) all))
+		  (gnus-group-goto-group group)
+		(gnus-group-catchup group all))
 	      (gnus-group-update-group-line)
-	    (setq ret (1+ ret))))
-	(setq groups (cdr groups)))
+	    (setq ret (1+ ret)))))
       (gnus-group-next-unread-group 1)
       ret)))
 
@@ -2476,7 +2512,7 @@ or nil if no action could be taken."
 	  (gnus-add-marked-articles group 'tick nil nil 'force)
 	  (gnus-add-marked-articles group 'dormant nil nil 'force))
 	(let ((gnus-newsgroup-name group))
-	  (run-hooks 'gnus-group-catchup-group-hook))
+	  (gnus-run-hooks 'gnus-group-catchup-group-hook))
 	num))))
 
 (defun gnus-group-expire-articles (&optional n)
@@ -2488,32 +2524,35 @@ or nil if no action could be taken."
       (error "No groups to expire"))
     (while (setq group (pop groups))
       (gnus-group-remove-mark group)
-      (when (gnus-check-backend-function 'request-expire-articles group)
-	(gnus-message 6 "Expiring articles in %s..." group)
-	(let* ((info (gnus-get-info group))
-	       (expirable (if (gnus-group-total-expirable-p group)
-			      (cons nil (gnus-list-of-read-articles group))
-			    (assq 'expire (gnus-info-marks info))))
-	       (expiry-wait (gnus-group-find-parameter group 'expiry-wait)))
-	  (when expirable
-	    (setcdr
-	     expirable
-	     (gnus-compress-sequence
-	      (if expiry-wait
-		  ;; We set the expiry variables to the group
-		  ;; parameter.
-		  (let ((nnmail-expiry-wait-function nil)
-			(nnmail-expiry-wait expiry-wait))
-		    (gnus-request-expire-articles
-		     (gnus-uncompress-sequence (cdr expirable)) group))
-		;; Just expire using the normal expiry values.
-		(gnus-request-expire-articles
-		 (gnus-uncompress-sequence (cdr expirable)) group))))
-	    (gnus-close-group group))
-	  (gnus-message 6 "Expiring articles in %s...done" group)))
+      (gnus-group-expire-articles-1 group)
       (gnus-dribble-touch)
       (gnus-group-position-point))))
 
+(defun gnus-group-expire-articles-1 (group)
+  (when (gnus-check-backend-function 'request-expire-articles group)
+    (gnus-message 6 "Expiring articles in %s..." group)
+    (let* ((info (gnus-get-info group))
+	   (expirable (if (gnus-group-total-expirable-p group)
+			  (cons nil (gnus-list-of-read-articles group))
+			(assq 'expire (gnus-info-marks info))))
+	   (expiry-wait (gnus-group-find-parameter group 'expiry-wait)))
+      (when expirable
+	(setcdr
+	 expirable
+	 (gnus-compress-sequence
+	  (if expiry-wait
+	      ;; We set the expiry variables to the group
+	      ;; parameter.
+	      (let ((nnmail-expiry-wait-function nil)
+		    (nnmail-expiry-wait expiry-wait))
+		(gnus-request-expire-articles
+		 (gnus-uncompress-sequence (cdr expirable)) group))
+	    ;; Just expire using the normal expiry values.
+	    (gnus-request-expire-articles
+	     (gnus-uncompress-sequence (cdr expirable)) group))))
+	(gnus-close-group group))
+      (gnus-message 6 "Expiring articles in %s...done" group))))
+
 (defun gnus-group-expire-all-groups ()
   "Expire all expirable articles in all newsgroups."
   (interactive)
@@ -2540,7 +2579,7 @@ or nil if no action could be taken."
 			      gnus-level-default-subscribed))
 	 s)))))
   (unless (and (>= level 1) (<= level gnus-level-killed))
-    (error "Illegal level: %d" level))
+    (error "Invalid level: %d" level))
   (let ((groups (gnus-group-process-prefix n))
 	group)
     (while (setq group (pop groups))
@@ -2600,7 +2639,7 @@ group line."
 	  'gnus-group-history)))
   (let ((newsrc (gnus-gethash group gnus-newsrc-hashtb)))
     (cond
-     ((string-match "^[ \t]$" group)
+     ((string-match "^[ \t]*$" group)
       (error "Empty group name"))
      (newsrc
       ;; Toggle subscription flag.
@@ -2644,10 +2683,11 @@ N and the number of steps taken is returned."
 (defun gnus-group-kill-all-zombies ()
   "Kill all zombie newsgroups."
   (interactive)
-  (setq gnus-killed-list (nconc gnus-zombie-list gnus-killed-list))
-  (setq gnus-zombie-list nil)
-  (gnus-dribble-touch)
-  (gnus-group-list-groups))
+  (when (gnus-yes-or-no-p "Really kill all zombies? ")
+    (setq gnus-killed-list (nconc gnus-zombie-list gnus-killed-list))
+    (setq gnus-zombie-list nil)
+    (gnus-dribble-touch)
+    (gnus-group-list-groups)))
 
 (defun gnus-group-kill-region (begin end)
   "Kill newsgroups in current region (excluding current point).
@@ -2709,7 +2749,8 @@ of groups killed."
 		(delq (assoc group gnus-newsrc-alist)
 		      gnus-newsrc-alist))
 	  (when gnus-group-change-level-function
-	    (funcall gnus-group-change-level-function group 9 3))
+	    (funcall gnus-group-change-level-function
+		     group gnus-level-killed 3))
 	  (cond
 	   ((setq entry (gnus-gethash group gnus-newsrc-hashtb))
 	    (push (cons (car entry) (nth 2 entry))
@@ -2726,11 +2767,10 @@ of groups killed."
     (if (< (length out) 2) (car out) (nreverse out))))
 
 (defun gnus-group-yank-group (&optional arg)
-  "Yank the last newsgroups killed with \\[gnus-group-kill-group],
-inserting it before the current newsgroup.  The numeric ARG specifies
-how many newsgroups are to be yanked.  The name of the newsgroup yanked
-is returned, or (if several groups are yanked) a list of yanked groups
-is returned."
+  "Yank the last newsgroups killed with \\[gnus-group-kill-group], inserting it before the current newsgroup.
+The numeric ARG specifies how many newsgroups are to be yanked.  The
+name of the newsgroup yanked is returned, or (if several groups are
+yanked) a list of yanked groups is returned."
   (interactive "p")
   (setq arg (or arg 1))
   (let (info group prev out)
@@ -2782,7 +2822,7 @@ is returned."
       (gnus-make-hashtable-from-newsrc-alist)
       (gnus-group-list-groups)))
    (t
-    (error "Can't kill; illegal level: %d" level))))
+    (error "Can't kill; invalid level: %d" level))))
 
 (defun gnus-group-list-all-groups (&optional arg)
   "List all newsgroups with level ARG or lower.
@@ -2854,7 +2894,7 @@ entail asking the server for the groups."
 
 (defun gnus-activate-all-groups (level)
   "Activate absolutely all groups."
-  (interactive (list 7))
+  (interactive (list gnus-level-unsubscribed))
   (let ((gnus-activate-level level)
 	(gnus-activate-foreign-newsgroups level))
     (gnus-group-get-new-news)))
@@ -2865,8 +2905,12 @@ If ARG is a number, it specifies which levels you are interested in
 re-scanning.  If ARG is non-nil and not a number, this will force
 \"hard\" re-reading of the active files from all servers."
   (interactive "P")
-  (let ((gnus-inhibit-demon t))
-    (run-hooks 'gnus-get-new-news-hook)
+  (require 'nnmail)
+  (let ((gnus-inhibit-demon t)
+	;; Binding this variable will inhibit multiple fetchings
+	;; of the same mail source.
+	(nnmail-fetched-sources (list t)))
+    (gnus-run-hooks 'gnus-get-new-news-hook)
 
     ;; Read any slave files.
     (unless gnus-slave
@@ -2893,7 +2937,7 @@ re-scanning.  If ARG is non-nil and not a number, this will force
 	  (gnus-get-unread-articles arg))
       (let ((gnus-read-active-file (if arg nil gnus-read-active-file)))
 	(gnus-get-unread-articles arg)))
-    (run-hooks 'gnus-after-getting-new-news-hook)
+    (gnus-run-hooks 'gnus-after-getting-new-news-hook)
     (gnus-group-list-groups (and (numberp arg)
 				 (max (car gnus-group-list-mode) arg)))))
 
@@ -2906,17 +2950,20 @@ If N is negative, this group and the N-1 previous groups will be checked."
 	 (ret (if (numberp n) (- n (length groups)) 0))
 	 (beg (unless n
 		(point)))
-	 group)
+	 group method)
     (while (setq group (pop groups))
       (gnus-group-remove-mark group)
       ;; Bypass any previous denials from the server.
-      (gnus-remove-denial (gnus-find-method-for-group group))
+      (gnus-remove-denial (setq method (gnus-find-method-for-group group)))
       (if (gnus-activate-group group (if dont-scan nil 'scan))
 	  (progn
 	    (gnus-get-unread-articles-in-group
 	     (gnus-get-info group) (gnus-active group) t)
 	    (unless (gnus-virtual-group-p group)
 	      (gnus-close-group group))
+	    (when gnus-agent
+	      (gnus-agent-save-group-info
+	       method (gnus-group-real-name group) (gnus-active group)))
 	    (gnus-group-update-group group))
 	(if (eq (gnus-server-status (gnus-find-method-for-group group))
 		'denied)
@@ -2949,8 +2996,8 @@ to use."
       (setq dirs (list dirs)))
     (while (and (not found)
 		(setq dir (pop dirs)))
-      (setq file (concat (file-name-as-directory dir)
-			 (gnus-group-real-name group)))
+      (let ((name (gnus-group-real-name group)))
+	(setq file (concat (file-name-as-directory dir) name)))
       (if (not (file-exists-p file))
 	  (gnus-message 1 "No such file: %s" file)
 	(let ((enable-local-variables nil))
@@ -3015,6 +3062,7 @@ to use."
      (lambda (group)
        (and (symbol-name group)
 	    (string-match regexp (symbol-name group))
+	    (symbol-value group)
 	    (push (symbol-name group) groups)))
      gnus-active-hashtb)
     ;; Also go through all descriptions that are known to Gnus.
@@ -3022,7 +3070,6 @@ to use."
       (mapatoms
        (lambda (group)
 	 (and (string-match regexp (symbol-value group))
-	      (gnus-active (symbol-name group))
 	      (push (symbol-name group) groups)))
        gnus-description-hashtb))
     (if (not groups)
@@ -3030,7 +3077,7 @@ to use."
       ;; Print out all the groups.
       (save-excursion
 	(pop-to-buffer "*Gnus Help*")
-	(buffer-disable-undo (current-buffer))
+	(buffer-disable-undo)
 	(erase-buffer)
 	(setq groups (sort groups 'string<))
 	(while groups
@@ -3115,12 +3162,14 @@ group."
 (defun gnus-group-find-new-groups (&optional arg)
   "Search for new groups and add them.
 Each new group will be treated with `gnus-subscribe-newsgroup-method.'
-If ARG (the prefix), use the `ask-server' method to query
-the server for new groups."
-  (interactive "P")
-  (gnus-find-new-newsgroups arg)
+With 1 C-u, use the `ask-server' method to query the server for new
+groups.
+With 2 C-u's, use most complete method possible to query the server
+for new groups, and subscribe the new groups as zombies."
+  (interactive "p")
+  (gnus-find-new-newsgroups (or arg 1))
   (gnus-group-list-groups))
-  
+
 (defun gnus-group-edit-global-kill (&optional article group)
   "Edit the global kill file.
 If GROUP, edit that local kill file instead."
@@ -3148,18 +3197,15 @@ If GROUP, edit that local kill file instead."
 In fact, cleanup buffers except for group mode buffer.
 The hook gnus-suspend-gnus-hook is called before actually suspending."
   (interactive)
-  (run-hooks 'gnus-suspend-gnus-hook)
+  (gnus-run-hooks 'gnus-suspend-gnus-hook)
   ;; Kill Gnus buffers except for group mode buffer.
-  (let* ((group-buf (get-buffer gnus-group-buffer))
-	 ;; Do this on a separate list in case the user does a ^G before we finish
-	 (gnus-buffer-list
-	  (delete group-buf (delete gnus-dribble-buffer
-				    (append gnus-buffer-list nil)))))
-    (while gnus-buffer-list
-      (gnus-kill-buffer (pop gnus-buffer-list)))
+  (let ((group-buf (get-buffer gnus-group-buffer)))
+    (mapcar (lambda (buf)
+	      (unless (member buf (list group-buf gnus-dribble-buffer))
+		(kill-buffer buf)))
+	    (gnus-buffers))
     (gnus-kill-gnus-frames)
     (when group-buf
-      (setq gnus-buffer-list (list group-buf))
       (bury-buffer group-buf)
       (delete-windows-on group-buf t))))
 
@@ -3178,7 +3224,7 @@ The hook `gnus-exit-gnus-hook' is called before actually exiting."
 	  (not gnus-interactive-exit)	;Without confirmation
 	  gnus-expert-user
 	  (gnus-y-or-n-p "Are you sure you want to quit reading news? "))
-    (run-hooks 'gnus-exit-gnus-hook)
+    (gnus-run-hooks 'gnus-exit-gnus-hook)
     ;; Offer to save data from non-quitted summary buffers.
     (gnus-offer-save-summaries)
     ;; Save the newsrc file(s).
@@ -3188,7 +3234,7 @@ The hook `gnus-exit-gnus-hook' is called before actually exiting."
     ;; Reset everything.
     (gnus-clear-system)
     ;; Allow the user to do things after cleaning up.
-    (run-hooks 'gnus-after-exiting-gnus-hook)))
+    (gnus-run-hooks 'gnus-after-exiting-gnus-hook)))
 
 (defun gnus-group-quit ()
   "Quit reading news without updating .newsrc.eld or .newsrc.
@@ -3202,14 +3248,14 @@ The hook `gnus-exit-gnus-hook' is called before actually exiting."
 	    (gnus-yes-or-no-p
 	     (format "Quit reading news without saving %s? "
 		     (file-name-nondirectory gnus-current-startup-file))))
-    (run-hooks 'gnus-exit-gnus-hook)
+    (gnus-run-hooks 'gnus-exit-gnus-hook)
     (gnus-configure-windows 'group t)
     (gnus-dribble-save)
     (gnus-close-backends)
     (gnus-clear-system)
     (gnus-kill-buffer gnus-group-buffer)
     ;; Allow the user to do things after cleaning up.
-    (run-hooks 'gnus-after-exiting-gnus-hook)))
+    (gnus-run-hooks 'gnus-after-exiting-gnus-hook)))
 
 (defun gnus-group-describe-briefly ()
   "Give a one line description of the group mode commands."
@@ -3241,59 +3287,60 @@ and the second element is the address."
   (gnus-browse-foreign-server method))
 
 (defun gnus-group-set-info (info &optional method-only-group part)
-  (let* ((entry (gnus-gethash
-		 (or method-only-group (gnus-info-group info))
-		 gnus-newsrc-hashtb))
-	 (part-info info)
-	 (info (if method-only-group (nth 2 entry) info))
-	 method)
-    (when method-only-group
+  (when info
+    (let* ((entry (gnus-gethash
+		   (or method-only-group (gnus-info-group info))
+		   gnus-newsrc-hashtb))
+	   (part-info info)
+	   (info (if method-only-group (nth 2 entry) info))
+	   method)
+      (when method-only-group
+	(unless entry
+	  (error "Trying to change non-existent group %s" method-only-group))
+	;; We have received parts of the actual group info - either the
+	;; select method or the group parameters.	 We first check
+	;; whether we have to extend the info, and if so, do that.
+	(let ((len (length info))
+	      (total (if (eq part 'method) 5 6)))
+	  (when (< len total)
+	    (setcdr (nthcdr (1- len) info)
+		    (make-list (- total len) nil)))
+	  ;; Then we enter the new info.
+	  (setcar (nthcdr (1- total) info) part-info)))
       (unless entry
-	(error "Trying to change non-existent group %s" method-only-group))
-      ;; We have received parts of the actual group info - either the
-      ;; select method or the group parameters.	 We first check
-      ;; whether we have to extend the info, and if so, do that.
-      (let ((len (length info))
-	    (total (if (eq part 'method) 5 6)))
-	(when (< len total)
-	  (setcdr (nthcdr (1- len) info)
-		  (make-list (- total len) nil)))
-	;; Then we enter the new info.
-	(setcar (nthcdr (1- total) info) part-info)))
-    (unless entry
-      ;; This is a new group, so we just create it.
-      (save-excursion
-	(set-buffer gnus-group-buffer)
-	(setq method (gnus-info-method info))
-	(when (gnus-server-equal method "native")
-	  (setq method nil))
+	;; This is a new group, so we just create it.
 	(save-excursion
 	  (set-buffer gnus-group-buffer)
-	  (if method
-	      ;; It's a foreign group...
-	      (gnus-group-make-group
-	       (gnus-group-real-name (gnus-info-group info))
-	       (if (stringp method) method
-		 (prin1-to-string (car method)))
-	       (and (consp method)
-		    (nth 1 (gnus-info-method info))))
-	    ;; It's a native group.
-	    (gnus-group-make-group (gnus-info-group info))))
-	(gnus-message 6 "Note: New group created")
-	(setq entry
-	      (gnus-gethash (gnus-group-prefixed-name
-			     (gnus-group-real-name (gnus-info-group info))
-			     (or (gnus-info-method info) gnus-select-method))
-			    gnus-newsrc-hashtb))))
-    ;; Whether it was a new group or not, we now have the entry, so we
-    ;; can do the update.
-    (if entry
-	(progn
-	  (setcar (nthcdr 2 entry) info)
-	  (when (and (not (eq (car entry) t))
-		     (gnus-active (gnus-info-group info)))
-	    (setcar entry (length (gnus-list-of-unread-articles (car info))))))
-      (error "No such group: %s" (gnus-info-group info)))))
+	  (setq method (gnus-info-method info))
+	  (when (gnus-server-equal method "native")
+	    (setq method nil))
+	  (save-excursion
+	    (set-buffer gnus-group-buffer)
+	    (if method
+		;; It's a foreign group...
+		(gnus-group-make-group
+		 (gnus-group-real-name (gnus-info-group info))
+		 (if (stringp method) method
+		   (prin1-to-string (car method)))
+		 (and (consp method)
+		      (nth 1 (gnus-info-method info))))
+	      ;; It's a native group.
+	      (gnus-group-make-group (gnus-info-group info))))
+	  (gnus-message 6 "Note: New group created")
+	  (setq entry
+		(gnus-gethash (gnus-group-prefixed-name
+			       (gnus-group-real-name (gnus-info-group info))
+			       (or (gnus-info-method info) gnus-select-method))
+			      gnus-newsrc-hashtb))))
+      ;; Whether it was a new group or not, we now have the entry, so we
+      ;; can do the update.
+      (if entry
+	  (progn
+	    (setcar (nthcdr 2 entry) info)
+	    (when (and (not (eq (car entry) t))
+		       (gnus-active (gnus-info-group info)))
+	      (setcar entry (length (gnus-list-of-unread-articles (car info))))))
+	(error "No such group: %s" (gnus-info-group info))))))
 
 (defun gnus-group-set-method-info (group select-method)
   (gnus-group-set-info select-method group 'method))
@@ -3303,27 +3350,26 @@ and the second element is the address."
 
 (defun gnus-add-marked-articles (group type articles &optional info force)
   ;; Add ARTICLES of TYPE to the info of GROUP.
-  ;; If INFO is non-nil, use that info.	 If FORCE is non-nil, don't
+  ;; If INFO is non-nil, use that info.         If FORCE is non-nil, don't
   ;; add, but replace marked articles of TYPE with ARTICLES.
   (let ((info (or info (gnus-get-info group)))
-	(uncompressed '(score bookmark killed))
 	marked m)
     (or (not info)
 	(and (not (setq marked (nthcdr 3 info)))
 	     (or (null articles)
-		 (setcdr (nthcdr 2 info)
-			 (list (list (cons type (gnus-compress-sequence
-						 articles t)))))))
+                (setcdr (nthcdr 2 info)
+                        (list (list (cons type (gnus-compress-sequence
+                                                articles t)))))))
 	(and (not (setq m (assq type (car marked))))
 	     (or (null articles)
-		 (setcar marked
-			 (cons (cons type (gnus-compress-sequence articles t) )
-			       (car marked)))))
+                (setcar marked
+                        (cons (cons type (gnus-compress-sequence articles t) )
+                              (car marked)))))
 	(if force
 	    (if (null articles)
-		(setcar (nthcdr 3 info)
-			(delq (assq type (car marked)) (car marked)))
-	      (setcdr m (gnus-compress-sequence articles t)))
+               (setcar (nthcdr 3 info)
+                       (gnus-delete-alist type (car marked)))
+             (setcdr m (gnus-compress-sequence articles t)))
 	  (setcdr m (gnus-compress-sequence
 		     (sort (nconc (gnus-uncompress-range (cdr m))
 				  (copy-sequence articles)) '<) t))))))
@@ -3343,13 +3389,13 @@ or `gnus-group-catchup-group-hook'."
 
 (defsubst gnus-group-timestamp (group)
   "Return the timestamp for GROUP."
-  (gnus-group-get-parameter group 'timestamp))
+  (gnus-group-get-parameter group 'timestamp t))
 
 (defun gnus-group-timestamp-delta (group)
   "Return the offset in seconds from the timestamp for GROUP to the current time, as a floating point number."
   (let* ((time (or (gnus-group-timestamp group)
 		  (list 0 0)))
-         (delta (gnus-time-minus (current-time) time)))
+         (delta (subtract-time (current-time) time)))
     (+ (* (nth 0 delta) 65536.0)
        (nth 1 delta))))