Revision: miles@gnu.org--gnu-2005/gnus--devo--0--patch-47
[gnus] / lisp / gnus-group.el
index 2c4360f..e7bbf93 100644 (file)
@@ -448,7 +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 "21.4"
+  :version "22.1"
   :group 'gnus-group-various
   :type '(choice (string :tag "Prompt string")
                 (const :tag "Empty" nil)
@@ -497,9 +497,15 @@ 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)
@@ -607,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
@@ -1067,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)
@@ -1453,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)
@@ -1741,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)
@@ -1990,14 +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 "21.4"
+  :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 "21.4"
+  :version "22.1"
   :group 'gnus-thread
   :type '(choice (const :tag "off" nil)
                 (const some)
@@ -2285,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))
@@ -2333,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."
@@ -2345,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)
@@ -2544,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)))
@@ -2553,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)
@@ -2626,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))))
 
@@ -3139,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))
@@ -3217,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))
@@ -3242,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))))
 
@@ -3276,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)
@@ -3428,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))
@@ -3631,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)))))