((= unread 0) .
gnus-group-mail-low-empty-face)
(t .
- gnus-group-mail-low-face))
+ gnus-group-mail-low-face))
"*Controls the highlighting of group buffer lines.
Below is a list of `Form'/`Face' pairs. When deciding how a a
"u" gnus-group-make-useful-group
"a" gnus-group-make-archive-group
"k" gnus-group-make-kiboze-group
+ "l" gnus-group-nnimap-edit-acl
"m" gnus-group-make-group
"E" gnus-group-edit-group
"e" gnus-group-edit-group-method
"w" gnus-group-make-web-group
"r" gnus-group-rename-group
"c" gnus-group-customize
+ "x" gnus-group-nnimap-expunge
"\177" gnus-group-delete-group
[delete] gnus-group-delete-group)
["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-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]
params (gnus-info-params info)
newsrc (cdr newsrc)
unread (car (gnus-gethash group gnus-newsrc-hashtb)))
- (and unread ; This group might be bogus
+ (and unread ; This group might be unchecked
(or (not regexp)
(string-match regexp group))
(<= (setq clevel (gnus-info-level info)) level)
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."
+Return the name of the group if selection was successful."
;; Transform the select method into a unique server.
(when (stringp method)
(setq method (gnus-server-to-method 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)
- method)))
+ (let* ((meth (gnus-method-simplify
+ (when (and method
+ (not (gnus-server-equal method gnus-select-method)))
+ (if address (list (intern method) address)
+ method))))
(nname (if method (gnus-group-prefixed-name name meth) name))
backend info)
(when (gnus-gethash nname gnus-newsrc-hashtb)
((= char ?d) 'digest)
((= char ?f) 'forward)
((= char ?a) 'mmfd)
+ ((= char ?g) 'guess)
(t (setq err (format "%c unknown. " char))
nil))))
(setq type found)))
(cons (current-buffer)
(if (eq major-mode 'gnus-summary-mode) 'summary 'group))))))
+(defvar nnwarchive-type-definition)
+(defvar gnus-group-warchive-type-history nil)
+(defvar gnus-group-warchive-login-history nil)
+(defvar gnus-group-warchive-address-history nil)
+
+(defun gnus-group-make-warchive-group ()
+ "Create a nnwarchive group."
+ (interactive)
+ (require 'nnwarchive)
+ (let* ((group (gnus-read-group "Group name: "))
+ (default-type (or (car gnus-group-warchive-type-history)
+ (symbol-name (caar nnwarchive-type-definition))))
+ (type
+ (gnus-string-or
+ (completing-read
+ (format "Warchive type (default %s): " default-type)
+ (mapcar (lambda (elem) (list (symbol-name (car elem))))
+ nnwarchive-type-definition)
+ nil t nil 'gnus-group-warchive-type-history)
+ default-type))
+ (address (read-string "Warchive address: "
+ nil 'gnus-group-warchive-address-history))
+ (default-login (or (car gnus-group-warchive-login-history)
+ user-mail-address))
+ (login
+ (gnus-string-or
+ (read-string
+ (format "Warchive login (default %s): " user-mail-address)
+ default-login 'gnus-group-warchive-login-history)
+ user-mail-address))
+ (method
+ `(nnwarchive ,address
+ (nnwarchive-type ,(intern type))
+ (nnwarchive-login ,login))))
+ (gnus-group-make-group group method)))
+
(defun gnus-group-make-archive-group (&optional all)
"Create the (ding) Gnus archive group of the most recent articles.
Given a prefix, create a full group."
'summary 'group)))
(error "Couldn't enter %s" dir))))
+(eval-and-compile
+ (autoload 'nnimap-expunge "nnimap")
+ (autoload 'nnimap-acl-get "nnimap")
+ (autoload 'nnimap-acl-edit "nnimap"))
+
+(defun gnus-group-nnimap-expunge (group)
+ "Expunge deleted articles in current nnimap GROUP."
+ (interactive (list (gnus-group-group-name)))
+ (let ((mailbox (gnus-group-real-name group)) method)
+ (unless group
+ (error "No group on current line"))
+ (unless (gnus-get-info group)
+ (error "Killed group; can't be edited"))
+ (unless (eq 'nnimap (car (setq method (gnus-find-method-for-group group))))
+ (error "%s is not an nnimap group" group))
+ (nnimap-expunge mailbox (cadr method))))
+
+(defun gnus-group-nnimap-edit-acl (group)
+ "Edit the Access Control List of current nnimap GROUP."
+ (interactive (list (gnus-group-group-name)))
+ (let ((mailbox (gnus-group-real-name group)) method acl)
+ (unless group
+ (error "No group on current line"))
+ (unless (gnus-get-info group)
+ (error "Killed group; can't be edited"))
+ (unless (eq (car (setq method (gnus-find-method-for-group group))) 'nnimap)
+ (error "%s is not an nnimap group" group))
+ (gnus-edit-form (setq acl (nnimap-acl-get mailbox (cadr method)))
+ (format "Editing the access control list for `%s'.
+
+ An access control list is a list of (identifier . rights) elements.
+
+ The identifier string specifies the corresponding user. The
+ identifier \"anyone\" is reserved to refer to the universal identity.
+
+ Rights is a string listing a (possibly empty) set of alphanumeric
+ characters, each character listing a set of operations which is being
+ controlled. Letters are reserved for ``standard'' rights, listed
+ below. Digits are reserved for implementation or site defined rights.
+
+ l - lookup (mailbox is visible to LIST/LSUB commands)
+ r - read (SELECT the mailbox, perform CHECK, FETCH, PARTIAL,
+ SEARCH, COPY from mailbox)
+ s - keep seen/unseen information across sessions (STORE SEEN flag)
+ w - write (STORE flags other than SEEN and DELETED)
+ i - insert (perform APPEND, COPY into mailbox)
+ p - post (send mail to submission address for mailbox,
+ not enforced by IMAP4 itself)
+ c - create (CREATE new sub-mailboxes in any implementation-defined
+ hierarchy)
+ d - delete (STORE DELETED flag, perform EXPUNGE)
+ a - administer (perform SETACL)" group)
+ `(lambda (form)
+ (nnimap-acl-edit
+ ,mailbox ',method ',acl form)))))
+
;; Group sorting commands
;; Suggested by Joe Hildebrand <hildjj@idaho.fuentez.com>.
(when (eq 'nnvirtual (car method))
(nnvirtual-catchup-group
(gnus-group-real-name group) (nth 1 method) all)))
- (if (>= (gnus-info-level (gnus-get-info group))
- gnus-level-zombie)
+ (if (>= (gnus-group-level group) gnus-level-zombie)
(gnus-message 2 "Dead groups can't be caught up")
(if (prog1
(gnus-group-goto-group group)
(gnus-group-yank-group)
(gnus-group-position-point)))
-(defun gnus-group-kill-all-zombies ()
- "Kill all zombie newsgroups."
- (interactive)
- (when (gnus-yes-or-no-p "Really kill all zombies? ")
+(defun gnus-group-kill-all-zombies (&optional dummy)
+ "Kill all zombie newsgroups.
+The optional DUMMY should always be nil."
+ (interactive (list (not (gnus-yes-or-no-p "Really kill all zombies? "))))
+ (unless dummy
(setq gnus-killed-list (nconc gnus-zombie-list gnus-killed-list))
(setq gnus-zombie-list nil)
(gnus-dribble-touch)
(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)
(interactive)
;; First we make sure that we have really read the active file.
(unless (gnus-read-active-file-p)
- (let ((gnus-read-active-file t))
+ (let ((gnus-read-active-file t)
+ (gnus-agent nil)) ; Trick the agent into ignoring the active file.
(gnus-read-active-file)))
;; Find all groups and sort them.
(let ((groups
(ret (if (numberp n) (- n (length groups)) 0))
(beg (unless n
(point)))
- group method)
+ group method
+ (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)
(while (setq group (pop groups))
(gnus-group-remove-mark group)
;; Bypass any previous denials from the server.
(gnus-browse-foreign-server method))
(defun gnus-group-set-info (info &optional method-only-group part)
- (when info
+ (when (or info part)
(let* ((entry (gnus-gethash
(or method-only-group (gnus-info-group info))
gnus-newsrc-hashtb))
(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)
- (gnus-delete-alist type (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))))))
(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)))
+ (list 0 0)))
(delta (subtract-time (current-time) time)))
(+ (* (nth 0 delta) 65536.0)
(nth 1 delta))))
projects / gnus / blobdiff