;;; gnus-group.el --- group mode commands for Gnus
-;; Copyright (C) 1996,97 Free Software Foundation, Inc.
+;; Copyright (C) 1996,97,98 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-undo)
(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)
%l Whether there are GroupLens predictions for this group (string)
%n Select from where (string)
%z A string that look like `<%s:%n>' if a foreign select method is used
-?d The date the group was last entered.
+%d The date the group was last entered.
%u User defined specifier. The next character in the format string should
be a letter. Gnus will call the function gnus-user-format-function-X,
where X is the letter following %u. The function will be passed the
: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"
(nndoc-article-type mbox)
- (eval `(nndoc-address
+ (eval `(nndoc-address
,(let ((file (nnheader-find-etc-directory
"gnus-tut.txt" t)))
(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-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
evaluated. The content of the face field after the first true form is
used. You can change how those group lines are displayed by
-editing the face field.
+editing the face field.
It is also possible to change and add form fields, but currently that
requires an understanding of Lisp expressions. Hopefully this will
"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
"r" gnus-group-read-init-file
"B" gnus-group-browse-foreign-server
"b" gnus-group-check-bogus-groups
- "F" gnus-find-new-newsgroups
+ "F" gnus-group-find-new-groups
"\C-c\C-d" gnus-group-describe-group
"\M-d" gnus-group-describe-all-groups
"\C-c\C-a" gnus-group-apropos
"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)
"r" gnus-group-sort-groups-by-rank
"m" gnus-group-sort-groups-by-method)
- (gnus-define-keys (gnus-group-sort-map "P" gnus-group-group-map)
+ (gnus-define-keys (gnus-group-sort-selected-map "P" gnus-group-group-map)
"s" gnus-group-sort-selected-groups
"a" gnus-group-sort-selected-groups-by-alphabet
"u" gnus-group-sort-selected-groups-by-unread
(gnus-define-keys (gnus-group-help-map "H" gnus-group-mode-map)
"d" gnus-group-describe-group
- "f" gnus-group-fetch-faq)
+ "f" gnus-group-fetch-faq
+ "v" gnus-version)
(gnus-define-keys (gnus-group-sub-map "S" gnus-group-mode-map)
"l" gnus-group-set-current-level
(gnus-group-group-name)]
["Info" gnus-group-edit-group (gnus-group-group-name)]
["Local kill file" gnus-group-edit-local-kill (gnus-group-group-name)]
- ["Global kill file" gnus-group-edit-global-kill t])
- ))
-
+ ["Global kill file" gnus-group-edit-global-kill t])))
+
(easy-menu-define
gnus-group-group-menu gnus-group-mode-map ""
'("Groups"
["First unread group" gnus-group-first-unread-group t]
["Best unread group" gnus-group-best-unread-group t])
["Delete bogus groups" gnus-group-check-bogus-groups t]
- ["Find new newsgroups" gnus-find-new-newsgroups t]
+ ["Find new newsgroups" gnus-group-find-new-groups t]
["Transpose" gnus-group-transpose-groups
(gnus-group-group-name)]
- ["Read a directory as a group..." gnus-group-enter-directory t]
- ))
+ ["Read a directory as a group..." gnus-group-enter-directory t]))
(easy-menu-define
gnus-group-misc-menu gnus-group-mode-map ""
(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]
- ["Check for new news" gnus-group-get-new-news t]
+ ["Check for new news" gnus-group-get-new-news t]
["Activate all groups" gnus-activate-all-groups t]
["Restart Gnus" gnus-group-restart t]
["Read init file" gnus-group-read-init-file 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]
- ))
+ ["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-set-default-directory)
(gnus-update-format-specifications nil 'group 'group-mode)
(gnus-update-group-mark-positions)
- (gnus-make-local-hook 'post-command-hook)
- (gnus-add-hook 'post-command-hook 'gnus-clear-inboxes-moved nil t)
+ (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)
(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))))
"List newsgroups with level LEVEL or lower that have unread articles.
Default is all subscribed groups.
If argument UNREAD is non-nil, groups with no unread articles are also
-listed."
+listed.
+
+Also see the `gnus-group-use-permanent-levels' variable."
(interactive
(list (if current-prefix-arg
(prefix-numeric-value current-prefix-arg)
;; We have some groups displayed.
(goto-char (point-max))
(when (or (not gnus-group-goto-next-group-function)
- (not (funcall gnus-group-goto-next-group-function
+ (not (funcall gnus-group-goto-next-group-function
group props)))
(cond
(empty
(>= clevel lowest)
(or all ; We list all groups?
(if (eq unread t) ; Unactivated?
- gnus-group-list-inactive-groups ; We list unactivated
+ gnus-group-list-inactive-groups ; We list unactivated
(> unread 0)) ; We list groups with unread articles
(and gnus-list-groups-with-ticked-articles
(cdr (assq 'tick (gnus-info-marks info))))
(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)
nil)
nil))))
-(defun gnus-group-insert-group-line (gnus-tmp-group gnus-tmp-level
+(defun gnus-group-insert-group-line (gnus-tmp-group gnus-tmp-level
gnus-tmp-marked number
gnus-tmp-method)
"Insert a group line in the group buffer."
(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
- beg end 'face
+ (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)))
(goto-char p)))
"Update all lines where GROUP appear.
If VISIBLE-ONLY is non-nil, the group won't be displayed if it isn't
already."
- (save-excursion
+ ;; Can't use `save-excursion' here, so we do it manually.
+ (let ((buf (current-buffer))
+ mark)
(set-buffer gnus-group-buffer)
+ (setq mark (point-marker))
;; The buffer may be narrowed.
(save-restriction
(widen)
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 '"
+ (concat "(gnus-group-set-info '"
(gnus-prin1-to-string (nth 2 entry))
")"))))
;; Find all group instances. If topics are in use, each group
(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)))))
+ (gnus-group-set-mode-line)))
+ (goto-char mark)
+ (set-marker mark nil)
+ (set-buffer buf)))
(defun gnus-group-set-mode-line ()
"Update the mode line in the group buffer."
(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 "") "" ":"))
(max-len 60)
gnus-tmp-header ;Dummy binding for user-defined formats
;; Get the resulting string.
- (modified
+ (modified
(and gnus-dribble-buffer
(buffer-name gnus-dribble-buffer)
(buffer-modified-p gnus-dribble-buffer)
(mode-string (eval gformat)))
;; Say whether the dribble buffer has been modified.
(setq mode-line-modified
- (if modified "---*- " "----- "))
+ (if modified (car gnus-mode-line-modified)
+ (cdr gnus-mode-line-modified)))
;; If the line is too long, we chop it off.
(when (> (length mode-string) max-len)
(setq mode-string (substring mode-string 0 (- max-len 4))))
(prog1
- (setq mode-line-buffer-identification
+ (setq mode-line-buffer-identification
(gnus-mode-line-buffer-identification
(list mode-string)))
(set-buffer-modified-p modified))))))
(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.
(not (eobp))
(not (setq
found
- (and (or all
- (and
- (let ((unread
- (get-text-property (point) 'gnus-unread)))
- (and (numberp unread) (> unread 0)))
- (setq lev (get-text-property (point)
+ (and
+ (get-text-property (point) 'gnus-group)
+ (or all
+ (and
+ (let ((unread
+ (get-text-property (point) 'gnus-unread)))
+ (and (numberp unread) (> unread 0)))
+ (setq lev (get-text-property (point)
+ 'gnus-level))
+ (<= lev gnus-level-subscribed)))
+ (or (not level)
+ (and (setq lev (get-text-property (point)
'gnus-level))
- (<= lev gnus-level-subscribed)))
- (or (not level)
- (and (setq lev (get-text-property (point)
- 'gnus-level))
- (or (= lev level)
- (and (< lev low)
- (< level lev)
- (progn
- (setq low lev)
- (setq pos (point))
- nil))))))))
+ (or (= lev level)
+ (and (< lev low)
+ (< level lev)
+ (progn
+ (setq low lev)
+ (setq pos (point))
+ nil))))))))
(zerop (forward-line way)))))
(if found
(progn (gnus-group-position-point) t)
(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)))
- ((and (boundp 'transient-mark-mode)
- transient-mark-mode
- (boundp 'mark-active)
- mark-active)
+ ((gnus-region-active-p)
;; Work on the region between point and mark.
(let ((max (max (point) (mark)))
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)
- (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
(- (1+ (cdr active)) (car active)))))
(gnus-summary-read-group
group (or all (and (numberp number)
- (zerop (+ number (gnus-range-length
+ (zerop (+ number (gnus-range-length
(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-score-find-score-files-function
+ gnus-home-score-file
gnus-apply-kill-hook
gnus-summary-expunge-below)
(gnus-group-read-group all t)))
(defun gnus-group-select-group-ephemerally ()
"Select the current group without doing any processing whatsoever.
You will actually be entered into a group that's a copy of
-the current group; no changes you make while in this group will
+the current group; no changes you make while in this group will
be permanent."
(interactive)
(require 'gnus-score)
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-read-ephemeral-group
(gnus-group-prefixed-name group method) method)))
;;;###autoload
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)
+(defun gnus-group-read-ephemeral-group (group method &optional activate
+ 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.
+ (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
group
- `(-1 nil (,group
+ `(-1 nil (,group
,gnus-level-default-subscribed nil nil ,method
((quit-config .
,(if quit-config quit-config
(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)))
(when activate
(gnus-activate-group group 'scan)
(unless (gnus-request-group group)
- (error "Couldn't request group: %s"
+ (error "Couldn't request group: %s"
(nnheader-get-report (car 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)))))
(when group
(if far
(gnus-goto-char
- (text-property-any
+ (text-property-any
(point-min) (point-max)
'gnus-group (gnus-intern-safe group gnus-active-hashtb)))
(beginning-of-line)
(t
;; Search through the entire buffer.
(gnus-goto-char
- (text-property-any
+ (text-property-any
(point-min) (point-max)
'gnus-group (gnus-intern-safe group gnus-active-hashtb))))))))
(gnus-read-group "Group name: ")
(gnus-read-method "From method: ")))
+ (when (stringp method)
+ (setq method (gnus-server-to-method method)))
(let* ((meth (when (and method
(not (gnus-server-equal method gnus-select-method)))
(if address (list (intern method) address)
(gnus-set-active nname (cons 1 0))
(unless (gnus-ephemeral-group-p name)
(gnus-dribble-enter
- (concat "(gnus-group-set-info '"
+ (concat "(gnus-group-set-info '"
(gnus-prin1-to-string (cdr info)) ")")))
;; Insert the line.
(gnus-group-insert-group-line-info nname)
(unless (gnus-check-backend-function 'request-rename-group group)
(error "This backend does not support renaming groups"))
- (unless group
+ (unless group
(error "No group to rename"))
(when (equal (gnus-group-real-name group) new-name)
(error "Can't rename to the same name"))
;; We find the proper prefixed name.
(setq new-name
- (if (equal (gnus-group-real-name new-name) new-name)
+ (if (gnus-group-native-p group)
;; Native group.
new-name
;; Foreign group.
(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)
(error "No group on current line"))
(unless (setq info (gnus-get-info group))
(error "Killed group; can't be edited"))
- (gnus-close-group group)
+ (ignore-errors
+ (gnus-close-group group))
(gnus-edit-form
;; Find the proper form to edit.
(cond ((eq part 'method)
(t info))
;; The proper documentation.
(format
- "Editing the %s."
+ "Editing the %s for `%s'."
(cond
((eq part 'method) "select method")
((eq part 'params) "group parameters")
- (t "group info")))
+ (t "group info"))
+ group)
`(lambda (form)
(gnus-group-edit-group-done ',part ,group form)))))
(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)
(let* ((group
(if solid (gnus-read-group "Group name: ")
(message-unique-id)))
+ (default-type (or (car gnus-group-web-type-history)
+ (symbol-name (caar nnweb-type-definition))))
(type
- (completing-read
- "Search engine type: "
- (mapcar (lambda (elem) (list (symbol-name (car elem))))
- nnweb-type-definition)
- nil t (cons (or (car gnus-group-web-type-history)
- (symbol-name (caar nnweb-type-definition)))
- 0)
- 'gnus-group-web-type-history))
+ (gnus-string-or
+ (completing-read
+ (format "Search engine type (default %s): " default-type)
+ (mapcar (lambda (elem) (list (symbol-name (car elem))))
+ nnweb-type-definition)
+ nil t nil 'gnus-group-web-type-history)
+ default-type))
(search
- (read-string
- "Search string: "
+ (read-string
+ "Search string: "
(cons (or (car gnus-group-web-search-history) "") 0)
'gnus-group-web-search-history))
(method
(list 'nndir-directory
(if all gnus-group-archive-directory
gnus-group-recent-archive-directory))))
- (gnus-group-add-parameter group (cons 'to-address "ding@ifi.uio.no"))))
+ (gnus-group-add-parameter group (cons 'to-address "ding@gnus.org"))))
(defun gnus-group-make-directory-group (dir)
"Create an nndir group.
(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)))))
(pgroup (gnus-group-prefixed-name group method)))
;; Check whether it exists already.
(when (gnus-gethash pgroup gnus-newsrc-hashtb)
- (error "Group %s already exists." pgroup))
+ (error "Group %s already exists" pgroup))
;; Subscribe the new group after the group on the current line.
(gnus-subscribe-group pgroup (gnus-group-group-name) method)
(gnus-group-update-group pgroup)
(defun gnus-group-sort-groups (func &optional reverse)
"Sort the group buffer according to FUNC.
-If REVERSE, reverse the sorting order."
+When used interactively, the sorting function used will be
+determined by the `gnus-group-sort-function' variable.
+If REVERSE (the prefix), reverse the sorting order."
(interactive (list gnus-group-sort-function current-prefix-arg))
(funcall gnus-group-sort-alist-function
(gnus-make-sort-function func) reverse)
- (gnus-group-list-groups))
+ (gnus-group-list-groups)
+ (gnus-dribble-touch))
(defun gnus-group-sort-flat (func reverse)
;; We peel off the dummy group from the alist.
(when func
- (when (equal (car (gnus-info-group gnus-newsrc-alist)) "dummy.group")
+ (when (equal (gnus-info-group (car gnus-newsrc-alist)) "dummy.group")
(pop gnus-newsrc-alist))
;; Do the sorting.
(setq gnus-newsrc-alist
(when (gnus-group-native-p (gnus-info-group info))
(gnus-info-clear-data info)))
(gnus-get-unread-articles)
- (gnus-dribble-enter "")
- (when (gnus-y-or-n-p
+ (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))
+ (unless groups (error "No groups selected"))
(if (not
(or (not gnus-interactive-catchup) ;Without confirmation?
gnus-expert-user
(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-compress-sequence
(if expiry-wait
;; We set the expiry variables to the group
- ;; parameter.
+ ;; parameter.
(let ((nnmail-expiry-wait-function nil)
(nnmail-expiry-wait expiry-wait))
(gnus-request-expire-articles
(gnus-uncompress-sequence (cdr expirable)) group))))
(gnus-close-group group))
(gnus-message 6 "Expiring articles in %s...done" group)))
+ (gnus-dribble-touch)
(gnus-group-position-point))))
(defun gnus-group-expire-all-groups ()
(gnus-group-unsubscribe-current-group n 'unsubscribe))
(defun gnus-group-subscribe (&optional n)
- "Unsubscribe the current group."
+ "Subscribe the current group."
(interactive "P")
(gnus-group-unsubscribe-current-group n 'subscribe))
groups (cdr groups))
(gnus-group-remove-mark group)
(gnus-group-unsubscribe-group
- group
+ group
(cond
((eq do-sub 'unsubscribe)
gnus-level-default-unsubscribed)
(list (completing-read
"Group: " gnus-active-hashtb nil
(gnus-read-active-file-p)
- nil
+ nil
'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.
(gnus-group-change-level
- newsrc (if level level (if (<= (nth 1 (nth 2 newsrc))
+ newsrc (if level level (if (<= (gnus-info-level (nth 2 newsrc))
gnus-level-subscribed)
(1+ gnus-level-subscribed)
gnus-level-default-subscribed)))
(interactive)
(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)
(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)
(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")
- (run-hooks 'gnus-get-new-news-hook)
-
- ;; Read any slave files.
- (unless gnus-slave
- (gnus-master-read-slave-newsrc))
-
- ;; We might read in new NoCeM messages here.
- (when (and gnus-use-nocem
- (null arg))
- (gnus-nocem-scan-groups))
- ;; If ARG is not a number, then we read the active file.
- (when (and arg (not (numberp arg)))
- (let ((gnus-read-active-file t))
- (gnus-read-active-file))
- (setq arg nil)
-
- ;; If the user wants it, we scan for new groups.
- (when (eq gnus-check-new-newsgroups 'always)
- (gnus-find-new-newsgroups)))
-
- (setq arg (gnus-group-default-level arg t))
- (if (and gnus-read-active-file (not arg))
- (progn
- (gnus-read-active-file)
- (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-group-list-groups))
-
-(defun gnus-group-get-new-news-this-group (&optional n)
+ (let ((gnus-inhibit-demon t))
+ (gnus-run-hooks 'gnus-get-new-news-hook)
+
+ ;; Read any slave files.
+ (unless gnus-slave
+ (gnus-master-read-slave-newsrc))
+
+ ;; We might read in new NoCeM messages here.
+ (when (and gnus-use-nocem
+ (null arg))
+ (gnus-nocem-scan-groups))
+ ;; If ARG is not a number, then we read the active file.
+ (when (and arg (not (numberp arg)))
+ (let ((gnus-read-active-file t))
+ (gnus-read-active-file))
+ (setq arg nil)
+
+ ;; If the user wants it, we scan for new groups.
+ (when (eq gnus-check-new-newsgroups 'always)
+ (gnus-find-new-newsgroups)))
+
+ (setq arg (gnus-group-default-level arg t))
+ (if (and gnus-read-active-file (not arg))
+ (progn
+ (gnus-read-active-file)
+ (gnus-get-unread-articles arg))
+ (let ((gnus-read-active-file (if arg nil gnus-read-active-file)))
+ (gnus-get-unread-articles arg)))
+ (gnus-run-hooks 'gnus-after-getting-new-news-hook)
+ (gnus-group-list-groups (and (numberp arg)
+ (max (car gnus-group-list-mode) arg)))))
+
+(defun gnus-group-get-new-news-this-group (&optional n dont-scan)
"Check for newly arrived news in the current group (and the N-1 next groups).
The difference between N and the number of newsgroup checked is returned.
If N is negative, this group and the N-1 previous groups will be checked."
(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))
- (if (gnus-activate-group group 'scan)
+ (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))
+ (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)
(interactive
(list
(gnus-group-group-name)
- (cond (current-prefix-arg
- (completing-read
- "Faq dir: " (and (listp gnus-group-faq-directory)
- (mapcar (lambda (file) (list file))
- gnus-group-faq-directory)))))))
+ (when current-prefix-arg
+ (completing-read
+ "Faq dir: " (and (listp gnus-group-faq-directory)
+ (mapcar (lambda (file) (list file))
+ gnus-group-faq-directory))))))
(unless group
(error "No group name given"))
(let ((dirs (or faq-dir gnus-group-faq-directory))
(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.
(when (and level
(> (prefix-numeric-value level) gnus-level-killed))
(gnus-get-killed-groups))
- (gnus-group-prepare-flat
+ (gnus-group-prepare-flat
(or level gnus-level-subscribed) all (or lowest 1) regexp)
(goto-char (point-min))
(gnus-group-position-point))
(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.
(gnus-check-bogus-newsgroups (and (not silent) (not gnus-expert-user)))
(gnus-group-list-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.'
+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))))
"Quit reading news after updating .newsrc.eld and .newsrc.
The hook `gnus-exit-gnus-hook' is called before actually exiting."
(interactive)
- (when
+ (when
(or noninteractive ;For gnus-batch-kill
(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."
"Address: "
(mapcar (lambda (server) (list server))
gnus-secondary-servers)))
- ;; We got a server name, so we find the method.
- (gnus-server-to-method how)))))
+ ;; We got a server name.
+ how))))
(gnus-browse-foreign-server method))
(defun gnus-group-set-info (info &optional method-only-group part)
;; 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)))
(if force
(if (null articles)
(setcar (nthcdr 3 info)
- (delq (assq type (car marked)) (car marked)))
+ (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))
(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