X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fgnus-group.el;h=54239628d00556e96248237fb2b9307f401e1c56;hb=625b891fc07e1e5fc5f2658176b6c0e3cb244ee0;hp=0e6f1b1535b14cfa960b6185c8693fc7a83fd3a4;hpb=30d9f23f0291edcefeca1958befadb992d2982b5;p=elisp%2Fgnus.git- diff --git a/lisp/gnus-group.el b/lisp/gnus-group.el index 0e6f1b1..5423962 100644 --- a/lisp/gnus-group.el +++ b/lisp/gnus-group.el @@ -90,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. @@ -725,7 +725,6 @@ ticked: The number of ticked articles." ["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-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] ["Check for new news" gnus-group-get-new-news t] @@ -2047,6 +2046,7 @@ and NEW-NAME will be prompted for." ((= char ?d) 'digest) ((= char ?f) 'forward) ((= char ?a) 'mmfd) + ((= char ?g) 'guess) (t (setq err (format "%c unknown. " char)) nil)))) (setq type found))) @@ -2680,10 +2680,11 @@ N and the number of steps taken is returned." (gnus-group-yank-group) (gnus-group-position-point))) -(defun gnus-group-kill-all-zombies () - "Kill all zombie newsgroups." - (interactive) - (when (gnus-yes-or-no-p "Really kill all zombies? ") +(defun gnus-group-kill-all-zombies (&optional dummy) + "Kill all zombie newsgroups. +The optional DUMMY should always be nil." + (interactive (list (not (gnus-yes-or-no-p "Really kill all zombies? ")))) + (unless dummy (setq gnus-killed-list (nconc gnus-zombie-list gnus-killed-list)) (setq gnus-zombie-list nil) (gnus-dribble-touch) @@ -2736,7 +2737,8 @@ of groups killed." (push (cons (car entry) (nth 2 entry)) gnus-list-of-killed-groups)) (gnus-group-change-level - (if entry entry group) gnus-level-killed (if entry nil level))) + (if entry entry group) gnus-level-killed (if entry nil level)) + (message "Killed group %s" group)) ;; If there are lots and lots of groups to be killed, we use ;; this thing instead. (let (entry) @@ -3287,59 +3289,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))