Import Gnus v5.10.3.
[elisp/gnus.git-] / lisp / gnus-group.el
index e6bbddc..a1bd82e 100644 (file)
@@ -180,8 +180,8 @@ with some simple extensions.
 %E    Icon as defined by `gnus-group-icon-list'.
 %u    User defined specifier.  The next character in the format string should
       be a letter.  Gnus will call the function gnus-user-format-function-X,
-      where X is the letter following %u.  The function will be passed a 
-      single dummy parameter as argument..  The function should return a
+      where X is the letter following %u.  The function will be passed a
+      single dummy parameter as argument.  The function should return a
       string, which will be inserted into the buffer just like information
       from any other group specifier.
 
@@ -732,7 +732,7 @@ simple manner.")
 
 (defun gnus-topic-mode-p ()
   "Return non-nil in `gnus-topic-mode'."
-  (and (boundp 'gnus-topic-mode) 
+  (and (boundp 'gnus-topic-mode)
        (symbol-value 'gnus-topic-mode)))
 
 (defun gnus-group-make-menu-bar ()
@@ -750,7 +750,7 @@ simple manner.")
        ["Select" gnus-group-select-group
        :included (not (gnus-topic-mode-p))
        :active (gnus-group-group-name)]
-       ["Select " gnus-topic-select-group 
+       ["Select " gnus-topic-select-group
        :included (gnus-topic-mode-p)]
        ["See old articles" (gnus-group-select-group 'all)
        :keys "C-u SPC" :active (gnus-group-group-name)]
@@ -759,7 +759,7 @@ simple manner.")
        :active (gnus-group-group-name)
        ,@(if (featurep 'xemacs) nil
            '(:help "Mark unread articles in the current group as read"))]
-       ["Catch up " gnus-topic-catchup-articles 
+       ["Catch up " gnus-topic-catchup-articles
        :included (gnus-topic-mode-p)
        ,@(if (featurep 'xemacs) nil
            '(:help "Mark unread articles in the current group or topic as read"))]
@@ -794,13 +794,13 @@ simple manner.")
            '(:help "Display the archived control message for the current group"))]
        ;; Actually one should check, if any of the marked groups gives t for
        ;; (gnus-check-backend-function 'request-expire-articles ...)
-       ["Expire articles" gnus-group-expire-articles 
+       ["Expire articles" gnus-group-expire-articles
        :included (not (gnus-topic-mode-p))
        :active (or (and (gnus-group-group-name)
                         (gnus-check-backend-function
                          'request-expire-articles
                          (gnus-group-group-name))) gnus-group-marked)]
-       ["Expire articles " gnus-topic-expire-articles 
+       ["Expire articles " gnus-topic-expire-articles
        :included (gnus-topic-mode-p)]
        ["Set group level..." gnus-group-set-current-level
        (gnus-group-group-name)]
@@ -891,6 +891,7 @@ simple manner.")
        ["Make a kiboze group..." gnus-group-make-kiboze-group t]
        ["Make a virtual group..." gnus-group-make-empty-virtual t]
        ["Add a group to a virtual..." gnus-group-add-to-virtual t]
+       ["Make an RSS group..." gnus-group-make-rss-group t]
        ["Rename group..." gnus-group-rename-group
         (gnus-check-backend-function
          'request-rename-group (gnus-group-group-name))]
@@ -1387,7 +1388,7 @@ if it is a string, only list groups matching REGEXP."
         (gnus-tmp-qualified-group
          (gnus-group-name-decode (gnus-group-real-name gnus-tmp-group)
                                  group-name-charset))
-        (gnus-tmp-comment 
+        (gnus-tmp-comment
          (or (gnus-group-get-parameter gnus-tmp-group 'comment t)
              gnus-tmp-group))
         (gnus-tmp-newsgroup-description
@@ -1736,9 +1737,11 @@ If UNMARK, remove the mark instead."
   (interactive "sMark (regexp): ")
   (let ((alist (cdr gnus-newsrc-alist))
        group)
-    (while alist
-      (when (string-match regexp (setq group (gnus-info-group (pop alist))))
-       (gnus-group-set-mark group))))
+    (save-excursion
+      (while alist
+       (when (string-match regexp (setq group (gnus-info-group (pop alist))))
+         (gnus-group-jump-to-group group)
+         (gnus-group-set-mark group)))))
   (gnus-group-position-point))
 
 (defun gnus-group-remove-mark (group &optional test-marked)
@@ -2242,7 +2245,7 @@ ADDRESS."
     (forward-line -1)
     (gnus-group-position-point)
 
-    ;; Load the backend and try to make the backend create
+    ;; Load the back end and try to make the back end create
     ;; the group as well.
     (when (assoc (symbol-name (setq backend (car (gnus-server-get-method
                                                  nil meth))))
@@ -2267,21 +2270,23 @@ ADDRESS."
        (lambda (group)
          (gnus-group-delete-group group nil t))))))
 
-(eval-when-compile (defvar gnus-cache-active-altered))
+(defvar gnus-cache-active-altered)
 
 (defun gnus-group-delete-group (group &optional force no-prompt)
   "Delete the current group.  Only meaningful with editable groups.
 If FORCE (the prefix) is non-nil, all the articles in the group will
 be deleted.  This is \"deleted\" as in \"removed forever from the face
 of the Earth\".         There is no undo.  The user will be prompted before
-doing the deletion."
+doing the deletion.
+Note that you also have to specify FORCE if you want the group to
+be removed from the server, even when it's empty."
   (interactive
    (list (gnus-group-group-name)
         current-prefix-arg))
   (unless group
     (error "No group to delete"))
   (unless (gnus-check-backend-function 'request-delete-group group)
-    (error "This backend does not support group deletion"))
+    (error "This back end does not support group deletion"))
   (prog1
       (if (and (not no-prompt)
               (not (gnus-yes-or-no-p
@@ -2313,12 +2318,12 @@ and NEW-NAME will be prompted for."
     (progn
       (unless (gnus-check-backend-function
               'request-rename-group (gnus-group-group-name))
-       (error "This backend does not support renaming groups"))
+       (error "This back end does not support renaming groups"))
       (gnus-read-group "Rename group to: "
                       (gnus-group-real-name (gnus-group-group-name))))))
 
   (unless (gnus-check-backend-function 'request-rename-group group)
-    (error "This backend does not support renaming groups"))
+    (error "This back end does not support renaming groups"))
   (unless group
     (error "No group to rename"))
   (when (equal (gnus-group-real-name group) new-name)
@@ -2334,6 +2339,9 @@ and NEW-NAME will be prompted for."
           (gnus-group-real-name new-name)
           (gnus-info-method (gnus-get-info group)))))
 
+  (when (gnus-active new-name)
+    (error "The group %s already exists" new-name))
+
   (gnus-message 6 "Renaming group %s to %s..." group new-name)
   (prog1
       (if (progn
@@ -2552,22 +2560,23 @@ If SOLID (the prefix), create a solid group."
        (cons (current-buffer)
             (if (eq major-mode 'gnus-summary-mode) 'summary 'group))))))
 
-(eval-when-compile (defvar nnrss-group-alist)
-                  (defun nnrss-discover-feed (arg))
-                  (defun nnrss-save-server-data (arg)))
+(eval-when-compile
+  (defvar nnrss-group-alist)
+  (defun nnrss-discover-feed (arg))
+  (defun nnrss-save-server-data (arg)))
 (defun gnus-group-make-rss-group (&optional url)
-  "Given a URL, discover if there is an RSS feed.  If there is,
-use Gnus' to create an nnrss group"
+  "Given a URL, discover if there is an RSS feed.
+If there is, use Gnus to create an nnrss group"
   (interactive)
   (require 'nnrss)
   (if (not url)
       (setq url (read-from-minibuffer "URL to Search for RSS: ")))
   (let ((feedinfo (nnrss-discover-feed url)))
     (if feedinfo
-       (let ((title (read-from-minibuffer "Title: " 
-                                          (cdr (assoc 'title 
+       (let ((title (read-from-minibuffer "Title: "
+                                          (cdr (assoc 'title
                                                       feedinfo))))
-             (desc  (read-from-minibuffer "Description: " 
+             (desc  (read-from-minibuffer "Description: "
                                           (cdr (assoc 'description
                                                       feedinfo))))
              (href (cdr (assoc 'href feedinfo))))
@@ -2654,7 +2663,7 @@ mail messages or news articles in files that have numeric names."
      (gnus-group-real-name group)
      (list 'nndir (gnus-group-real-name group) (list 'nndir-directory dir)))))
 
-(eval-when-compile (defvar nnkiboze-score-file))
+(defvar nnkiboze-score-file)
 (defun gnus-group-make-kiboze-group (group address scores)
   "Create an nnkiboze group.
 The user will be prompted for a name, a regexp to match groups, and
@@ -2859,7 +2868,7 @@ If REVERSE, sort in reverse order."
   (gnus-group-sort-groups 'gnus-group-sort-by-rank reverse))
 
 (defun gnus-group-sort-groups-by-method (&optional reverse)
-  "Sort the group buffer alphabetically by backend name.
+  "Sort the group buffer alphabetically by back end name.
 If REVERSE, sort in reverse order."
   (interactive "P")
   (gnus-group-sort-groups 'gnus-group-sort-by-method reverse))
@@ -2948,7 +2957,7 @@ sort in reverse order."
   (gnus-group-sort-selected-groups n 'gnus-group-sort-by-rank reverse))
 
 (defun gnus-group-sort-selected-groups-by-method (&optional n reverse)
-  "Sort the group buffer alphabetically by backend name.
+  "Sort the group buffer alphabetically by back end name.
 Obeys the process/prefix convention.  If REVERSE (the symbolic prefix),
 sort in reverse order."
   (interactive (gnus-interactive "P\ny"))
@@ -2977,7 +2986,7 @@ sort in reverse order."
   (< (gnus-info-level info1) (gnus-info-level info2)))
 
 (defun gnus-group-sort-by-method (info1 info2)
-  "Sort alphabetically by backend name."
+  "Sort alphabetically by back end name."
   (string< (car (gnus-find-method-for-group
                 (gnus-info-group info1) info1))
           (car (gnus-find-method-for-group
@@ -3236,26 +3245,22 @@ Uses the process/prefix convention."
   "Toggle subscription of the current group.
 If given numerical prefix, toggle the N next groups."
   (interactive "P")
-  (let ((groups (gnus-group-process-prefix n))
-       group)
-    (while groups
-      (setq group (car groups)
-           groups (cdr groups))
-      (gnus-group-remove-mark group)
-      (gnus-group-unsubscribe-group
-       group
-       (cond
-       ((eq do-sub 'unsubscribe)
-        gnus-level-default-unsubscribed)
-       ((eq do-sub 'subscribe)
-        gnus-level-default-subscribed)
-       ((<= (gnus-group-group-level) gnus-level-subscribed)
-        gnus-level-default-unsubscribed)
-       (t
-        gnus-level-default-subscribed))
-       t)
-      (gnus-group-update-group-line))
-    (gnus-group-next-group 1)))
+  (dolist (group (gnus-group-process-prefix n))
+    (gnus-group-remove-mark group)
+    (gnus-group-unsubscribe-group
+     group
+     (cond
+      ((eq do-sub 'unsubscribe)
+       gnus-level-default-unsubscribed)
+      ((eq do-sub 'subscribe)
+       gnus-level-default-subscribed)
+      ((<= (gnus-group-group-level) gnus-level-subscribed)
+       gnus-level-default-unsubscribed)
+      (t
+       gnus-level-default-subscribed))
+     t)
+    (gnus-group-update-group-line))
+  (gnus-group-next-group 1))
 
 (defun gnus-group-unsubscribe-group (group &optional level silent)
   "Toggle subscription to GROUP.
@@ -3371,29 +3376,27 @@ of groups killed."
          (message "Killed group %s" group))
       ;; If there are lots and lots of groups to be killed, we use
       ;; this thing instead.
-      (let (entry)
-       (setq groups (nreverse groups))
-       (while groups
-         (gnus-group-remove-mark (setq group (pop groups)))
-         (gnus-delete-line)
-         (push group gnus-killed-list)
-         (setq gnus-newsrc-alist
-               (delq (assoc group gnus-newsrc-alist)
-                     gnus-newsrc-alist))
-         (when gnus-group-change-level-function
-           (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))
-                 gnus-list-of-killed-groups)
-           (setcdr (cdr entry) (cdddr entry)))
-          ((member group gnus-zombie-list)
-           (setq gnus-zombie-list (delete group gnus-zombie-list))))
-         ;; There may be more than one instance displayed.
-         (while (gnus-group-goto-group group)
-           (gnus-delete-line)))
-       (gnus-make-hashtable-from-newsrc-alist)))
+      (dolist (group (nreverse groups))
+       (gnus-group-remove-mark group)
+       (gnus-delete-line)
+       (push group gnus-killed-list)
+       (setq gnus-newsrc-alist
+             (delq (assoc group gnus-newsrc-alist)
+                   gnus-newsrc-alist))
+       (when gnus-group-change-level-function
+         (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))
+               gnus-list-of-killed-groups)
+         (setcdr (cdr entry) (cdddr entry)))
+        ((member group gnus-zombie-list)
+         (setq gnus-zombie-list (delete group gnus-zombie-list))))
+       ;; There may be more than one instance displayed.
+       (while (gnus-group-goto-group group)
+         (gnus-delete-line)))
+      (gnus-make-hashtable-from-newsrc-alist))
 
     (gnus-group-position-point)
     (if (< (length out) 2) (car out) (nreverse out))))
@@ -3458,7 +3461,7 @@ yanked) a list of yanked groups is returned."
 
 (defun gnus-group-list-all-groups (&optional arg)
   "List all newsgroups with level ARG or lower.
-Default is gnus-level-unsubscribed, which lists all subscribed and most
+Default is `gnus-level-unsubscribed', which lists all subscribed and most
 unsubscribed groups."
   (interactive "P")
   (gnus-group-list-groups (or arg gnus-level-unsubscribed) t))
@@ -3668,7 +3671,7 @@ If given a prefix argument, prompt for a group."
          (browse-url (eval url))
        (setq url (concat "http://" hierarchy
                          ".news-admin.org/charters/" name))
-       (if (and (fboundp 'url-http-file-exists-p) 
+       (if (and (fboundp 'url-http-file-exists-p)
                 (url-http-file-exists-p url))
            (browse-url url)
          (gnus-group-fetch-control group))))))
@@ -3689,14 +3692,14 @@ If given a prefix argument, prompt for a group."
       (setq hierarchy (match-string 1 name))
       (if gnus-group-fetch-control-use-browse-url
          (browse-url (concat "ftp://ftp.isc.org/usenet/control/"
-                             hierarchy "/" name ".Z"))
+                             hierarchy "/" name ".gz"))
        (let ((enable-local-variables nil))
          (gnus-group-read-ephemeral-group
           group
-          `(nndoc ,group (nndoc-address 
+          `(nndoc ,group (nndoc-address
                           ,(find-file-noselect
-                            (concat "/ftp@ftp.isc.org:/usenet/control/" 
-                                    hierarchy "/" name ".Z")))
+                            (concat "/ftp@ftp.isc.org:/usenet/control/"
+                                    hierarchy "/" name ".gz")))
                   (nndoc-article-type mbox)) t nil nil))))))
 
 (defun gnus-group-describe-group (force &optional group)
@@ -3794,7 +3797,7 @@ If given a prefix argument, prompt for a group."
     (pop-to-buffer obuf)))
 
 (defun gnus-group-description-apropos (regexp)
-  "List all newsgroups that have names or descriptions that match a regexp."
+  "List all newsgroups that have names or descriptions that match REGEXP."
   (interactive "sGnus description apropos (regexp): ")
   (when (not (or gnus-description-hashtb
                 (gnus-read-all-descriptions-files)))
@@ -3893,10 +3896,12 @@ If GROUP, edit that local kill file instead."
   (interactive)
   (gnus-save-newsrc-file))
 
+(defvar gnus-backlog-articles)
+
 (defun gnus-group-suspend ()
   "Suspend the current Gnus session.
 In fact, cleanup buffers except for group mode buffer.
-The hook gnus-suspend-gnus-hook is called before actually suspending."
+The hook `gnus-suspend-gnus-hook' is called before actually suspending."
   (interactive)
   (gnus-run-hooks 'gnus-suspend-gnus-hook)
   (gnus-offer-save-summaries)
@@ -3910,6 +3915,7 @@ The hook gnus-suspend-gnus-hook is called before actually suspending."
                              (eq major-mode 'message-mode))))
                (gnus-kill-buffer buf)))
            (gnus-buffers))
+    (setq gnus-backlog-articles nil)
     (gnus-kill-gnus-frames)
     (when group-buf
       (bury-buffer group-buf)
@@ -3982,10 +3988,10 @@ If not, METHOD should be a list where the first element is the method
 and the second element is the address."
   (interactive
    (list (let ((how (completing-read
-                    "Which backend: "
+                    "Which back end: "
                     (append gnus-valid-select-methods gnus-server-alist)
                     nil t (cons "nntp" 0) 'gnus-method-history)))
-          ;; We either got a backend name or a virtual server name.
+          ;; We either got a back end name or a virtual server name.
           ;; If the first, we also need an address.
           (if (assoc how gnus-valid-select-methods)
               (list (intern how)