;;; gnus-group.el --- group mode commands for Gnus
-;; Copyright (C) 1996,97 Free Software Foundation, Inc.
+;; Copyright (C) 1996,97,98,99 Free Software Foundation, Inc.
-;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
;; This file is part of GNU Emacs.
(require 'gnus-range)
(require 'gnus-win)
(require 'gnus-undo)
+(require 'time-date)
(defcustom gnus-group-archive-directory
- "/ftp@ftp.hpc.uh.edu:/pub/emacs/ding-list/"
+ "*ftp@ftp.hpc.uh.edu:/pub/emacs/ding-list/"
"*The address of the (ding) archives."
:group 'gnus-group-foreign
:type 'directory)
(defcustom gnus-group-recent-archive-directory
- "/ftp@ftp.hpc.uh.edu:/pub/emacs/ding-list-recent/"
+ "*ftp@ftp.hpc.uh.edu:/pub/emacs/ding-list-recent/"
"*The address of the most recent (ding) articles."
:group 'gnus-group-foreign
:type 'directory)
-(defcustom gnus-no-groups-message "No news is no news"
+(defcustom gnus-no-groups-message "No gnus is bad news"
"*Message displayed by Gnus when no groups are available."
:group 'gnus-start
:type 'string)
:type 'hook)
(defcustom gnus-useful-groups
- `(("(ding) mailing list mirrored at sunsite.auc.dk"
+ '(("(ding) mailing list mirrored at sunsite.auc.dk"
"emacs.ding"
(nntp "sunsite.auc.dk"
- (nntp-address "sunsite.auc.dk")))
+ (nntp-address "sunsite.auc.dk")))
+ ("gnus-bug archive"
+ "gnus-bug"
+ (nndir "/ftp@ftp.ifi.uio.no:/pub/emacs/gnus/gnus-bug/"))
("Gnus help group"
"gnus-help"
(nndoc "gnus-help"
(unless file
(error "Couldn't find doc group"))
file))))))
- "Alist of useful group-server pairs."
+ "*Alist of useful group-server pairs."
:group 'gnus-group-listing
:type '(repeat (list (string :tag "Description")
(string :tag "Name")
gnus-group-news-3-empty-face)
((and (not mailp) (eq level 3)) .
gnus-group-news-3-face)
+ ((and (= unread 0) (not mailp) (eq level 4)) .
+ gnus-group-news-4-empty-face)
+ ((and (not mailp) (eq level 4)) .
+ gnus-group-news-4-face)
+ ((and (= unread 0) (not mailp) (eq level 5)) .
+ gnus-group-news-5-empty-face)
+ ((and (not mailp) (eq level 5)) .
+ gnus-group-news-5-face)
+ ((and (= unread 0) (not mailp) (eq level 6)) .
+ gnus-group-news-6-empty-face)
+ ((and (not mailp) (eq level 6)) .
+ gnus-group-news-6-face)
((and (= unread 0) (not mailp)) .
gnus-group-news-low-empty-face)
((and (not mailp)) .
gnus-group-mail-low-empty-face)
(t .
gnus-group-mail-low-face))
- "Controls the highlighting of group buffer lines.
+ "*Controls the highlighting of group buffer lines.
Below is a list of `Form'/`Face' pairs. When deciding how a a
particular group line should be displayed, each form is
"p" gnus-group-prev-unread-group
"\177" gnus-group-prev-unread-group
[delete] gnus-group-prev-unread-group
+ [backspace] gnus-group-prev-unread-group
"N" gnus-group-next-group
"P" gnus-group-prev-group
"\M-n" gnus-group-next-unread-group-same-level
(fboundp 'gnus-soup-pack-packet)]
["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-soup-brew-soup (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]
["Read manual" gnus-info-find-node 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 without saving" gnus-group-quit t]))
- (run-hooks 'gnus-group-menu-hook)))
+ (gnus-run-hooks 'gnus-group-menu-hook)))
(defun gnus-group-mode ()
"Major mode for reading news.
(gnus-group-set-mode-line)
(setq mode-line-process nil)
(use-local-map gnus-group-mode-map)
- (buffer-disable-undo (current-buffer))
+ (buffer-disable-undo)
(setq truncate-lines t)
(setq buffer-read-only t)
(gnus-set-default-directory)
(gnus-update-format-specifications nil 'group 'group-mode)
(gnus-update-group-mark-positions)
- (make-local-hook 'post-command-hook)
- (add-hook 'post-command-hook 'gnus-clear-inboxes-moved nil t)
(when gnus-use-undo
(gnus-undo-mode 1))
- (run-hooks 'gnus-group-mode-hook))
+ (when gnus-slave
+ (gnus-slave-mode))
+ (gnus-run-hooks 'gnus-group-mode-hook))
(defun gnus-update-group-mark-positions ()
(save-excursion
- (let ((gnus-process-mark 128)
+ (let ((gnus-process-mark ?\200)
(gnus-group-marked '("dummy.group"))
- (gnus-active-hashtb (make-vector 10 0)))
+ (gnus-active-hashtb (make-vector 10 0))
+ (topic ""))
(gnus-set-active "dummy.group" '(0 . 0))
(gnus-set-work-buffer)
(gnus-group-insert-group-line "dummy.group" 0 nil 0 nil)
(list (cons 'process (and (search-forward "\200" nil t)
(- (point) 2))))))))
-(defun gnus-clear-inboxes-moved ()
- (setq nnmail-moved-inboxes nil))
-
(defun gnus-mouse-pick-group (e)
"Enter the group under the mouse pointer."
(interactive "e")
(or level gnus-group-default-list-level gnus-level-subscribed))))
(defun gnus-group-setup-buffer ()
- (switch-to-buffer (get-buffer-create gnus-group-buffer))
+ (set-buffer (gnus-get-buffer-create gnus-group-buffer))
(unless (eq major-mode 'gnus-group-mode)
- (gnus-add-current-to-buffer-list)
(gnus-group-mode)
(when gnus-carpal
(gnus-carpal-setup-buffer 'group))))
(gnus-group-default-level nil t)
gnus-group-default-list-level
gnus-level-subscribed))))
- ;; Just do this here, for no particular good reason.
- (gnus-clear-inboxes-moved)
(unless level
(setq level (car gnus-group-list-mode)
unread (cdr gnus-group-list-mode)))
(gnus-group-set-mode-line)
(setq gnus-group-list-mode (cons level all))
- (run-hooks 'gnus-group-prepare-hook)
+ (gnus-run-hooks 'gnus-group-prepare-hook)
t))
(defun gnus-group-prepare-flat-list-dead (groups level mark regexp)
gnus-level ,gnus-tmp-level))
(when (inline (gnus-visual-p 'group-highlight 'highlight))
(forward-line -1)
- (run-hooks 'gnus-group-update-hook)
+ (gnus-run-hooks 'gnus-group-update-hook)
(forward-line))
;; Allow XEmacs to remove front-sticky text properties.
(gnus-group-remove-excess-properties)))
(mailp (memq 'mail (assoc (symbol-name
(car (or method gnus-select-method)))
gnus-valid-select-methods)))
- (level (or (gnus-info-level info) 9))
+ (level (or (gnus-info-level info) gnus-level-killed))
(score (or (gnus-info-score info) 0))
(ticked (gnus-range-length (cdr (assq 'tick marked))))
(group-age (gnus-group-timestamp-delta group))
(setq list (cdr list)))
(let ((face (cdar list)))
(unless (eq face (get-text-property beg 'face))
- (gnus-put-text-property
+ (gnus-put-text-property-excluding-characters-with-faces
beg end 'face
(setq face (if (boundp face) (symbol-value face) face)))
(gnus-extent-start-open beg)))
found buffer-read-only)
;; Enter the current status into the dribble buffer.
(let ((entry (gnus-gethash group gnus-newsrc-hashtb)))
- (when (and entry (not (gnus-ephemeral-group-p group)))
+ (when (and entry
+ (not (gnus-ephemeral-group-p group)))
(gnus-dribble-enter
(concat "(gnus-group-set-info '"
(gnus-prin1-to-string (nth 2 entry))
(gnus-group-insert-group-line-info group)
(save-excursion
(forward-line -1)
- (run-hooks 'gnus-group-update-group-hook)))
+ (gnus-run-hooks 'gnus-group-update-group-hook)))
(setq loc (1+ loc)))
(unless (or found visible-only)
;; No such line in the buffer, find out where it's supposed to
(gnus-group-insert-group-line-info group)
(save-excursion
(forward-line -1)
- (run-hooks 'gnus-group-update-group-hook))))
+ (gnus-run-hooks 'gnus-group-update-group-hook))))
(when gnus-group-update-group-function
(funcall gnus-group-update-group-function group))
(gnus-group-set-mode-line)))
(defun gnus-group-group-name ()
"Get the name of the newsgroup on the current line."
(let ((group (get-text-property (gnus-point-at-bol) 'gnus-group)))
- (and group (symbol-name group))))
+ (when group
+ (symbol-name group))))
(defun gnus-group-group-level ()
"Get the level of the newsgroup on the current line."
(defun gnus-group-level (group)
"Return the estimated level of GROUP."
(or (gnus-info-level (gnus-get-info group))
- (and (member group gnus-zombie-list) 8)
- 9))
+ (and (member group gnus-zombie-list) gnus-level-zombie)
+ gnus-level-killed))
(defun gnus-group-search-forward (&optional backward all level first-too)
"Find the next newsgroup with unread articles.
(beginning-of-line)
(forward-char (or (cdr (assq 'process gnus-group-mark-positions)) 2))
(subst-char-in-region
- (point) (1+ (point)) (following-char)
+ (point) (1+ (point)) (char-after)
(if unmark
(progn
(setq gnus-group-marked (delete group gnus-group-marked))
(n (abs n))
group groups)
(save-excursion
- (while (and (> n 0)
- (setq group (gnus-group-group-name)))
- (push group groups)
+ (while (> n 0)
+ (if (setq group (gnus-group-group-name))
+ (push group groups))
(setq n (1- n))
(gnus-group-next-group way)))
(nreverse groups)))
(let ((group (gnus-group-group-name)))
(and group (list group))))))
+;;; !!!Surely gnus-group-iterate should be a macro instead? I can't
+;;; imagine why I went through these contortions...
(eval-and-compile
(let ((function (make-symbol "gnus-group-iterate-function"))
(window (make-symbol "gnus-group-iterate-window"))
(save-selected-window
(save-excursion
(funcall ,function ,group)))))))))
-
+
(put 'gnus-group-iterate 'lisp-indent-function 1)
;; Selecting groups.
-(defun gnus-group-read-group (&optional all no-article group)
+(defun gnus-group-read-group (&optional all no-article group select-articles)
"Read news in this newsgroup.
If the prefix argument ALL is non-nil, already read articles become
readable. IF ALL is a number, fetch this number of articles. If the
(cdr (assq 'tick marked)))
(gnus-range-length
(cdr (assq 'dormant marked)))))))
- no-article nil no-display)))
+ no-article nil no-display nil select-articles)))
(defun gnus-group-select-group (&optional all)
"Select this newsgroup.
gnus-summary-mode-hook gnus-select-group-hook
(group (gnus-group-group-name))
(method (gnus-find-method-for-group group)))
- (setq method
- `(,(car method) ,(concat (cadr method) "-ephemeral")
- (,(intern (format "%s-address" (car method))) ,(cadr method))
- ,@(cddr method)))
(gnus-group-read-ephemeral-group
(gnus-group-prefixed-name group method) method)))
(gnus-no-server))
(gnus-group-read-group nil nil group))
+;;;###autoload
+(defun gnus-fetch-group-other-frame (group)
+ "Pop up a frame and enter GROUP."
+ (interactive "P")
+ (let ((window (get-buffer-window gnus-group-buffer)))
+ (cond (window
+ (select-frame (window-frame window)))
+ ((= (length (frame-list)) 1)
+ (select-frame (make-frame)))
+ (t
+ (other-frame 1))))
+ (gnus-fetch-group group))
+
(defvar gnus-ephemeral-group-server 0)
;; Enter a group that is not in the group buffer. Non-nil is returned
;; if selection was successful.
(defun gnus-group-read-ephemeral-group (group method &optional activate
- quit-config request-only)
+ quit-config request-only
+ select-articles)
"Read GROUP from METHOD as an ephemeral group.
If ACTIVATE, request the group first.
If QUIT-CONFIG, use that window configuration when exiting from the
ephemeral group.
If REQUEST-ONLY, don't actually read the group; just request it.
+If SELECT-ARTICLES, only select those articles.
Return the name of the group is selection was successful."
;; Transform the select method into a unique server.
- (let ((saddr (intern (format "%s-address" (car method)))))
- (setq method (gnus-copy-sequence method))
- (require (car method))
- (when (boundp saddr)
- (unless (assq saddr method)
- (nconc method `((,saddr ,(cadr method))))
- (setf (cadr method) (format "%s-%d" (cadr method)
- (incf gnus-ephemeral-group-server))))))
+ (when (stringp method)
+ (setq method (gnus-server-to-method method)))
+ (setq method
+ `(,(car method) ,(concat (cadr method) "-ephemeral")
+ (,(intern (format "%s-address" (car method))) ,(cadr method))
+ ,@(cddr method)))
(let ((group (if (gnus-group-foreign-p group) group
(gnus-group-prefixed-name group method))))
(gnus-sethash
(cons gnus-summary-buffer
gnus-current-window-configuration))))))
gnus-newsrc-hashtb)
+ (push method gnus-ephemeral-servers)
(set-buffer gnus-group-buffer)
(unless (gnus-check-server method)
(error "Unable to contact server: %s" (gnus-status-message method)))
(if request-only
group
(condition-case ()
- (when (gnus-group-read-group t t group)
+ (when (gnus-group-read-group t t group select-articles)
group)
;;(error nil)
(quit nil)))))
(gnus-read-group "Group name: ")
(gnus-read-method "From method: ")))
+ (when (stringp method)
+ (setq method (or (gnus-server-to-method method) method)))
(let* ((meth (when (and method
(not (gnus-server-equal method gnus-select-method)))
(if address (list (intern method) address)
(gnus-set-active new-name (gnus-active group))
(gnus-message 6 "Renaming group %s to %s...done" group new-name)
new-name)
+ (setq gnus-killed-list (delete group gnus-killed-list))
+ (gnus-set-active group nil)
+ (gnus-dribble-touch)
(gnus-group-position-point)))
(defun gnus-group-edit-group (group &optional part)
(gnus-group-position-point)))
(defun gnus-group-make-useful-group (group method)
+ "Create one of the groups described in `gnus-useful-groups'."
(interactive
(let ((entry (assoc (completing-read "Create group: " gnus-useful-groups
nil t)
"Create the Gnus documentation group."
(interactive)
(let ((name (gnus-group-prefixed-name "gnus-help" '(nndoc "gnus-help")))
- (file (nnheader-find-etc-directory "gnus-tut.txt" t))
- dir)
+ (file (nnheader-find-etc-directory "gnus-tut.txt" t)))
(when (gnus-gethash name gnus-newsrc-hashtb)
(error "Documentation group already exists"))
(if (not file)
(push (cons header regexps) scores))
scores)))
(gnus-group-make-group group "nnkiboze" address)
- (nnheader-temp-write (gnus-score-file-name (concat "nnkiboze:" group))
+ (with-temp-file (gnus-score-file-name (concat "nnkiboze:" group))
(let (emacs-lisp-mode-hook)
(pp scores (current-buffer)))))
;; Go through all the infos and replace the old entries
;; with the new infos.
(while infos
- (setcar entries (pop infos))
+ (setcar (car entries) (pop infos))
(pop entries))
;; Update the hashtable.
(gnus-make-hashtable-from-newsrc-alist)))
-(defun gnus-group-sort-selected-groups-by-alphabet (&optional reverse)
+(defun gnus-group-sort-selected-groups-by-alphabet (&optional n reverse)
"Sort the group buffer alphabetically by group name.
-If REVERSE, sort in reverse order."
- (interactive "P")
- (gnus-group-sort-selected-groups 'gnus-group-sort-by-alphabet reverse))
+Obeys the process/prefix convention. If REVERSE (the symbolic prefix),
+sort in reverse order."
+ (interactive (gnus-interactive "P\ny"))
+ (gnus-group-sort-selected-groups n 'gnus-group-sort-by-alphabet reverse))
-(defun gnus-group-sort-selected-groups-by-unread (&optional reverse)
+(defun gnus-group-sort-selected-groups-by-unread (&optional n reverse)
"Sort the group buffer by number of unread articles.
-If REVERSE, sort in reverse order."
- (interactive "P")
- (gnus-group-sort-selected-groups 'gnus-group-sort-by-unread reverse))
+Obeys the process/prefix convention. If REVERSE (the symbolic prefix),
+sort in reverse order."
+ (interactive (gnus-interactive "P\ny"))
+ (gnus-group-sort-selected-groups n 'gnus-group-sort-by-unread reverse))
-(defun gnus-group-sort-selected-groups-by-level (&optional reverse)
+(defun gnus-group-sort-selected-groups-by-level (&optional n reverse)
"Sort the group buffer by group level.
-If REVERSE, sort in reverse order."
- (interactive "P")
- (gnus-group-sort-selected-groups 'gnus-group-sort-by-level reverse))
+Obeys the process/prefix convention. If REVERSE (the symbolic prefix),
+sort in reverse order."
+ (interactive (gnus-interactive "P\ny"))
+ (gnus-group-sort-selected-groups n 'gnus-group-sort-by-level reverse))
-(defun gnus-group-sort-selected-groups-by-score (&optional reverse)
+(defun gnus-group-sort-selected-groups-by-score (&optional n reverse)
"Sort the group buffer by group score.
-If REVERSE, sort in reverse order."
- (interactive "P")
- (gnus-group-sort-selected-groups 'gnus-group-sort-by-score reverse))
+Obeys the process/prefix convention. If REVERSE (the symbolic prefix),
+sort in reverse order."
+ (interactive (gnus-interactive "P\ny"))
+ (gnus-group-sort-selected-groups n 'gnus-group-sort-by-score reverse))
-(defun gnus-group-sort-selected-groups-by-rank (&optional reverse)
+(defun gnus-group-sort-selected-groups-by-rank (&optional n reverse)
"Sort the group buffer by group rank.
-If REVERSE, sort in reverse order."
- (interactive "P")
- (gnus-group-sort-selected-groups 'gnus-group-sort-by-rank reverse))
+Obeys the process/prefix convention. If REVERSE (the symbolic prefix),
+sort in reverse order."
+ (interactive (gnus-interactive "P\ny"))
+ (gnus-group-sort-selected-groups n 'gnus-group-sort-by-rank reverse))
-(defun gnus-group-sort-selected-groups-by-method (&optional reverse)
+(defun gnus-group-sort-selected-groups-by-method (&optional n reverse)
"Sort the group buffer alphabetically by backend name.
-If REVERSE, sort in reverse order."
- (interactive "P")
- (gnus-group-sort-selected-groups 'gnus-group-sort-by-method reverse))
+Obeys the process/prefix convention. If REVERSE (the symbolic prefix),
+sort in reverse order."
+ (interactive (gnus-interactive "P\ny"))
+ (gnus-group-sort-selected-groups n 'gnus-group-sort-by-method reverse))
;;; Sorting predicates.
(when (gnus-group-native-p (gnus-info-group info))
(gnus-info-clear-data info)))
(gnus-get-unread-articles)
- (gnus-dribble-enter "")
+ (gnus-dribble-touch)
(when (gnus-y-or-n-p
"Move the cache away to avoid problems in the future? ")
(call-interactively 'gnus-cache-move-cache)))))
(defun gnus-group-catchup-current (&optional n all)
"Mark all articles not marked as unread in current newsgroup as read.
-If prefix argument N is numeric, the ARG next newsgroups will be
+If prefix argument N is numeric, the next N newsgroups will be
caught up. If ALL is non-nil, marked articles will also be marked as
read. Cross references (Xref: header) of articles are ignored.
-The difference between N and actual number of newsgroups that were
-caught up is returned."
+The number of newsgroups that this function was unable to catch
+up is returned."
(interactive "P")
- (unless (gnus-group-group-name)
- (error "No group on the current line"))
(let ((groups (gnus-group-process-prefix n))
- (ret 0))
+ (ret 0)
+ group)
+ (unless groups (error "No groups selected"))
(if (not
(or (not gnus-interactive-catchup) ;Without confirmation?
gnus-expert-user
(car groups)
(format "these %d groups" (length groups)))))))
n
- (while groups
+ (while (setq group (pop groups))
+ (gnus-group-remove-mark group)
;; Virtual groups have to be given special treatment.
- (let ((method (gnus-find-method-for-group (car groups))))
+ (let ((method (gnus-find-method-for-group group)))
(when (eq 'nnvirtual (car method))
(nnvirtual-catchup-group
- (gnus-group-real-name (car groups)) (nth 1 method) all)))
- (gnus-group-remove-mark (car groups))
- (if (>= (gnus-group-group-level) gnus-level-zombie)
+ (gnus-group-real-name group) (nth 1 method) all)))
+ (if (>= (gnus-info-level (gnus-get-info group))
+ gnus-level-zombie)
(gnus-message 2 "Dead groups can't be caught up")
(if (prog1
- (gnus-group-goto-group (car groups))
- (gnus-group-catchup (car groups) all))
+ (gnus-group-goto-group group)
+ (gnus-group-catchup group all))
(gnus-group-update-group-line)
- (setq ret (1+ ret))))
- (setq groups (cdr groups)))
+ (setq ret (1+ ret)))))
(gnus-group-next-unread-group 1)
ret)))
(gnus-add-marked-articles group 'tick nil nil 'force)
(gnus-add-marked-articles group 'dormant nil nil 'force))
(let ((gnus-newsgroup-name group))
- (run-hooks 'gnus-group-catchup-group-hook))
+ (gnus-run-hooks 'gnus-group-catchup-group-hook))
num))))
(defun gnus-group-expire-articles (&optional n)
(error "No groups to expire"))
(while (setq group (pop groups))
(gnus-group-remove-mark group)
- (when (gnus-check-backend-function 'request-expire-articles group)
- (gnus-message 6 "Expiring articles in %s..." group)
- (let* ((info (gnus-get-info group))
- (expirable (if (gnus-group-total-expirable-p group)
- (cons nil (gnus-list-of-read-articles group))
- (assq 'expire (gnus-info-marks info))))
- (expiry-wait (gnus-group-find-parameter group 'expiry-wait)))
- (when expirable
- (setcdr
- expirable
- (gnus-compress-sequence
- (if expiry-wait
- ;; We set the expiry variables to the group
- ;; parameter.
- (let ((nnmail-expiry-wait-function nil)
- (nnmail-expiry-wait expiry-wait))
- (gnus-request-expire-articles
- (gnus-uncompress-sequence (cdr expirable)) group))
- ;; Just expire using the normal expiry values.
- (gnus-request-expire-articles
- (gnus-uncompress-sequence (cdr expirable)) group))))
- (gnus-close-group group))
- (gnus-message 6 "Expiring articles in %s...done" group)))
+ (gnus-group-expire-articles-1 group)
(gnus-dribble-touch)
(gnus-group-position-point))))
+(defun gnus-group-expire-articles-1 (group)
+ (when (gnus-check-backend-function 'request-expire-articles group)
+ (gnus-message 6 "Expiring articles in %s..." group)
+ (let* ((info (gnus-get-info group))
+ (expirable (if (gnus-group-total-expirable-p group)
+ (cons nil (gnus-list-of-read-articles group))
+ (assq 'expire (gnus-info-marks info))))
+ (expiry-wait (gnus-group-find-parameter group 'expiry-wait)))
+ (when expirable
+ (setcdr
+ expirable
+ (gnus-compress-sequence
+ (if expiry-wait
+ ;; We set the expiry variables to the group
+ ;; parameter.
+ (let ((nnmail-expiry-wait-function nil)
+ (nnmail-expiry-wait expiry-wait))
+ (gnus-request-expire-articles
+ (gnus-uncompress-sequence (cdr expirable)) group))
+ ;; Just expire using the normal expiry values.
+ (gnus-request-expire-articles
+ (gnus-uncompress-sequence (cdr expirable)) group))))
+ (gnus-close-group group))
+ (gnus-message 6 "Expiring articles in %s...done" group))))
+
(defun gnus-group-expire-all-groups ()
"Expire all expirable articles in all newsgroups."
(interactive)
gnus-level-default-subscribed))
s)))))
(unless (and (>= level 1) (<= level gnus-level-killed))
- (error "Illegal level: %d" level))
+ (error "Invalid level: %d" level))
(let ((groups (gnus-group-process-prefix n))
group)
(while (setq group (pop groups))
'gnus-group-history)))
(let ((newsrc (gnus-gethash group gnus-newsrc-hashtb)))
(cond
- ((string-match "^[ \t]$" group)
+ ((string-match "^[ \t]*$" group)
(error "Empty group name"))
(newsrc
;; Toggle subscription flag.
(defun gnus-group-kill-all-zombies ()
"Kill all zombie newsgroups."
(interactive)
- (setq gnus-killed-list (nconc gnus-zombie-list gnus-killed-list))
- (setq gnus-zombie-list nil)
- (gnus-dribble-touch)
- (gnus-group-list-groups))
+ (when (gnus-yes-or-no-p "Really kill all zombies? ")
+ (setq gnus-killed-list (nconc gnus-zombie-list gnus-killed-list))
+ (setq gnus-zombie-list nil)
+ (gnus-dribble-touch)
+ (gnus-group-list-groups)))
(defun gnus-group-kill-region (begin end)
"Kill newsgroups in current region (excluding current point).
(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)
(delq (assoc group gnus-newsrc-alist)
gnus-newsrc-alist))
(when gnus-group-change-level-function
- (funcall gnus-group-change-level-function group 9 3))
+ (funcall gnus-group-change-level-function
+ group gnus-level-killed 3))
(cond
((setq entry (gnus-gethash group gnus-newsrc-hashtb))
(push (cons (car entry) (nth 2 entry))
gnus-list-of-killed-groups)
(setcdr (cdr entry) (cdddr entry)))
((member group gnus-zombie-list)
- (setq gnus-zombie-list (delete group gnus-zombie-list)))))
+ (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-make-hashtable-from-newsrc-alist)))
(gnus-group-position-point)
(if (< (length out) 2) (car out) (nreverse out))))
(defun gnus-group-yank-group (&optional arg)
- "Yank the last newsgroups killed with \\[gnus-group-kill-group],
-inserting it before the current newsgroup. The numeric ARG specifies
-how many newsgroups are to be yanked. The name of the newsgroup yanked
-is returned, or (if several groups are yanked) a list of yanked groups
-is returned."
+ "Yank the last newsgroups killed with \\[gnus-group-kill-group], inserting it before the current newsgroup.
+The numeric ARG specifies how many newsgroups are to be yanked. The
+name of the newsgroup yanked is returned, or (if several groups are
+yanked) a list of yanked groups is returned."
(interactive "p")
(setq arg (or arg 1))
(let (info group prev out)
(gnus-make-hashtable-from-newsrc-alist)
(gnus-group-list-groups)))
(t
- (error "Can't kill; illegal level: %d" level))))
+ (error "Can't kill; invalid level: %d" level))))
(defun gnus-group-list-all-groups (&optional arg)
"List all newsgroups with level ARG or lower.
(defun gnus-activate-all-groups (level)
"Activate absolutely all groups."
- (interactive (list 7))
+ (interactive (list gnus-level-unsubscribed))
(let ((gnus-activate-level level)
(gnus-activate-foreign-newsgroups level))
(gnus-group-get-new-news)))
re-scanning. If ARG is non-nil and not a number, this will force
\"hard\" re-reading of the active files from all servers."
(interactive "P")
- (let ((gnus-inhibit-demon t))
- (run-hooks 'gnus-get-new-news-hook)
+ (require 'nnmail)
+ (let ((gnus-inhibit-demon t)
+ ;; Binding this variable will inhibit multiple fetchings
+ ;; of the same mail source.
+ (nnmail-fetched-sources (list t)))
+ (gnus-run-hooks 'gnus-get-new-news-hook)
;; Read any slave files.
(unless gnus-slave
(gnus-get-unread-articles arg))
(let ((gnus-read-active-file (if arg nil gnus-read-active-file)))
(gnus-get-unread-articles arg)))
- (run-hooks 'gnus-after-getting-new-news-hook)
+ (gnus-run-hooks 'gnus-after-getting-new-news-hook)
(gnus-group-list-groups (and (numberp arg)
(max (car gnus-group-list-mode) arg)))))
(ret (if (numberp n) (- n (length groups)) 0))
(beg (unless n
(point)))
- group)
+ group method)
(while (setq group (pop groups))
(gnus-group-remove-mark group)
;; Bypass any previous denials from the server.
- (gnus-remove-denial (gnus-find-method-for-group group))
+ (gnus-remove-denial (setq method (gnus-find-method-for-group group)))
(if (gnus-activate-group group (if dont-scan nil 'scan))
(progn
(gnus-get-unread-articles-in-group
(gnus-get-info group) (gnus-active group) t)
(unless (gnus-virtual-group-p group)
(gnus-close-group group))
+ (when gnus-agent
+ (gnus-agent-save-group-info
+ method (gnus-group-real-name group) (gnus-active group)))
(gnus-group-update-group group))
(if (eq (gnus-server-status (gnus-find-method-for-group group))
'denied)
(setq dirs (list dirs)))
(while (and (not found)
(setq dir (pop dirs)))
- (setq file (concat (file-name-as-directory dir)
- (gnus-group-real-name group)))
+ (let ((name (gnus-group-real-name group)))
+ (setq file (concat (file-name-as-directory dir) name)))
(if (not (file-exists-p file))
(gnus-message 1 "No such file: %s" file)
(let ((enable-local-variables nil))
(lambda (group)
(and (symbol-name group)
(string-match regexp (symbol-name group))
+ (symbol-value group)
(push (symbol-name group) groups)))
gnus-active-hashtb)
;; Also go through all descriptions that are known to Gnus.
(mapatoms
(lambda (group)
(and (string-match regexp (symbol-value group))
- (gnus-active (symbol-name group))
(push (symbol-name group) groups)))
gnus-description-hashtb))
(if (not groups)
;; Print out all the groups.
(save-excursion
(pop-to-buffer "*Gnus Help*")
- (buffer-disable-undo (current-buffer))
+ (buffer-disable-undo)
(erase-buffer)
(setq groups (sort groups 'string<))
(while groups
(defun gnus-group-find-new-groups (&optional arg)
"Search for new groups and add them.
Each new group will be treated with `gnus-subscribe-newsgroup-method.'
-If ARG (the prefix), use the `ask-server' method to query
-the server for new groups."
- (interactive "P")
- (gnus-find-new-newsgroups arg)
+With 1 C-u, use the `ask-server' method to query the server for new
+groups.
+With 2 C-u's, use most complete method possible to query the server
+for new groups, and subscribe the new groups as zombies."
+ (interactive "p")
+ (gnus-find-new-newsgroups (or arg 1))
(gnus-group-list-groups))
-
+
(defun gnus-group-edit-global-kill (&optional article group)
"Edit the global kill file.
If GROUP, edit that local kill file instead."
In fact, cleanup buffers except for group mode buffer.
The hook gnus-suspend-gnus-hook is called before actually suspending."
(interactive)
- (run-hooks 'gnus-suspend-gnus-hook)
+ (gnus-run-hooks 'gnus-suspend-gnus-hook)
;; Kill Gnus buffers except for group mode buffer.
- (let* ((group-buf (get-buffer gnus-group-buffer))
- ;; Do this on a separate list in case the user does a ^G before we finish
- (gnus-buffer-list
- (delete group-buf (delete gnus-dribble-buffer
- (append gnus-buffer-list nil)))))
- (while gnus-buffer-list
- (gnus-kill-buffer (pop gnus-buffer-list)))
+ (let ((group-buf (get-buffer gnus-group-buffer)))
+ (mapcar (lambda (buf)
+ (unless (member buf (list group-buf gnus-dribble-buffer))
+ (kill-buffer buf)))
+ (gnus-buffers))
(gnus-kill-gnus-frames)
(when group-buf
- (setq gnus-buffer-list (list group-buf))
(bury-buffer group-buf)
(delete-windows-on group-buf t))))
(not gnus-interactive-exit) ;Without confirmation
gnus-expert-user
(gnus-y-or-n-p "Are you sure you want to quit reading news? "))
- (run-hooks 'gnus-exit-gnus-hook)
+ (gnus-run-hooks 'gnus-exit-gnus-hook)
;; Offer to save data from non-quitted summary buffers.
(gnus-offer-save-summaries)
;; Save the newsrc file(s).
;; Reset everything.
(gnus-clear-system)
;; Allow the user to do things after cleaning up.
- (run-hooks 'gnus-after-exiting-gnus-hook)))
+ (gnus-run-hooks 'gnus-after-exiting-gnus-hook)))
(defun gnus-group-quit ()
"Quit reading news without updating .newsrc.eld or .newsrc.
(gnus-yes-or-no-p
(format "Quit reading news without saving %s? "
(file-name-nondirectory gnus-current-startup-file))))
- (run-hooks 'gnus-exit-gnus-hook)
+ (gnus-run-hooks 'gnus-exit-gnus-hook)
(gnus-configure-windows 'group t)
(gnus-dribble-save)
(gnus-close-backends)
(gnus-clear-system)
(gnus-kill-buffer gnus-group-buffer)
;; Allow the user to do things after cleaning up.
- (run-hooks 'gnus-after-exiting-gnus-hook)))
+ (gnus-run-hooks 'gnus-after-exiting-gnus-hook)))
(defun gnus-group-describe-briefly ()
"Give a one line description of the group mode commands."
(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))
(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)))
- (uncompressed '(score bookmark killed))
marked m)
(or (not info)
(and (not (setq marked (nthcdr 3 info)))
(or (null articles)
- (setcdr (nthcdr 2 info)
- (list (list (cons type (gnus-compress-sequence
- articles t)))))))
+ (setcdr (nthcdr 2 info)
+ (list (list (cons type (gnus-compress-sequence
+ articles t)))))))
(and (not (setq m (assq type (car marked))))
(or (null articles)
- (setcar marked
- (cons (cons type (gnus-compress-sequence articles t) )
- (car marked)))))
+ (setcar marked
+ (cons (cons type (gnus-compress-sequence articles t) )
+ (car marked)))))
(if force
(if (null articles)
- (setcar (nthcdr 3 info)
- (delq (assq type (car marked)) (car marked)))
- (setcdr m (gnus-compress-sequence articles t)))
+ (setcar (nthcdr 3 info)
+ (gnus-delete-alist type (car marked)))
+ (setcdr m (gnus-compress-sequence articles t)))
(setcdr m (gnus-compress-sequence
(sort (nconc (gnus-uncompress-range (cdr m))
(copy-sequence articles)) '<) t))))))
(defsubst gnus-group-timestamp (group)
"Return the timestamp for GROUP."
- (gnus-group-get-parameter group 'timestamp))
+ (gnus-group-get-parameter group 'timestamp t))
(defun gnus-group-timestamp-delta (group)
"Return the offset in seconds from the timestamp for GROUP to the current time, as a floating point number."
(let* ((time (or (gnus-group-timestamp group)
(list 0 0)))
- (delta (gnus-time-minus (current-time) time)))
+ (delta (subtract-time (current-time) time)))
(+ (* (nth 0 delta) 65536.0)
(nth 1 delta))))