;;; 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>
(require 'gnus-undo)
(require 'time-date)
(require 'gnus-ems)
-(require 'mm-url)
+
+(eval-when-compile (require 'mm-url))
(defcustom gnus-group-archive-directory
"*ftp@ftp.hpc.uh.edu:/pub/emacs/ding-list/"
(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, \"%\")
effect.
General format specifiers can also be used.
-See `(gnus)Formatting Variables'."
+See Info node `(gnus)Formatting Variables'."
:link '(custom-manual "(gnus)Formatting Variables")
:group 'gnus-group-visual
:type 'string)
;;; 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) ?s)
(?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
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)
(defun gnus-group-sort-by-method (info1 info2)
"Sort alphabetically by backend name."
- (string< (symbol-name (car (gnus-find-method-for-group
- (gnus-info-group info1) info1)))
- (symbol-name (car (gnus-find-method-for-group
- (gnus-info-group info2) info2)))))
+ (string< (car (gnus-find-method-for-group
+ (gnus-info-group info1) info1))
+ (car (gnus-find-method-for-group
+ (gnus-info-group info2) info2))))
(defun gnus-group-sort-by-server (info1 info2)
"Sort alphabetically by server name."
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
(setq found t))))))
(defun gnus-group-fetch-charter (group)
- "Fetch the charter for the current group."
+ "Fetch the charter for the current group.
+If given a prefix argument, prompt for a group."
(interactive
- (list (or (gnus-group-group-name)
- gnus-newsgroup-name)))
+ (list (or (when current-prefix-arg
+ (completing-read "Group: " gnus-active-hashtb))
+ (gnus-group-group-name)
+ gnus-newsgroup-name)))
(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."
+ "Fetch the archived control messages for the current group.
+If given a prefix argument, prompt for a group."
(interactive
- (list (or (gnus-group-group-name)
- gnus-newsgroup-name)))
+ (list (or (when current-prefix-arg
+ (completing-read "Group: " gnus-active-hashtb))
+ (gnus-group-group-name)
+ gnus-newsgroup-name)))
(unless group
(error "No group name given"))
(let ((name (gnus-group-real-name group))
(when (string-match "\\(^[^\\.]+\\)\\..*" name)
(setq hierarchy (match-string 1 name))
(if gnus-group-fetch-control-use-browse-url
- (browse-url (concat "ftp://ftp.isc.org:/usenet/control/"
+ (browse-url (concat "ftp://ftp.isc.org/usenet/control/"
hierarchy "/" name ".Z"))
(let ((enable-local-variables nil))
(gnus-group-read-ephemeral-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))))))