For example:
(((nntp \"news.com.cn\") . cn-gb-2312))
"
+ :version "21.1"
:group 'gnus-charset
:type '(repeat (cons (sexp :tag "Method") (symbol :tag "Charset"))))
:group 'gnus-charset
:type '(repeat (cons (regexp :tag "Group") (symbol :tag "Charset"))))
+(defcustom gnus-group-jump-to-group-prompt nil
+ "Default prompt for `gnus-group-jump-to-group'.
+If non-nil, the value should be a string, e.g. \"nnml:\",
+in which case `gnus-group-jump-to-group' offers \"Group: nnml:\"
+in the minibuffer prompt."
+ :group 'gnus-group-various
+ :type '(choice (string :tag "Prompt string")
+ (const :tag "Empty" nil)))
+
;;; Internal variables
(defvar gnus-group-sort-alist-function 'gnus-group-sort-flat
(defvar gnus-group-icon-cache nil)
-(defvar gnus-group-running-xemacs (string-match "XEmacs" emacs-version))
+
+(defvar gnus-group-listed-groups nil)
+(defvar gnus-group-list-option nil)
;;;
;;; Gnus group mode
"c" gnus-group-list-cached
"?" gnus-group-list-dormant)
+ (gnus-define-keys (gnus-group-list-limit-map "/" gnus-group-list-map)
+ "k" gnus-group-list-limit
+ "z" gnus-group-list-limit
+ "s" gnus-group-list-limit
+ "u" gnus-group-list-limit
+ "A" gnus-group-list-limit
+ "m" gnus-group-list-limit
+ "M" gnus-group-list-limit
+ "l" gnus-group-list-limit
+ "c" gnus-group-list-limit
+ "?" gnus-group-list-limit)
+
+ (gnus-define-keys (gnus-group-list-flush-map "f" gnus-group-list-map)
+ "k" gnus-group-list-flush
+ "z" gnus-group-list-flush
+ "s" gnus-group-list-flush
+ "u" gnus-group-list-flush
+ "A" gnus-group-list-flush
+ "m" gnus-group-list-flush
+ "M" gnus-group-list-flush
+ "l" gnus-group-list-flush
+ "c" gnus-group-list-flush
+ "?" gnus-group-list-flush)
+
+ (gnus-define-keys (gnus-group-list-plus-map "p" gnus-group-list-map)
+ "k" gnus-group-list-plus
+ "z" gnus-group-list-plus
+ "s" gnus-group-list-plus
+ "u" gnus-group-list-plus
+ "A" gnus-group-list-plus
+ "m" gnus-group-list-plus
+ "M" gnus-group-list-plus
+ "l" gnus-group-list-plus
+ "c" gnus-group-list-plus
+ "?" gnus-group-list-plus)
+
(gnus-define-keys (gnus-group-score-map "W" gnus-group-mode-map)
"f" gnus-score-flush-cache)
(easy-menu-define
gnus-group-reading-menu gnus-group-mode-map ""
- '("Group"
+ `("Group"
["Read" gnus-group-read-group (gnus-group-group-name)]
["Select" gnus-group-select-group (gnus-group-group-name)]
["See old articles" (gnus-group-select-group 'all)
:keys "C-u SPC" :active (gnus-group-group-name)]
- ["Catch up" gnus-group-catchup-current (gnus-group-group-name)]
+ ["Catch up" gnus-group-catchup-current :active (gnus-group-group-name)
+ ,@(if (featurep 'xemacs) nil
+ '(:help "Mark unread articles in the current group as read"))]
["Catch up all articles" gnus-group-catchup-current-all
(gnus-group-group-name)]
["Check for new articles" gnus-group-get-new-news-this-group
- (gnus-group-group-name)]
+ :active (gnus-group-group-name)
+ ,@(if (featurep 'xemacs) nil
+ '(:help "Check for new messages in current group"))]
["Toggle subscription" gnus-group-unsubscribe-current-group
(gnus-group-group-name)]
- ["Kill" gnus-group-kill-group (gnus-group-group-name)]
+ ["Kill" gnus-group-kill-group :active (gnus-group-group-name)
+ ,@(if (featurep 'xemacs) nil
+ '(:help "Kill (remove) current group"))]
["Yank" gnus-group-yank-group gnus-list-of-killed-groups]
- ["Describe" gnus-group-describe-group (gnus-group-group-name)]
+ ["Describe" gnus-group-describe-group :active (gnus-group-group-name)
+ ,@(if (featurep 'xemacs) nil
+ '(:help "Display description of the current group"))]
["Fetch FAQ" gnus-group-fetch-faq (gnus-group-group-name)]
;; Actually one should check, if any of the marked groups gives t for
;; (gnus-check-backend-function 'request-expire-articles ...)
(easy-menu-define
gnus-group-misc-menu gnus-group-mode-map ""
- '("Misc"
+ `("Misc"
("SOUP"
["Pack replies" nnsoup-pack-replies (fboundp 'nnsoup-request-group)]
["Send replies" gnus-soup-send-replies
["Brew SOUP" gnus-group-brew-soup (fboundp 'gnus-soup-pack-packet)])
["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]
+ ["Check for new news" gnus-group-get-new-news
+ ,@(if (featurep 'xemacs) nil
+ '(:help "Get newly arrived articles"))
+ ]
["Activate all groups" gnus-activate-all-groups t]
["Restart Gnus" gnus-group-restart t]
["Read init file" gnus-group-read-init-file t]
["Flush score cache" gnus-score-flush-cache t]
["Toggle topics" gnus-topic-mode t]
["Send a bug report" gnus-bug t]
- ["Exit from Gnus" gnus-group-exit t]
+ ["Exit from Gnus" gnus-group-exit
+ ,@(if (featurep 'xemacs) nil
+ '(:help "Quit reading news"))]
["Exit without saving" gnus-group-quit t]))
(gnus-run-hooks 'gnus-group-menu-hook)))
+(defvar gnus-group-toolbar-map nil)
+
+;; Emacs 21 tool bar. Should be no-op otherwise.
+(defun gnus-group-make-tool-bar ()
+ (if (and (fboundp 'tool-bar-add-item-from-menu)
+ (default-value 'tool-bar-mode)
+ (not gnus-group-toolbar-map))
+ (setq gnus-group-toolbar-map
+ (let ((tool-bar-map (make-sparse-keymap))
+ (load-path (mm-image-load-path)))
+ (tool-bar-add-item-from-menu
+ 'gnus-group-get-new-news "get-news" gnus-group-mode-map)
+ (tool-bar-add-item-from-menu
+ 'gnus-group-get-new-news-this-group "gnntg" gnus-group-mode-map)
+ (tool-bar-add-item-from-menu
+ 'gnus-group-catchup-current "catchup" gnus-group-mode-map)
+ (tool-bar-add-item-from-menu
+ 'gnus-group-describe-group "describe-group" gnus-group-mode-map)
+ (tool-bar-add-item "subscribe" 'gnus-group-subscribe 'subscribe
+ :help "Subscribe to the current group")
+ (tool-bar-add-item "unsubscribe" 'gnus-group-unsubscribe
+ 'unsubscribe
+ :help "Unsubscribe from the current group")
+ (tool-bar-add-item-from-menu
+ 'gnus-group-exit "exit-gnus" gnus-group-mode-map)
+ tool-bar-map)))
+ (if gnus-group-toolbar-map
+ (set (make-local-variable 'tool-bar-map) gnus-group-toolbar-map)))
+
(defun gnus-group-mode ()
"Major mode for reading news.
\\{gnus-group-mode-map}"
(interactive)
- (when (gnus-visual-p 'group-menu 'menu)
- (gnus-group-make-menu-bar))
(kill-all-local-variables)
+ (when (gnus-visual-p 'group-menu 'menu)
+ (gnus-group-make-menu-bar)
+ (gnus-group-make-tool-bar))
(gnus-simplify-mode-line)
(setq major-mode 'gnus-group-mode)
(setq mode-name "Group")
(interactive "nList groups on level: \nP")
(gnus-group-list-groups level all level))
-(defun gnus-group-prepare-flat (level &optional all lowest regexp)
+(defun gnus-group-prepare-logic (group test)
+ (or (and gnus-group-listed-groups
+ (null gnus-group-list-option)
+ (member group gnus-group-listed-groups))
+ (cond
+ ((null gnus-group-listed-groups) test)
+ ((null gnus-group-list-option) test)
+ (t (and (member group gnus-group-listed-groups)
+ (if (eq gnus-group-list-option 'flush)
+ (not test)
+ test))))))
+
+(defun gnus-group-prepare-flat (level &optional predicate lowest regexp)
"List all newsgroups with unread articles of level LEVEL or lower.
-If ALL is non-nil, list groups that have no unread articles.
+If PREDICATE is a function, list groups that the function returns non-nil;
+if it is t, list groups that have no unread articles.
If LOWEST is non-nil, list all newsgroups of level LOWEST or higher.
-If REGEXP, only list groups matching REGEXP."
+If REGEXP is a function, list dead groups that the function returns non-nil;
+if it is a string, only list groups matching REGEXP."
(set-buffer gnus-group-buffer)
(let ((buffer-read-only nil)
(newsrc (cdr gnus-newsrc-alist))
(lowest (or lowest 1))
+ (not-in-list (and gnus-group-listed-groups
+ (copy-sequence gnus-group-listed-groups)))
info clevel unread group params)
(erase-buffer)
- (when (< lowest gnus-level-zombie)
+ (when (or (< lowest gnus-level-zombie)
+ gnus-group-listed-groups)
;; List living groups.
(while newsrc
(setq info (car newsrc)
params (gnus-info-params info)
newsrc (cdr newsrc)
unread (car (gnus-gethash group gnus-newsrc-hashtb)))
- (and unread ; This group might be unchecked
- (or (not regexp)
- (string-match regexp group))
- (<= (setq clevel (gnus-info-level info)) level)
- (>= clevel lowest)
- (or all ; We list all groups?
- (if (eq unread t) ; Unactivated?
- gnus-group-list-inactive-groups ; We list unactivated
- (> unread 0)) ; We list groups with unread articles
- (and gnus-list-groups-with-ticked-articles
- (cdr (assq 'tick (gnus-info-marks info))))
+ (if not-in-list
+ (setq not-in-list (delete group not-in-list)))
+ (and
+ (gnus-group-prepare-logic
+ group
+ (and unread ; This group might be unchecked
+ (or (not (stringp regexp))
+ (string-match regexp group))
+ (<= (setq clevel (gnus-info-level info)) level)
+ (>= clevel lowest)
+ (cond
+ ((functionp predicate)
+ (funcall predicate info))
+ (predicate t) ; We list all groups?
+ (t
+ (or
+ (if (eq unread t) ; Unactivated?
+ gnus-group-list-inactive-groups
+ ; We list unactivated
+ (> unread 0))
+ ; We list groups with unread articles
+ (and gnus-list-groups-with-ticked-articles
+ (cdr (assq 'tick (gnus-info-marks info))))
; And groups with tickeds
- ;; Check for permanent visibility.
- (and gnus-permanently-visible-groups
- (string-match gnus-permanently-visible-groups
- group))
- (memq 'visible params)
- (cdr (assq 'visible params)))
- (gnus-group-insert-group-line
- group (gnus-info-level info)
- (gnus-info-marks info) unread (gnus-info-method info)))))
-
+ ;; Check for permanent visibility.
+ (and gnus-permanently-visible-groups
+ (string-match gnus-permanently-visible-groups group))
+ (memq 'visible params)
+ (cdr (assq 'visible params)))))))
+ (gnus-group-insert-group-line
+ group (gnus-info-level info)
+ (gnus-info-marks info) unread (gnus-info-method info)))))
+
;; List dead groups.
- (and (>= level gnus-level-zombie) (<= lowest gnus-level-zombie)
- (gnus-group-prepare-flat-list-dead
- (setq gnus-zombie-list (sort gnus-zombie-list 'string<))
- gnus-level-zombie ?Z
- regexp))
- (and (>= level gnus-level-killed) (<= lowest gnus-level-killed)
- (gnus-group-prepare-flat-list-dead
- (setq gnus-killed-list (sort gnus-killed-list 'string<))
- gnus-level-killed ?K regexp))
+ (if (or gnus-group-listed-groups
+ (and (>= level gnus-level-zombie)
+ (<= lowest gnus-level-zombie)))
+ (gnus-group-prepare-flat-list-dead
+ (setq gnus-zombie-list (sort gnus-zombie-list 'string<))
+ gnus-level-zombie ?Z
+ regexp))
+ (if not-in-list
+ (dolist (group gnus-zombie-list)
+ (setq not-in-list (delete group not-in-list))))
+ (if (or gnus-group-listed-groups
+ (and (>= level gnus-level-killed) (<= lowest gnus-level-killed)))
+ (gnus-group-prepare-flat-list-dead
+ (gnus-union
+ not-in-list
+ (setq gnus-killed-list (sort gnus-killed-list 'string<)))
+ gnus-level-killed ?K regexp))
(gnus-group-set-mode-line)
- (setq gnus-group-list-mode (cons level all))
+ (setq gnus-group-list-mode (cons level predicate))
(gnus-run-hooks 'gnus-group-prepare-hook)
t))
;; suggested by Jack Vinson <vinson@unagi.cis.upenn.edu>. It does
;; this by ignoring the group format specification altogether.
(let (group)
- (if regexp
- ;; This loop is used when listing groups that match some
- ;; regexp.
- (while groups
- (setq group (pop groups))
- (when (string-match regexp group)
- (gnus-add-text-properties
- (point) (prog1 (1+ (point))
- (insert " " mark " *: "
- (gnus-group-name-decode group
- (gnus-group-name-charset
- nil group))
- "\n"))
- (list 'gnus-group (gnus-intern-safe group gnus-active-hashtb)
- 'gnus-unread t
- 'gnus-level level))))
- ;; This loop is used when listing all groups.
- (while groups
- (setq group (pop groups))
- (gnus-add-text-properties
- (point) (prog1 (1+ (point))
- (insert " " mark " *: "
- (gnus-group-name-decode group
- (gnus-group-name-charset
- nil group))
- "\n"))
- (list 'gnus-group (gnus-intern-safe group gnus-active-hashtb)
- 'gnus-unread t
- 'gnus-level level))))))
+ (while groups
+ (setq group (pop groups))
+ (when (gnus-group-prepare-logic
+ group
+ (or (not regexp)
+ (and (stringp regexp) (string-match regexp group))
+ (and (functionp regexp) (funcall regexp group))))
+;;; (gnus-add-text-properties
+;;; (point) (prog1 (1+ (point))
+;;; (insert " " mark " *: "
+;;; (gnus-group-name-decode group
+;;; (gnus-group-name-charset
+;;; nil group))
+;;; "\n"))
+;;; (list 'gnus-group (gnus-intern-safe group gnus-active-hashtb)
+;;; 'gnus-unread t
+;;; 'gnus-level level))
+ (gnus-group-insert-group-line
+ group level nil
+ (let ((active (gnus-active group)))
+ (if active
+ (if (zerop (cdr active))
+ 0
+ (- (1+ (cdr active)) (car active)))
+ nil))
+ (gnus-method-simplify (gnus-find-method-for-group group)))))))
(defun gnus-group-update-group-line ()
"Update the current line in the group buffer."
0
(- (1+ (cdr active)) (car active)))
nil)
- nil))))
+ (gnus-method-simplify (gnus-find-method-for-group group))))))
(defun gnus-group-insert-group-line (gnus-tmp-group gnus-tmp-level
gnus-tmp-marked number
gnus-level ,gnus-tmp-level))
(forward-line -1)
(when (inline (gnus-visual-p 'group-highlight 'highlight))
- (gnus-run-hooks 'gnus-group-update-hook)
- (forward-line))
+ (gnus-run-hooks 'gnus-group-update-hook))
+ (forward-line)
;; Allow XEmacs to remove front-sticky text properties.
(gnus-group-remove-excess-properties)))
(when (gnus-group-read-group t t group select-articles)
group)
;;(error nil)
- (quit nil)))))
+ (quit
+ (message "Quit reading the ephemeral group")
+ nil)))))
(defun gnus-group-jump-to-group (group)
"Jump to newsgroup GROUP."
(list (completing-read
"Group: " gnus-active-hashtb nil
(gnus-read-active-file-p)
- nil
+ gnus-group-jump-to-group-prompt
'gnus-group-history)))
(when (equal group "")
(gnus-message 6 "Renaming group %s to %s..." group new-name)
(prog1
- (if (not (gnus-request-rename-group group new-name))
+ (if (progn
+ (gnus-group-goto-group group)
+ (not (when (< (gnus-group-group-level) gnus-level-zombie)
+ (gnus-request-rename-group group new-name))))
(gnus-error 3 "Couldn't rename group %s to %s" group new-name)
;; We rename the group internally by killing it...
- (gnus-group-goto-group group)
(gnus-group-kill-group)
;; ... changing its name ...
(setcar (cdar gnus-list-of-killed-groups) new-name)
(while (or (not group) (gnus-gethash group gnus-newsrc-hashtb))
(setq group
(gnus-group-prefixed-name
- (concat (file-name-as-directory (directory-file-name dir))
- ext)
+ (expand-file-name ext dir)
'(nndir "")))
(setq ext (format "<%d>" (setq i (1+ i)))))
(gnus-group-make-group
(gnus-group-real-name group)
(list 'nndir (gnus-group-real-name group) (list 'nndir-directory dir)))))
+(eval-when-compile (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
"Match on header: " headers nil t))))
(setq regexps nil)
(while (not (equal "" (setq regexp (read-string
- (format "Match on %s (string): "
+ (format "Match on %s (regexp): "
header)))))
(push (list regexp nil nil 'r) regexps))
(push (cons header regexps) scores))
scores)))
(gnus-group-make-group group "nnkiboze" address)
- (with-temp-file (gnus-score-file-name (concat "nnkiboze:" group))
- (let (emacs-lisp-mode-hook)
- (pp scores (current-buffer)))))
+ (let* ((nnkiboze-current-group group)
+ (score-file (car (nnkiboze-score-file "")))
+ (score-dir (file-name-directory score-file)))
+ (unless (file-exists-p score-dir)
+ (make-directory score-dir))
+ (with-temp-file score-file
+ (let (emacs-lisp-mode-hook)
+ (pp scores (current-buffer))))))
(defun gnus-group-add-to-virtual (n vgroup)
"Add the current group to a virtual group."
(error "Killed group; can't be edited"))
(unless (eq (car (setq method (gnus-find-method-for-group group))) 'nnimap)
(error "%s is not an nnimap group" group))
- (gnus-edit-form (setq acl (nnimap-acl-get mailbox (cadr method)))
- (format "Editing the access control list for `%s'.
+ (unless (setq acl (nnimap-acl-get mailbox (cadr method)))
+ (error "Server does not support ACL's"))
+ (gnus-edit-form acl (format "Editing the access control list for `%s'.
An access control list is a list of (identifier . rights) elements.
(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" group)
+ ;; Return the list of un-expired articles.
+ (cdr expirable))))
(defun gnus-group-expire-all-groups ()
"Expire all expirable articles in all newsgroups."
(when current-prefix-arg
(completing-read
"Faq dir: " (and (listp gnus-group-faq-directory)
- (mapcar (lambda (file) (list file))
+ (mapcar #'list
gnus-group-faq-directory))))))
(unless group
(error "No group name given"))
(while (and (not found)
(setq dir (pop dirs)))
(let ((name (gnus-group-real-name group)))
- (setq file (concat (file-name-as-directory dir) name)))
+ (setq file (expand-file-name name dir)))
(if (not (file-exists-p file))
(gnus-message 1 "No such file: %s" file)
(let ((enable-local-variables nil))
(when (and level
(> (prefix-numeric-value level) gnus-level-killed))
(gnus-get-killed-groups))
- (gnus-group-prepare-flat
- (or level gnus-level-subscribed) all (or lowest 1) regexp)
+ (funcall gnus-group-prepare-function
+ (or level gnus-level-subscribed) (and all t) (or lowest 1) regexp)
(goto-char (point-min))
(gnus-group-position-point))
(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
+ ;; If INFO is non-nil, use that info. If FORCE is non-nil, don't
;; add, but replace marked articles of TYPE with ARTICLES.
(let ((info (or info (gnus-get-info group)))
marked m)
""
(gnus-time-iso8601 time))))
-(defun gnus-group-prepare-flat-list-dead-predicate
- (groups level mark predicate)
- (let (group)
- (if predicate
- ;; This loop is used when listing groups that match some
- ;; regexp.
- (while (setq group (pop groups))
- (when (funcall predicate group)
- (gnus-add-text-properties
- (point) (prog1 (1+ (point))
- (insert " " mark " *: "
- (gnus-group-name-decode group
- (gnus-group-name-charset
- nil group))
- "\n"))
- (list 'gnus-group (gnus-intern-safe group gnus-active-hashtb)
- 'gnus-unread t
- 'gnus-level level)))))))
-
-(defun gnus-group-prepare-flat-predicate (level predicate &optional lowest
- dead-predicate)
- "List all newsgroups with unread articles of level LEVEL or lower.
-If LOWEST is non-nil, list all newsgroups of level LOWEST or higher.
-If PREDICATE, only list groups which PREDICATE returns non-nil.
-If DEAD-PREDICATE, list dead groups which DEAD-PREDICATE returns non-nil."
- (set-buffer gnus-group-buffer)
- (let ((buffer-read-only nil)
- (newsrc (cdr gnus-newsrc-alist))
- (lowest (or lowest 1))
- info clevel unread group params)
- (erase-buffer)
- ;; List living groups.
- (while newsrc
- (setq info (car newsrc)
- group (gnus-info-group info)
- params (gnus-info-params info)
- newsrc (cdr newsrc)
- unread (car (gnus-gethash group gnus-newsrc-hashtb)))
- (and unread ; This group might be unchecked
- (funcall predicate info)
- (<= (setq clevel (gnus-info-level info)) level)
- (>= clevel lowest)
- (gnus-group-insert-group-line
- group (gnus-info-level info)
- (gnus-info-marks info) unread (gnus-info-method info))))
-
- ;; List dead groups.
- (and (>= level gnus-level-zombie) (<= lowest gnus-level-zombie)
- (gnus-group-prepare-flat-list-dead-predicate
- (setq gnus-zombie-list (sort gnus-zombie-list 'string<))
- gnus-level-zombie ?Z
- dead-predicate))
- (and (>= level gnus-level-killed) (<= lowest gnus-level-killed)
- (gnus-group-prepare-flat-list-dead-predicate
- (setq gnus-killed-list (sort gnus-killed-list 'string<))
- gnus-level-killed ?K dead-predicate))
-
- (gnus-group-set-mode-line)
- (setq gnus-group-list-mode (cons level t))
- (gnus-run-hooks 'gnus-group-prepare-hook)
- t))
-
(defun gnus-group-list-cached (level &optional lowest)
"List all groups with cached articles.
If the prefix LEVEL is non-nil, it should be a number that says which
(setq level (prefix-numeric-value level)))
(when (or (not level) (>= level gnus-level-zombie))
(gnus-cache-open))
- (gnus-group-prepare-flat-predicate (or level gnus-level-subscribed)
- #'(lambda (info)
- (let ((marks (gnus-info-marks info)))
- (assq 'cache marks)))
- lowest
- #'(lambda (group)
- (or (gnus-gethash group
- gnus-cache-active-hashtb)
- ;; Cache active file might use "."
- ;; instead of ":".
- (gnus-gethash
- (mapconcat 'identity
- (split-string group ":")
- ".")
- gnus-cache-active-hashtb))))
+ (funcall gnus-group-prepare-function
+ (or level gnus-level-subscribed)
+ #'(lambda (info)
+ (let ((marks (gnus-info-marks info)))
+ (assq 'cache marks)))
+ lowest
+ #'(lambda (group)
+ (or (gnus-gethash group
+ gnus-cache-active-hashtb)
+ ;; Cache active file might use "."
+ ;; instead of ":".
+ (gnus-gethash
+ (mapconcat 'identity
+ (split-string group ":")
+ ".")
+ gnus-cache-active-hashtb))))
(goto-char (point-min))
(gnus-group-position-point))
(setq level (prefix-numeric-value level)))
(when (or (not level) (>= level gnus-level-zombie))
(gnus-cache-open))
- (gnus-group-prepare-flat-predicate (or level gnus-level-subscribed)
- #'(lambda (info)
- (let ((marks (gnus-info-marks info)))
- (assq 'dormant marks)))
- lowest)
+ (funcall gnus-group-prepare-function
+ (or level gnus-level-subscribed)
+ #'(lambda (info)
+ (let ((marks (gnus-info-marks info)))
+ (assq 'dormant 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)
+ (goto-char (point-min))
+ (while (setq point (text-property-not-all (point) (point-max)
+ 'gnus-group nil))
+ (goto-char point)
+ (push (symbol-name (get-text-property point 'gnus-group)) groups)
+ (forward-char 1))
+ groups))
+
+(defun gnus-group-list-plus (&optional args)
+ "List groups plus the current selection."
+ (interactive "P")
+ (let ((gnus-group-listed-groups (gnus-group-listed-groups))
+ (gnus-group-list-mode gnus-group-list-mode) ;; Save it.
+ func)
+ (push last-command-event unread-command-events)
+ (if (featurep 'xemacs)
+ (push (make-event 'key-press '(key ?A)) unread-command-events)
+ (push ?A unread-command-events))
+ (let (gnus-pick-mode keys)
+ (setq keys (if (featurep 'xemacs)
+ (events-to-keys (read-key-sequence nil))
+ (read-key-sequence nil)))
+ (setq func (lookup-key (current-local-map) keys)))
+ (if (or (not func)
+ (numberp func))
+ (ding)
+ (call-interactively func))))
+
+(defun gnus-group-list-flush (&optional args)
+ "Flush groups from the current selection."
+ (interactive "P")
+ (let ((gnus-group-list-option 'flush))
+ (gnus-group-list-plus args)))
+
+(defun gnus-group-list-limit (&optional args)
+ "List groups limited within the current selection."
+ (interactive "P")
+ (let ((gnus-group-list-option 'limit))
+ (gnus-group-list-plus args)))
+
(provide 'gnus-group)
;;; gnus-group.el ends here