Try to prune the Gnus registry if it's full.
[gnus] / lisp / gnus-group.el
index 5a65d30..c265538 100644 (file)
@@ -1,7 +1,6 @@
 ;;; gnus-group.el --- group mode commands for Gnus
 
-;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;;   2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
+;; Copyright (C) 1996-2011  Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;; Keywords: news
@@ -698,7 +697,8 @@ simple manner.")
   "M" gnus-group-list-all-matching
   "l" gnus-group-list-level
   "c" gnus-group-list-cached
-  "?" gnus-group-list-dormant)
+  "?" gnus-group-list-dormant
+  "!" gnus-group-list-ticked)
 
 (gnus-define-keys (gnus-group-list-limit-map "/" gnus-group-list-map)
   "k"  gnus-group-list-limit
@@ -850,7 +850,8 @@ simple manner.")
        ["List all groups matching..." gnus-group-list-all-matching t]
        ["List active file" gnus-group-list-active t]
        ["List groups with cached" gnus-group-list-cached t]
-       ["List groups with dormant" gnus-group-list-dormant t])
+       ["List groups with dormant" gnus-group-list-dormant t]
+       ["List groups with ticked" gnus-group-list-ticked t])
        ("Sort"
        ["Default sort" gnus-group-sort-groups t]
        ["Sort by method" gnus-group-sort-groups-by-method t]
@@ -1677,6 +1678,13 @@ and ends at END."
           " "))
     " "))
 
+
+(defun gnus-group-refresh-group (group)
+  (gnus-activate-group group)
+  (gnus-get-unread-articles-in-group (gnus-get-info group)
+                                    (gnus-active group))
+  (gnus-group-update-group group))
+
 (defun gnus-group-update-group (group &optional visible-only)
   "Update all lines where GROUP appear.
 If VISIBLE-ONLY is non-nil, the group won't be displayed if it isn't
@@ -2267,7 +2275,7 @@ Return the name of the group if selection was successful."
    (list
     ;; (gnus-read-group "Group name: ")
     (gnus-group-completing-read)
-    (gnus-read-method "From method")))
+    (gnus-read-method "From method")))
   ;; Transform the select method into a unique server.
   (when (stringp method)
     (setq method (gnus-server-to-method method)))
@@ -2307,9 +2315,10 @@ Return the name of the group if selection was successful."
                       gnus-fetch-old-ephemeral-headers))
                  (gnus-group-read-group (or number t) t group select-articles))
            group)
-       ;;(error nil)
        (quit
-        (message "Quit reading the ephemeral group")
+        (if debug-on-quit
+            (debug "Quit")
+          (message "Quit reading the ephemeral group"))
         nil)))))
 
 (defcustom gnus-gmane-group-download-format
@@ -2461,7 +2470,7 @@ If PROMPT (the prefix) is a number, use the prompt specified in
 `gnus-group-jump-to-group-prompt'."
   (interactive
    (list (gnus-group-completing-read
-          nil nil (gnus-read-active-file-p)
+          nil nil nil
           (if current-prefix-arg
               (cdr (assq current-prefix-arg gnus-group-jump-to-group-prompt))
             (or (and (stringp gnus-group-jump-to-group-prompt)
@@ -2674,7 +2683,7 @@ server."
   (interactive
    (list
     (gnus-read-group "Group name: ")
-    (gnus-read-method "From method")))
+    (gnus-read-method "From method")))
 
   (when (stringp method)
     (setq method (or (gnus-server-to-method method) method)))
@@ -2734,6 +2743,15 @@ server."
        (lambda (group)
          (gnus-group-delete-group group nil t))))))
 
+(defun gnus-group-delete-articles (group)
+  "Delete all articles in the current group."
+  (interactive (list (gnus-group-group-name)))
+  (let ((articles (gnus-uncompress-range (gnus-active group))))
+    (when (gnus-yes-or-no-p
+          (format "Do you really want to delete these %d articles forever? "
+                  (length articles)))
+      (gnus-request-expire-articles articles group 'force))))
+
 (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
@@ -3087,7 +3105,7 @@ The user will be prompted for a directory.  The contents of this
 directory will be used as a newsgroup.  The directory should contain
 mail messages or news articles in files that have numeric names."
   (interactive
-   (list (read-file-name "Create group from directory: ")))
+   (list (read-directory-name "Create group from directory: ")))
   (unless (file-exists-p dir)
     (error "No such directory"))
   (unless (file-directory-p dir)
@@ -3781,6 +3799,8 @@ of groups killed."
                  gnus-list-of-killed-groups))
          (gnus-group-change-level
           (if entry entry group) gnus-level-killed (if entry nil level))
+         (when (numberp (gnus-group-unread group))
+           (gnus-request-update-group-status group 'unsubscribe))
          (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.
@@ -3803,7 +3823,9 @@ of groups killed."
          (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-delete-line))
+       (when (numberp (gnus-group-unread group))
+         (gnus-request-update-group-status group 'unsubscribe)))
       (gnus-make-hashtable-from-newsrc-alist))
 
     (gnus-group-position-point)
@@ -3831,6 +3853,7 @@ yanked) a list of yanked groups is returned."
        (and prev (gnus-group-entry prev))
        t)
       (gnus-group-insert-group-line-info group)
+      (gnus-request-update-group-status group 'subscribe)
       (gnus-undo-register
        `(when (gnus-group-goto-group ,group)
           (gnus-group-kill-group 1))))
@@ -4380,6 +4403,21 @@ and the second element is the address."
 (defun gnus-group-set-params-info (group params)
   (gnus-group-set-info params group 'params))
 
+;; Ad-hoc function for inserting data from a different newsrc.eld
+;; file.  Use with caution, if at all.
+(defun gnus-import-other-newsrc-file (file)
+  (with-temp-buffer
+    (insert-file file)
+    (let (form)
+      (while (ignore-errors
+              (setq form (read (current-buffer))))
+       (when (and (consp form)
+                  (eq (cadr form) 'gnus-newsrc-alist))
+         (let ((infos (cadr (nth 2 form))))
+           (dolist (info infos)
+             (when (gnus-get-info (car info))
+               (gnus-set-info (car info) info)))))))))
+
 (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
@@ -4500,6 +4538,28 @@ This command may read the active file."
   (goto-char (point-min))
   (gnus-group-position-point))
 
+(defun gnus-group-list-ticked (level &optional lowest)
+  "List all groups with ticked articles.
+If the prefix LEVEL is non-nil, it should be a number that says which
+level to cut off listing groups.
+If LOWEST, don't list groups with level lower than LOWEST.
+
+This command may read the active file."
+  (interactive "P")
+  (when level
+    (setq level (prefix-numeric-value level)))
+  (when (or (not level) (>= level gnus-level-zombie))
+    (gnus-cache-open))
+  (funcall gnus-group-prepare-function
+          (or level gnus-level-subscribed)
+          #'(lambda (info)
+              (let ((marks (gnus-info-marks info)))
+                (assq 'tick marks)))
+          lowest
+          'ignore)
+  (goto-char (point-min))
+  (gnus-group-position-point))
+
 (defun gnus-group-listed-groups ()
   "Return a list of listed groups."
   (let (point groups)