;;; 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.
;;; Code:
+(eval-when-compile (require 'cl))
+
(require 'gnus)
(require 'gnus-start)
(require 'nnmail)
(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-permanently-visible-groups nil
"*Regexp to match groups that should always be listed in the group buffer.
-This means that they will still be listed when there are no unread
-articles in the groups."
+This means that they will still be listed even when there are no
+unread articles in the groups.
+
+If nil, no groups are permanently visible."
:group 'gnus-group-listing
:type 'regexp)
: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
"m" gnus-group-mark-group
"u" gnus-group-unmark-group
"w" gnus-group-mark-region
- "m" gnus-group-mark-buffer
+ "b" gnus-group-mark-buffer
"r" gnus-group-mark-regexp
"U" gnus-group-unmark-all-groups)
(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 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-tmp-moderated-string
(if (eq gnus-tmp-moderated ?m) "(m)" ""))
(gnus-tmp-method
- (gnus-server-get-method gnus-tmp-group gnus-tmp-method))
+ (gnus-server-get-method gnus-tmp-group gnus-tmp-method)) ;
(gnus-tmp-news-server (or (cadr gnus-tmp-method) ""))
(gnus-tmp-news-method (or (car gnus-tmp-method) ""))
(gnus-tmp-news-method-string
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)))
(save-excursion
(set-buffer gnus-group-buffer)
(let* ((gformat (or gnus-group-mode-line-format-spec
- (setq gnus-group-mode-line-format-spec
- (gnus-parse-format
- gnus-group-mode-line-format
- gnus-group-mode-line-format-alist))))
+ (gnus-set-format 'group-mode)))
(gnus-tmp-news-server (cadr gnus-select-method))
(gnus-tmp-news-method (car gnus-select-method))
(gnus-tmp-colon (if (equal gnus-tmp-news-server "") "" ":"))
(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))))))
-(defun gnus-group-iterate (arg function)
- "Iterate FUNCTION over all process/prefixed groups.
+;;; !!!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"))
+ (groups (make-symbol "gnus-group-iterate-groups"))
+ (group (make-symbol "gnus-group-iterate-group")))
+ (eval
+ `(defun gnus-group-iterate (arg ,function)
+ "Iterate FUNCTION over all process/prefixed groups.
FUNCTION will be called with the group name as the paremeter
and with point over the group in question."
- (let ((groups (gnus-group-process-prefix arg))
- group)
- (while (setq group (pop groups))
- (gnus-group-remove-mark group)
- (save-excursion
- (save-selected-window
- (funcall function group))))))
+ (let ((,groups (gnus-group-process-prefix arg))
+ (,window (selected-window))
+ ,group)
+ (while (setq ,group (pop ,groups))
+ (select-window ,window)
+ (gnus-group-remove-mark ,group)
+ (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.
"Select the current group \"quickly\".
This means that no highlighting or scoring will be performed.
If ALL (the prefix argument) is 0, don't even generate the summary
-buffer."
+buffer.
+
+This might be useful if you want to toggle threading
+before entering the group."
(interactive "P")
(require 'gnus-score)
(let (gnus-visual
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)))
Returns whether the fetching was successful or not."
(interactive "sGroup name: ")
(unless (get-buffer gnus-group-buffer)
- (gnus))
+ (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))
;; 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)
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.
(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)))
\"hard\" re-reading of the active files from all servers."
(interactive "P")
(let ((gnus-inhibit-demon t))
- (run-hooks 'gnus-get-new-news-hook)
+ (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-read-init-file ()
"Read the Gnus elisp init file."
(interactive)
- (gnus-read-init-file))
+ (gnus-read-init-file)
+ (gnus-message 5 "Read %s" gnus-init-file))
(defun gnus-group-check-bogus-groups (&optional silent)
"Check bogus newsgroups.
(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."
(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))))
projects / gnus / blobdiff