;;; gnus-group.el --- group mode commands for Gnus
-;; Copyright (C) 1996-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1996-2014 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
;;; Code:
-;; For Emacs <22.2 and XEmacs.
-(eval-and-compile
- (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
-
(eval-when-compile
(require 'cl))
(defvar tool-bar-mode)
(autoload 'gnus-group-make-nnir-group "nnir")
-(defcustom gnus-no-groups-message "No Gnus is good news"
+(defcustom gnus-no-groups-message "No news is good news"
"*Message displayed by Gnus when no groups are available."
:group 'gnus-start
:type 'string)
gnus-group-news-low))
"*Controls the highlighting of group buffer lines.
-Below is a list of `Form'/`Face' pairs. When deciding how a a
+Below is a list of `Form'/`Face' pairs. When deciding how 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
"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
'gnus-group-tool-bar-retro)
"Specifies the Gnus group tool bar.
-It can be either a list or a symbol refering to a list. See
+It can be either a list or a symbol referring to a list. See
`gmm-tool-bar-from-list' for the format of the list. The
default key map is `gnus-group-mode-map'.
(set (make-local-variable 'tool-bar-map) map))))
gnus-group-tool-bar-map)
-(defun gnus-group-mode ()
+(define-derived-mode gnus-group-mode fundamental-mode "Group"
"Major mode for reading news.
All normal editing commands are switched off.
The following commands are available:
\\{gnus-group-mode-map}"
- (interactive)
- (kill-all-local-variables)
(when (gnus-visual-p 'group-menu 'menu)
(gnus-group-make-menu-bar)
(gnus-group-make-tool-bar))
(gnus-simplify-mode-line)
- (setq major-mode 'gnus-group-mode)
- (setq mode-name "Group")
(gnus-group-set-mode-line)
(setq mode-line-process nil)
- (use-local-map gnus-group-mode-map)
(buffer-disable-undo)
(setq truncate-lines t)
(setq buffer-read-only t
(when gnus-use-undo
(gnus-undo-mode 1))
(when gnus-slave
- (gnus-slave-mode))
- (gnus-run-mode-hooks 'gnus-group-mode-hook))
+ (gnus-slave-mode)))
(defun gnus-update-group-mark-positions ()
(save-excursion
(defun gnus-group-setup-buffer ()
(set-buffer (gnus-get-buffer-create gnus-group-buffer))
- (unless (eq major-mode 'gnus-group-mode)
+ (unless (derived-mode-p 'gnus-group-mode)
(gnus-group-mode)))
(defun gnus-group-name-charset (method group)
(predicate t) ; We list all groups?
(t
(or
- (if (eq unread t) ; Unactivated?
+ (if (eq unread t) ; Inactive?
gnus-group-list-inactive-groups
- ; We list unactivated
+ ; We list inactive
(and (numberp unread) (> unread 0)))
; We list groups with unread articles
(and gnus-list-groups-with-ticked-articles
(let ((face (cdar (gnus-group-update-eval-form
group
gnus-group-highlight))))
- (unless (eq face (get-text-property beg 'face))
+ (unless (eq face (gnus-get-text-property-excluding-characters-with-faces beg 'face))
(let ((inhibit-read-only t))
(gnus-put-text-property-excluding-characters-with-faces
beg end 'face
(defun gnus-group-name-at-point ()
"Return a group name from around point if it exists, or nil."
- (if (eq major-mode 'gnus-group-mode)
+ (if (derived-mode-p 'gnus-group-mode)
(let ((group (gnus-group-group-name)))
(when group
(gnus-group-decoded-name group)))
number)
"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 QUIT-CONFIG, use that Gnus window configuration name 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.
If PARAMETERS, use those as the group parameters.
;; (gnus-read-group "Group name: ")
(gnus-group-completing-read)
(gnus-read-method "From method")))
- ;; Transform the select method into a unique server.
(unless (gnus-alive-p)
- (gnus-no-server))
+ (nnheader-init-server-buffer)
+ ;; Necessary because of funky inlining.
+ (require 'gnus-cache)
+ (setq gnus-newsrc-hashtb (gnus-make-hashtable)))
+ ;; 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 ((address-slot
+ (intern (format "%s-address" (car method)))))
+ (setq method
+ (if (assq address-slot (cddr method))
+ `(,(car method) ,(concat (cadr method) "-ephemeral")
+ ,@(cddr method))
+ `(,(car method) ,(concat (cadr method) "-ephemeral")
+ (,address-slot ,(cadr method))
+ ,@(cddr method)))))
(let ((group (if (gnus-group-foreign-p group) group
(gnus-group-prefixed-name (gnus-group-real-name group)
method))))
+ (gnus-set-active group nil)
(gnus-sethash
group
`(-1 nil (,group
,gnus-level-default-subscribed nil nil ,method
,(cons
- (cond
- (quit-config
- (cons 'quit-config quit-config))
- ((assq gnus-current-window-configuration
- gnus-buffer-configuration)
- (cons 'quit-config
+ (cons 'quit-config
+ (cond
+ (quit-config
+ quit-config)
+ ((assq gnus-current-window-configuration
+ gnus-buffer-configuration)
(cons gnus-summary-buffer
- gnus-current-window-configuration))))
+ gnus-current-window-configuration))
+ (t
+ (cons (current-buffer)
+ (current-window-configuration)))))
parameters)))
gnus-newsrc-hashtb)
(push method gnus-ephemeral-servers)
- (set-buffer gnus-group-buffer)
+ (when (gnus-buffer-live-p gnus-group-buffer)
+ (set-buffer gnus-group-buffer))
(unless (gnus-check-server method)
(error "Unable to contact server: %s" (gnus-status-message method)))
(when activate
group start (+ start range)))
(write-region (point-min) (point-max) tmpfile)
(gnus-group-read-ephemeral-group
- (format "%s.start-%s.range-%s" group start range)
+ (format "nndoc+ephemeral:%s.start-%s.range-%s" group start range)
`(nndoc ,tmpfile
(nndoc-article-type mbox))))
(delete-file tmpfile)))
(gnus-read-ephemeral-gmane-group group start range)))
(defcustom gnus-bug-group-download-format-alist
- '((emacs . "http://debbugs.gnu.org/%s;mboxmaint=yes;mboxstat=yes")
+ '((emacs . "http://debbugs.gnu.org/cgi/bugreport.cgi?bug=%s;mboxmaint=yes;mboxstat=yes")
(debian
. "http://bugs.debian.org/cgi-bin/bugreport.cgi?bug=%s&mbox=yes;mboxmaint=yes"))
"Alist of symbols for bug trackers and the corresponding URL format string.
"/.*$" ""))))
(write-region (point-min) (point-max) tmpfile)
(gnus-group-read-ephemeral-group
- "gnus-read-ephemeral-bug"
+ (format "nndoc+ephemeral:bug#%s"
+ (mapconcat 'number-to-string ids ","))
`(nndoc ,tmpfile
(nndoc-article-type mbox))
nil window-conf))
(interactive
(list
(gnus-read-group "Group name: ")
- (gnus-read-method "From method")))
+ (gnus-read-method "Select method for new group (use tab for completion)")))
(when (stringp method)
(setq method (or (gnus-server-to-method method) method)))
(lambda (group)
(gnus-group-delete-group group nil t))))))
-(defun gnus-group-delete-articles (group)
- "Delete all articles in the current group."
- (interactive (list (gnus-group-group-name)))
+(defun gnus-group-delete-articles (group &optional oldp)
+ "Delete all articles in the current group.
+If OLDP (the prefix), only delete articles that are \"old\",
+according to the expiry settings. Note that this will delete old
+not-expirable articles, too."
+ (interactive (list (gnus-group-group-name)
+ current-prefix-arg))
(let ((articles (gnus-uncompress-range (gnus-active group))))
(when (gnus-yes-or-no-p
(format "Do you really want to delete these %d articles forever? "
(length articles)))
- (gnus-request-expire-articles articles group 'force))))
+ (gnus-request-expire-articles articles group
+ (if current-prefix-arg
+ nil
+ 'force)))))
(defun gnus-group-delete-group (group &optional force no-prompt)
"Delete the current group. Only meaningful with editable groups.
(gnus-group-read-ephemeral-group
group method t
(cons (current-buffer)
- (if (eq major-mode 'gnus-summary-mode) 'summary 'group))))))
+ (if (derived-mode-p 'gnus-summary-mode) 'summary 'group))))))
(defvar nnrss-group-alist)
(eval-when-compile
(unless (gnus-group-read-ephemeral-group
name method t
(cons (current-buffer)
- (if (eq major-mode 'gnus-summary-mode)
+ (if (derived-mode-p 'gnus-summary-mode)
'summary 'group)))
(error "Couldn't enter %s" dir))))
(interactive "P")
(gnus-group-catchup-current n 'all))
+(declare-function gnus-sequence-of-unread-articles "gnus-sum" (group))
+
(defun gnus-group-catchup (group &optional all)
"Mark all articles in GROUP as read.
If ALL is non-nil, all articles are marked as read.
(expirable (if (gnus-group-total-expirable-p group)
(cons nil (gnus-list-of-read-articles group))
(assq 'expire (gnus-info-marks info))))
+ (articles-to-expire
+ (gnus-list-range-difference
+ (gnus-uncompress-sequence (cdr expirable))
+ (cdr (assq 'unexist (gnus-info-marks info)))))
(expiry-wait (gnus-group-find-parameter group 'expiry-wait))
(nnmail-expiry-target
(or (gnus-group-find-parameter group 'expiry-target)
;; parameter.
(let ((nnmail-expiry-wait-function nil)
(nnmail-expiry-wait expiry-wait))
- (gnus-request-expire-articles
- (gnus-uncompress-sequence (cdr expirable)) group))
+ (gnus-request-expire-articles articles-to-expire group))
;; Just expire using the normal expiry values.
- (gnus-request-expire-articles
- (gnus-uncompress-sequence (cdr expirable)) group))))
+ (gnus-request-expire-articles articles-to-expire group))))
(gnus-close-group group))
(gnus-message 6 "Expiring articles in %s...done"
(gnus-group-decoded-name group))
(unless gnus-slave
(gnus-master-read-slave-newsrc))
- (gnus-get-unread-articles arg nil one-level)
+ (gnus-get-unread-articles (gnus-group-default-level arg t)
+ nil one-level)
;; If the user wants it, we scan for new groups.
(when (eq gnus-check-new-newsgroups 'always)
(gnus-agent-save-group-info
method (gnus-group-real-name group) active))
(gnus-group-update-group group nil t))
- (if (eq (gnus-server-status (gnus-find-method-for-group group))
- 'denied)
- (gnus-error 3 "Server previously determined to be down; not retrying")
- (gnus-error 3 "%s error: %s" group (gnus-status-message group)))))
+ (gnus-error 3 "%s error: %s" group (gnus-status-message group))))
(when beg
(goto-char beg))
(when gnus-goto-next-group-when-activating
(unless (or (eq buf group-buf)
(eq buf gnus-dribble-buffer)
(with-current-buffer buf
- (eq major-mode 'message-mode)))
+ (derived-mode-p 'message-mode)))
(gnus-kill-buffer buf)))
(setq gnus-backlog-articles nil)
(gnus-kill-gnus-frames)
(defun gnus-group-browse-foreign-server (method)
"Browse a foreign news server.
If called interactively, this function will ask for a select method
- (nntp, nnspool, etc.) and a server address (eg. nntp.some.where).
+ (nntp, nnspool, etc.) and a server address (e.g., nntp.some.where).
If not, METHOD should be a list where the first element is the method
and the second element is the address."
(interactive
;; Suggested by mapjph@bath.ac.uk.
(gnus-completing-read
"Address"
- gnus-secondary-servers))
+ ;; FIXME? gnus-secondary-servers is obsolete,
+ ;; and it is not obvious that there is anything
+ ;; sensible to use instead in this particular case.
+ (if (boundp 'gnus-secondary-servers)
+ gnus-secondary-servers
+ (cdr gnus-select-method))))
;; We got a server name.
how))))
(gnus-browse-foreign-server method))
(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-group-set-params-info (group params)
- (gnus-group-set-info params group 'params))
-
;; Ad-hoc function for inserting data from a different newsrc.eld
;; file. Use with caution, if at all.
(defun gnus-import-other-newsrc-file (file)
(sort (nconc (gnus-uncompress-range (cdr m))
(copy-sequence articles)) '<) t))))))
+(declare-function gnus-summary-add-mark "gnus-sum" (article type))
+
(defun gnus-add-mark (group mark article)
"Mark ARTICLE in GROUP with MARK, whether the group is displayed or not."
(let ((buffer (gnus-summary-buffer-name group)))
(let ((gnus-group-list-option 'limit))
(gnus-group-list-plus args)))
+(declare-function gnus-mark-article-as-read "gnus-sum" (article &optional mark))
+(declare-function gnus-group-make-articles-read "gnus-sum" (group articles))
+
(defun gnus-group-mark-article-read (group article)
"Mark ARTICLE read."
(let ((buffer (gnus-summary-buffer-name group))
(setq mark gnus-expirable-mark))
(setq mark (gnus-request-update-mark
group article mark))
+ (gnus-request-set-mark
+ group (list (list (list article) 'add '(read))))
(gnus-mark-article-as-read article mark)
(setq gnus-newsgroup-active (gnus-active group))
(when active
projects / gnus / blobdiff