;;; gnus-group.el --- group mode commands for Gnus
-;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002
+;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003
;; Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
(function-item gnus-group-sort-by-rank)
(function :tag "other" nil))))
-(defcustom gnus-group-line-format "%M\%S\%p\%P\%5y: %(%g%)%l %O\n"
+(defcustom gnus-group-line-format "%M\%S\%p\%P\%5y:%B%(%g%)%l %O\n"
"*Format of group lines.
It works along the same lines as a normal formatting string,
with some simple extensions.
%i Number of ticked and dormant (integer)
%T Number of ticked articles (integer)
%R Number of read articles (integer)
+%U Number of unseen articles (integer)
%t Estimated total number of articles (integer)
%y Number of unread, unticked articles (integer)
%G Group name (string)
%s Select method (string)
%o Moderated group (char, \"m\")
%p Process mark (char)
+%B Whether a summary buffer for the group is open (char, \"*\")
%O Moderated group (string, \"(m)\" or \"\")
%P Topic indentation (string)
%m Whether there is new(ish) mail in the group (char, \"%\")
;;; Internal variables
+(defvar gnus-group-is-exiting-p nil)
(defvar gnus-group-sort-alist-function 'gnus-group-sort-flat
"Function for sorting the group buffer.")
(gnus-range-length (cdr (assq 'tick gnus-tmp-marked))))))
(t number)) ?s)
(?R gnus-tmp-number-of-read ?s)
+ (?U (gnus-number-of-unseen-articles-in-group gnus-tmp-group) ?d)
(?t gnus-tmp-number-total ?d)
(?y gnus-tmp-number-of-unread ?s)
(?I (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked))) ?d)
(?n gnus-tmp-news-method ?s)
(?P gnus-group-indentation ?s)
(?E gnus-tmp-group-icon ?s)
+ (?B gnus-tmp-summary-live ?c)
(?l gnus-tmp-grouplens ?s)
(?z gnus-tmp-news-method-string ?s)
(?m (gnus-group-new-mail gnus-tmp-group) ?c)
"l" gnus-group-sort-groups-by-level
"v" gnus-group-sort-groups-by-score
"r" gnus-group-sort-groups-by-rank
- "m" gnus-group-sort-groups-by-method)
+ "m" gnus-group-sort-groups-by-method
+ "n" gnus-group-sort-groups-by-real-name)
(gnus-define-keys (gnus-group-sort-selected-map "P" gnus-group-group-map)
"s" gnus-group-sort-selected-groups
"l" gnus-group-sort-selected-groups-by-level
"v" gnus-group-sort-selected-groups-by-score
"r" gnus-group-sort-selected-groups-by-rank
- "m" gnus-group-sort-selected-groups-by-method)
+ "m" gnus-group-sort-selected-groups-by-method
+ "n" gnus-group-sort-selected-groups-by-real-name)
(gnus-define-keys (gnus-group-list-map "A" gnus-group-mode-map)
"k" gnus-group-list-killed
"\C-k" gnus-group-kill-level
"z" gnus-group-kill-all-zombies))
+(defun gnus-topic-mode-p ()
+ "Return non-nil in `gnus-topic-mode'."
+ (and (boundp 'gnus-topic-mode)
+ gnus-topic-mode))
+
(defun gnus-group-make-menu-bar ()
(gnus-turn-off-edit-menu 'group)
(unless (boundp 'gnus-group-reading-menu)
(easy-menu-define
gnus-group-reading-menu gnus-group-mode-map ""
`("Group"
- ["Read" gnus-group-read-group (gnus-group-group-name)]
- ["Select" gnus-group-select-group (gnus-group-group-name)]
+ ["Read" gnus-group-read-group
+ :included (not (gnus-topic-mode-p))
+ :active (gnus-group-group-name)]
+ ["Read " gnus-topic-read-group
+ :included (gnus-topic-mode-p)]
+ ["Select" gnus-group-select-group
+ :included (not (gnus-topic-mode-p))
+ :active (gnus-group-group-name)]
+ ["Select " gnus-topic-select-group
+ :included (gnus-topic-mode-p)]
["See old articles" (gnus-group-select-group 'all)
:keys "C-u SPC" :active (gnus-group-group-name)]
- ["Catch up" gnus-group-catchup-current :active (gnus-group-group-name)
+ ["Catch up" gnus-group-catchup-current
+ :included (not (gnus-topic-mode-p))
+ :active (gnus-group-group-name)
,@(if (featurep 'xemacs) nil
'(:help "Mark unread articles in the current group as read"))]
+ ["Catch up " gnus-topic-catchup-articles
+ :included (gnus-topic-mode-p)
+ ,@(if (featurep 'xemacs) nil
+ '(:help "Mark unread articles in the current group or topic 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
+ :included (not (gnus-topic-mode-p))
:active (gnus-group-group-name)
,@(if (featurep 'xemacs) nil
'(:help "Check for new messages in current group"))]
+ ["Check for new articles " gnus-topic-get-new-news-this-topic
+ :included (gnus-topic-mode-p)
+ ,@(if (featurep 'xemacs) nil
+ '(:help "Check for new messages in current group or topic"))]
["Toggle subscription" gnus-group-unsubscribe-current-group
(gnus-group-group-name)]
["Kill" gnus-group-kill-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)]
- ["Fetch charter" gnus-group-fetch-charter :active (gnus-group-group-name)
+ ["Fetch charter" gnus-group-fetch-charter
+ :active (gnus-group-group-name)
,@(if (featurep 'xemacs) nil
'(:help "Display the charter of the current group"))]
- ["Fetch control message" gnus-group-fetch-control :active (gnus-group-group-name)
+ ["Fetch control message" gnus-group-fetch-control
+ :active (gnus-group-group-name)
,@(if (featurep 'xemacs) nil
'(:help "Display the archived control message for the current group"))]
;; Actually one should check, if any of the marked groups gives t for
;; (gnus-check-backend-function 'request-expire-articles ...)
- ["Expire articles" gnus-group-expire-articles
- (or (and (gnus-group-group-name)
- (gnus-check-backend-function
- 'request-expire-articles
- (gnus-group-group-name))) gnus-group-marked)]
+ ["Expire articles" gnus-group-expire-articles
+ :included (not (gnus-topic-mode-p))
+ :active (or (and (gnus-group-group-name)
+ (gnus-check-backend-function
+ 'request-expire-articles
+ (gnus-group-group-name))) gnus-group-marked)]
+ ["Expire articles " gnus-topic-expire-articles
+ :included (gnus-topic-mode-p)]
["Set group level..." gnus-group-set-current-level
(gnus-group-group-name)]
["Select quick" gnus-group-quick-select-group (gnus-group-group-name)]
["Customize" gnus-group-customize (gnus-group-group-name)]
("Edit"
["Parameters" gnus-group-edit-group-parameters
- (gnus-group-group-name)]
+ :included (not (gnus-topic-mode-p))
+ :active (gnus-group-group-name)]
+ ["Parameters " gnus-topic-edit-parameters
+ :included (gnus-topic-mode-p)]
["Select method" gnus-group-edit-group-method
(gnus-group-group-name)]
["Info" gnus-group-edit-group (gnus-group-group-name)]
["Sort by real name" gnus-group-sort-groups-by-real-name t])
("Sort process/prefixed"
["Default sort" gnus-group-sort-selected-groups
- (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))]
+ (not (gnus-topic-mode-p))]
["Sort by method" gnus-group-sort-selected-groups-by-method
- (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))]
+ (not (gnus-topic-mode-p))]
["Sort by rank" gnus-group-sort-selected-groups-by-rank
- (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))]
+ (not (gnus-topic-mode-p))]
["Sort by score" gnus-group-sort-selected-groups-by-score
- (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))]
+ (not (gnus-topic-mode-p))]
["Sort by level" gnus-group-sort-selected-groups-by-level
- (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))]
+ (not (gnus-topic-mode-p))]
["Sort by unread" gnus-group-sort-selected-groups-by-unread
- (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))]
+ (not (gnus-topic-mode-p))]
["Sort by name" gnus-group-sort-selected-groups-by-alphabet
- (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))]
+ (not (gnus-topic-mode-p))]
["Sort by real name" gnus-group-sort-selected-groups-by-real-name
- (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))])
+ (not (gnus-topic-mode-p))])
("Mark"
["Mark group" gnus-group-mark-group
(and (gnus-group-group-name)
(memq (gnus-group-group-name) gnus-group-marked))]
["Unmark all" gnus-group-unmark-all-groups gnus-group-marked]
["Mark regexp..." gnus-group-mark-regexp t]
- ["Mark region" gnus-group-mark-region t]
+ ["Mark region" gnus-group-mark-region :active (gnus-mark-active-p)]
["Mark buffer" gnus-group-mark-buffer t]
["Execute command" gnus-group-universal-argument
(or gnus-group-marked (gnus-group-group-name))])
("Subscribe"
["Subscribe to a group..." gnus-group-unsubscribe-group t]
- ["Kill all newsgroups in region" gnus-group-kill-region t]
+ ["Kill all newsgroups in region" gnus-group-kill-region
+ :active (gnus-mark-active-p)]
["Kill all zombie groups" gnus-group-kill-all-zombies
gnus-zombie-list]
["Kill all groups on level..." gnus-group-kill-level t])
params (gnus-info-params info)
newsrc (cdr newsrc)
unread (car (gnus-gethash group gnus-newsrc-hashtb)))
- (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
+ (when not-in-list
+ (setq not-in-list (delete group not-in-list)))
+ (when (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))
+ (> unread 0))
; We list groups with unread articles
- (and gnus-list-groups-with-ticked-articles
- (cdr (assq 'tick (gnus-info-marks info))))
+ (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.
- (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))
+ (when (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))
+ (when not-in-list
+ (dolist (group gnus-zombie-list)
+ (setq not-in-list (delete group not-in-list))))
+ (when (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 predicate))
nil)
(gnus-method-simplify (gnus-find-method-for-group group))))))
+(defun gnus-number-of-unseen-articles-in-group (group)
+ (let* ((info (nth 2 (gnus-group-entry group)))
+ (marked (gnus-info-marks info))
+ (seen (cdr (assq 'seen marked)))
+ (active (gnus-active group)))
+ (if (not active)
+ 0
+ (length (gnus-uncompress-range
+ (gnus-range-difference
+ (gnus-range-difference (list active) (gnus-info-read info))
+ seen))))))
+
(defun gnus-group-insert-group-line (gnus-tmp-group gnus-tmp-level
gnus-tmp-marked number
gnus-tmp-method)
(zerop number)
(cdr (assq 'tick gnus-tmp-marked)))
?* ? ))
+ (gnus-tmp-summary-live
+ (if (and (not gnus-group-is-exiting-p)
+ (gnus-buffer-live-p (gnus-summary-buffer-name
+ gnus-tmp-group)))
+ ?* ? ))
(gnus-tmp-process-marked
(if (member gnus-tmp-group gnus-group-marked)
gnus-process-mark ? ))
(gnus-group-prefixed-name group method) method)))
;;;###autoload
-(defun gnus-fetch-group (group)
+(defun gnus-fetch-group (group &optional articles)
"Start Gnus if necessary and enter GROUP.
Returns whether the fetching was successful or not."
(interactive (list (completing-read "Group name: " gnus-active-hashtb)))
(unless (get-buffer gnus-group-buffer)
(gnus-no-server))
- (gnus-group-read-group nil nil group))
+ (gnus-group-read-group articles nil group))
;;;###autoload
(defun gnus-fetch-group-other-frame (group)
(defun gnus-group-jump-to-group (group)
"Jump to newsgroup GROUP."
(interactive
- (list (completing-read
- "Group: " gnus-active-hashtb nil
- (gnus-read-active-file-p)
- gnus-group-jump-to-group-prompt
- 'gnus-group-history)))
+ (list (mm-string-make-unibyte
+ (completing-read
+ "Group: " gnus-active-hashtb nil
+ (gnus-read-active-file-p)
+ gnus-group-jump-to-group-prompt
+ 'gnus-group-history))))
(when (equal group "")
(error "Empty group name"))
(gnus-group-goto-group group)
(gnus-group-kill-group 1 t)
(gnus-sethash group nil gnus-active-hashtb)
- (when gnus-cache-active-hashtb
+ (when (and (boundp 'gnus-cache-active-hashtb)
+ gnus-cache-active-hashtb)
(gnus-sethash group nil gnus-cache-active-hashtb)
(setq gnus-cache-active-altered t))
t))
(nnweb-type ,(intern type))
(nnweb-ephemeral-p t))))
(if solid
- (gnus-group-make-group group "nnweb" "" `(,(intern type) ,search))
+ (progn
+ (gnus-pull 'nnweb-ephemeral-p method)
+ (gnus-group-make-group group method))
(gnus-group-read-ephemeral-group
group method t
(cons (current-buffer)
num)))
(defun gnus-group-expire-articles (&optional n)
- "Expire all expirable articles in the current newsgroup."
+ "Expire all expirable articles in the current newsgroup.
+Uses the process/prefix convention."
(interactive "P")
(let ((groups (gnus-group-process-prefix n))
group)
(gnus-group-group-name)
(when current-prefix-arg
(completing-read
- "Faq dir: " (and (listp gnus-group-faq-directory)
+ "FAQ dir: " (and (listp gnus-group-faq-directory)
(mapcar #'list
gnus-group-faq-directory))))))
(unless group
(unless group
(error "No group name given"))
(require 'mm-url)
+ (condition-case nil (require 'url-http) (error nil))
(let ((name (mm-url-form-encode-xwfu (gnus-group-real-name group)))
url hierarchy)
(when (string-match "\\(^[^\\.]+\\)\\..*" name)
(setq hierarchy (match-string 1 name))
- (if (setq url (cdr (assoc hierarchy gnus-group-charter-alist)))
+ (if (and (setq url (cdr (assoc hierarchy gnus-group-charter-alist)))
+ (if (fboundp 'url-http-file-exists-p)
+ (url-http-file-exists-p (eval url))
+ t))
(browse-url (eval url))
- (gnus-group-fetch-control group)))))
+ (setq url (concat "http://" hierarchy
+ ".news-admin.org/charters/" name))
+ (if (and (fboundp 'url-http-file-exists-p)
+ (url-http-file-exists-p url))
+ (browse-url url)
+ (gnus-group-fetch-control group))))))
(defun gnus-group-fetch-control (group)
"Fetch the archived control messages for the current group.
(setq gnus-newsgroup-unselected
(nreverse gnus-newsgroup-unselected)))))
(gnus-activate-group group)
- (gnus-group-make-articles-read group
- (list article))
+ (gnus-group-make-articles-read group (list article))
(when (gnus-group-auto-expirable-p group)
(gnus-add-marked-articles
group 'expire (list article))))))
projects / gnus / blobdiff