Revision: miles@gnu.org--gnu-2005/gnus--devo--0--patch-47
[gnus] / lisp / gnus-group.el
index bd938f0..e7bbf93 100644 (file)
@@ -448,6 +448,7 @@ nnml:\" in the minibuffer prompt.
 If it is an alist, it must consist of \(NUMBER .  PROMPT\) pairs, for example:
 \((1 .  \"\") (2 .  \"nnfolder+archive:\")).  The element with number 0 is
 used when no prefix argument is given to `gnus-group-jump-to-group'."
+  :version "22.1"
   :group 'gnus-group-various
   :type '(choice (string :tag "Prompt string")
                 (const :tag "Empty" nil)
@@ -496,16 +497,25 @@ simple manner.")
     (?T (gnus-range-length (cdr (assq 'tick gnus-tmp-marked))) ?d)
     (?i (+ (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked)))
           (gnus-range-length (cdr (assq 'tick gnus-tmp-marked)))) ?d)
-    (?g gnus-tmp-group ?s)
+    (?g (if (boundp 'gnus-tmp-decoded-group)
+           gnus-tmp-decoded-group
+         gnus-tmp-group)
+       ?s)
     (?G gnus-tmp-qualified-group ?s)
-    (?c (gnus-short-group-name gnus-tmp-group) ?s)
+    (?c (gnus-short-group-name (if (boundp 'gnus-tmp-decoded-group)
+                                  gnus-tmp-decoded-group
+                                gnus-tmp-group))
+       ?s)
     (?C gnus-tmp-comment ?s)
     (?D gnus-tmp-newsgroup-description ?s)
     (?o gnus-tmp-moderated ?c)
     (?O gnus-tmp-moderated-string ?s)
     (?p gnus-tmp-process-marked ?c)
     (?s gnus-tmp-news-server ?s)
-    (?n gnus-tmp-news-method ?s)
+    (?n ,(if (featurep 'xemacs)
+            '(symbol-name gnus-tmp-news-method)
+          'gnus-tmp-news-method)
+       ?s)
     (?P gnus-group-indentation ?s)
     (?E gnus-tmp-group-icon ?s)
     (?B gnus-tmp-summary-live ?c)
@@ -603,6 +613,7 @@ simple manner.")
   "\M-e" gnus-group-edit-group-method
   "^" gnus-group-enter-server-mode
   gnus-mouse-2 gnus-mouse-pick-group
+  [follow-link] mouse-face
   "<" beginning-of-buffer
   ">" end-of-buffer
   "\C-c\C-b" gnus-bug
@@ -1063,7 +1074,8 @@ The following commands are available:
       (gnus-group-insert-group-line "dummy.group" 0 nil 0 nil)
       (goto-char (point-min))
       (setq gnus-group-mark-positions
-           (list (cons 'process (and (search-forward "\200" nil t)
+           (list (cons 'process (and (search-forward
+                                      (mm-string-as-multibyte "\200") nil t)
                                      (- (point) 2))))))))
 
 (defun gnus-mouse-pick-group (e)
@@ -1449,8 +1461,8 @@ if it is a string, only list groups matching REGEXP."
      (point)
      (prog1 (1+ (point))
        ;; Insert the text.
-       (let ((gnus-tmp-group (gnus-group-name-decode
-                             gnus-tmp-group group-name-charset)))
+       (let ((gnus-tmp-decoded-group (gnus-group-name-decode
+                                     gnus-tmp-group group-name-charset)))
         (eval gnus-group-line-format-spec)))
      `(gnus-group ,(gnus-intern-safe gnus-tmp-group gnus-active-hashtb)
                  gnus-unread ,(if (numberp number)
@@ -1737,10 +1749,8 @@ If FIRST-TOO, the current line is also eligible as a target."
 (defun gnus-group-unmark-all-groups ()
   "Unmark all groups."
   (interactive)
-  (let ((groups gnus-group-marked))
-    (save-excursion
-      (while groups
-       (gnus-group-remove-mark (pop groups)))))
+  (save-excursion
+    (mapc 'gnus-group-remove-mark gnus-group-marked))
   (gnus-group-position-point))
 
 (defun gnus-group-mark-region (unmark beg end)
@@ -1986,12 +1996,14 @@ Same as `gnus-large-newsgroup', but only used for ephemeral newsgroups.
 If the number of articles in a newsgroup is greater than this value,
 confirmation is required for selecting the newsgroup.  If it is nil, no
 confirmation is required."
+  :version "22.1"
   :group 'gnus-group-select
   :type '(choice (const :tag "No limit" nil)
                 integer))
 
 (defcustom gnus-fetch-old-ephemeral-headers nil
   "Same as `gnus-fetch-old-headers', but only used for ephemeral newsgroups."
+  :version "22.1"
   :group 'gnus-thread
   :type '(choice (const :tag "off" nil)
                 (const some)
@@ -2250,6 +2262,16 @@ If EXCLUDE-GROUP, do not go to that group."
   (interactive)
   (gnus-enter-server-buffer))
 
+(defun gnus-group-make-group-simple (&optional group)
+  "Add a new newsgroup.
+The user will be prompted for GROUP."
+  (interactive
+   (list (completing-read "Group: " gnus-active-hashtb
+                         nil nil nil 'gnus-group-history)))
+  (gnus-group-make-group
+   (gnus-group-real-name group)
+   (gnus-group-server group)))
+
 (defun gnus-group-make-group (name &optional method address args)
   "Add a new newsgroup.
 The user will be prompted for a NAME, for a select METHOD, and an
@@ -2269,7 +2291,7 @@ ADDRESS."
         (nname (if method (gnus-group-prefixed-name name meth) name))
         backend info)
     (when (gnus-group-entry nname)
-      (error "Group %s already exists" nname))
+      (error "Group %s already exists" (gnus-group-decoded-name nname)))
     ;; Subscribe to the new group.
     (gnus-group-change-level
      (setq info (list t nname gnus-level-default-subscribed nil nil meth))
@@ -2317,7 +2339,7 @@ ADDRESS."
   "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
+of the Earth\".  There is no undo.  The user will be prompted before
 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."
@@ -2329,20 +2351,21 @@ be removed from the server, even when it's empty."
   (unless (gnus-check-backend-function 'request-delete-group group)
     (error "This back end does not support group deletion"))
   (prog1
-      (if (and (not no-prompt)
-              (not (gnus-yes-or-no-p
-                    (format
-                     "Do you really want to delete %s%s? "
-                     group (if force " and all its contents" "")))))
-         ()                            ; Whew!
-       (gnus-message 6 "Deleting group %s..." group)
-       (if (not (gnus-request-delete-group group force))
-           (gnus-error 3 "Couldn't delete group %s" group)
-         (gnus-message 6 "Deleting group %s...done" group)
-         (gnus-group-goto-group group)
-         (gnus-group-kill-group 1 t)
-         (gnus-set-active group nil)
-         t))
+      (let ((group-decoded (gnus-group-decoded-name group)))
+       (if (and (not no-prompt)
+                (not (gnus-yes-or-no-p
+                      (format
+                       "Do you really want to delete %s%s? "
+                       group-decoded (if force " and all its contents" "")))))
+           ()                          ; Whew!
+         (gnus-message 6 "Deleting group %s..." group-decoded)
+         (if (not (gnus-request-delete-group group force))
+             (gnus-error 3 "Couldn't delete group %s" group-decoded)
+           (gnus-message 6 "Deleting group %s...done" group-decoded)
+           (gnus-group-goto-group group)
+           (gnus-group-kill-group 1 t)
+           (gnus-set-active group nil)
+           t)))
     (gnus-group-position-point)))
 
 (defun gnus-group-rename-group (group new-name)
@@ -2528,7 +2551,9 @@ group already exists:
   (gnus-group-position-point))
 
 (defun gnus-group-make-doc-group (file type)
-  "Create a group that uses a single file as the source."
+  "Create a group that uses a single file as the source.
+
+If called with a prefix argument, ask for the file type."
   (interactive
    (list (read-file-name "File name: ")
         (and current-prefix-arg 'ask)))
@@ -2537,7 +2562,7 @@ group already exists:
          char found)
       (while (not found)
        (message
-        "%sFile type (mbox, babyl, digest, forward, mmdf, guess) [mbdfag]: "
+        "%sFile type (mbox, babyl, digest, forward, mmdf, guess) [m, b, d, f, a, g]: "
         err)
        (setq found (cond ((= (setq char (read-char)) ?m) 'mbox)
                          ((= char ?b) 'babyl)
@@ -2610,17 +2635,26 @@ If there is, use Gnus to create an nnrss group"
       (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
-                                                      feedinfo))))
+       (let ((title (gnus-newsgroup-savable-name
+                     (read-from-minibuffer "Title: "
+                                           (gnus-newsgroup-savable-name
+                                            (or (cdr (assoc 'title
+                                                            feedinfo))
+                                                "")))))
              (desc  (read-from-minibuffer "Description: "
                                           (cdr (assoc 'description
                                                       feedinfo))))
-             (href (cdr (assoc 'href feedinfo))))
-         (push (list title href desc)
-               nnrss-group-alist)
-         (gnus-group-unsubscribe-group
-          (concat "nnrss:" title))
+             (href (cdr (assoc 'href feedinfo)))
+             (encodable (mm-coding-system-p 'utf-8)))
+         (when encodable
+           ;; Unify non-ASCII text.
+           (setq title (mm-decode-coding-string
+                        (mm-encode-coding-string title 'utf-8) 'utf-8)))
+         (gnus-group-make-group (if encodable
+                                    (mm-encode-coding-string title 'utf-8)
+                                  title)
+                                '(nnrss ""))
+         (push (list title href desc) nnrss-group-alist)
          (nnrss-save-server-data nil))
       (error "No feeds found for %s" url))))
 
@@ -2731,7 +2765,7 @@ score file entries for articles to include in the group."
       (make-directory score-dir))
     (with-temp-file score-file
       (let (emacs-lisp-mode-hook)
-       (pp scores (current-buffer))))))
+       (gnus-pp scores)))))
 
 (defun gnus-group-add-to-virtual (n vgroup)
   "Add the current group to a virtual group."
@@ -3123,7 +3157,7 @@ up is returned."
                   "Do you really want to mark all articles in %s as read? "
                 "Mark all unread articles in %s as read? ")
               (if (= (length groups) 1)
-                  (car groups)
+                  (gnus-group-decoded-name (car groups))
                 (format "these %d groups" (length groups)))))))
        n
       (while (setq group (pop groups))
@@ -3201,7 +3235,8 @@ Uses the process/prefix convention."
 
 (defun gnus-group-expire-articles-1 (group)
   (when (gnus-check-backend-function 'request-expire-articles group)
-    (gnus-message 6 "Expiring articles in %s..." group)
+    (gnus-message 6 "Expiring articles in %s..."
+                 (gnus-group-decoded-name group))
     (let* ((info (gnus-get-info group))
           (expirable (if (gnus-group-total-expirable-p group)
                          (cons nil (gnus-list-of-read-articles group))
@@ -3226,7 +3261,8 @@ Uses the process/prefix convention."
            (gnus-request-expire-articles
             (gnus-uncompress-sequence (cdr expirable)) group))))
        (gnus-close-group group))
-      (gnus-message 6 "Expiring articles in %s...done" group)
+      (gnus-message 6 "Expiring articles in %s...done"
+                   (gnus-group-decoded-name group))
       ;; Return the list of un-expired articles.
       (cdr expirable))))
 
@@ -3260,16 +3296,15 @@ Uses the process/prefix convention."
           s))))))
   (unless (and (>= level 1) (<= level gnus-level-killed))
     (error "Invalid level: %d" level))
-  (let ((groups (gnus-group-process-prefix n))
-       group)
-    (while (setq group (pop groups))
-      (gnus-group-remove-mark group)
-      (gnus-message 6 "Changed level of %s from %d to %d"
-                   group (or (gnus-group-group-level) gnus-level-killed)
-                   level)
-      (gnus-group-change-level
-       group level (or (gnus-group-group-level) gnus-level-killed))
-      (gnus-group-update-group-line)))
+  (dolist (group (gnus-group-process-prefix n))
+    (gnus-group-remove-mark group)
+    (gnus-message 6 "Changed level of %s from %d to %d"
+                 (gnus-group-decoded-name group)
+                 (or (gnus-group-group-level) gnus-level-killed)
+                 level)
+    (gnus-group-change-level
+     group level (or (gnus-group-group-level) gnus-level-killed))
+    (gnus-group-update-group-line))
   (gnus-group-position-point))
 
 (defun gnus-group-unsubscribe (&optional n)
@@ -3412,7 +3447,7 @@ of groups killed."
                  gnus-list-of-killed-groups))
          (gnus-group-change-level
           (if entry entry group) gnus-level-killed (if entry nil level))
-         (message "Killed group %s" group))
+         (message "Killed group %s" (gnus-group-decoded-name group)))
       ;; If there are lots and lots of groups to be killed, we use
       ;; this thing instead.
       (dolist (group (nreverse groups))
@@ -3615,6 +3650,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)))
+    (gnus-check-reasonable-setup)
     (gnus-run-hooks 'gnus-after-getting-new-news-hook)
     (gnus-group-list-groups (and (numberp arg)
                                 (max (car gnus-group-list-mode) arg)))))
@@ -3639,15 +3675,17 @@ If DONT-SCAN is non-nil, scan non-activated groups as well."
       (gnus-group-remove-mark group)
       ;; Bypass any previous denials from the server.
       (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)
+      (if (gnus-activate-group group (if dont-scan nil 'scan) nil method)
+         (let ((info (gnus-get-info group))
+               (active (gnus-active group)))
+           (when info
+             (gnus-request-update-info info method))
+           (gnus-get-unread-articles-in-group info active)
            (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)))
+              method (gnus-group-real-name group) active))
            (gnus-group-update-group group))
        (if (eq (gnus-server-status (gnus-find-method-for-group group))
                'denied)