;;; gnus-group.el --- group mode commands for Gnus
-;; Copyright (C) 1996, 1997, 1998, 1999, 2000
+;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001
;; Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
(require 'gnus-win)
(require 'gnus-undo)
(require 'time-date)
+(require 'gnus-ems)
(defcustom gnus-group-archive-directory
"*ftp@ftp.hpc.uh.edu:/pub/emacs/ding-list/"
for the groups to be sorted. Pre-made functions include
`gnus-group-sort-by-alphabet', `gnus-group-sort-by-real-name',
`gnus-group-sort-by-unread', `gnus-group-sort-by-level',
-`gnus-group-sort-by-score', `gnus-group-sort-by-method', and
-`gnus-group-sort-by-rank'.
+`gnus-group-sort-by-score', `gnus-group-sort-by-method',
+`gnus-group-sort-by-server', and `gnus-group-sort-by-rank'.
This variable can also be a list of sorting functions. In that case,
the most significant sort function should be the last function in the
(function-item gnus-group-sort-by-level)
(function-item gnus-group-sort-by-score)
(function-item gnus-group-sort-by-method)
+ (function-item gnus-group-sort-by-server)
(function-item gnus-group-sort-by-rank)
(function :tag "other" nil)))
:options '(gnus-topic-mode)
:type 'hook)
+;; Extracted from gnus-xmas-redefine in order to preserve user settings
+(when (featurep 'xemacs)
+ (add-hook 'gnus-group-mode-hook 'gnus-xmas-group-menu-add)
+ (add-hook 'gnus-group-mode-hook 'gnus-xmas-setup-group-toolbar))
+
(defcustom gnus-group-menu-hook nil
"Hook run after the creation of the group mode menu."
:group 'gnus-group-various
(sexp :tag "Method"))))
(defcustom gnus-group-highlight
- '(;; News.
- ((and (= unread 0) (not mailp) (eq level 1)) .
+ '(;; Mail.
+ ((and mailp (= unread 0) (eq level 1)) .
+ gnus-group-mail-1-empty-face)
+ ((and mailp (eq level 1)) .
+ gnus-group-mail-1-face)
+ ((and mailp (= unread 0) (eq level 2)) .
+ gnus-group-mail-2-empty-face)
+ ((and mailp (eq level 2)) .
+ gnus-group-mail-2-face)
+ ((and mailp (= unread 0) (eq level 3)) .
+ gnus-group-mail-3-empty-face)
+ ((and mailp (eq level 3)) .
+ gnus-group-mail-3-face)
+ ((and mailp (= unread 0)) .
+ gnus-group-mail-low-empty-face)
+ ((and mailp) .
+ gnus-group-mail-low-face)
+ ;; News.
+ ((and (= unread 0) (eq level 1)) .
gnus-group-news-1-empty-face)
- ((and (not mailp) (eq level 1)) .
+ ((and (eq level 1)) .
gnus-group-news-1-face)
- ((and (= unread 0) (not mailp) (eq level 2)) .
+ ((and (= unread 0) (eq level 2)) .
gnus-group-news-2-empty-face)
- ((and (not mailp) (eq level 2)) .
+ ((and (eq level 2)) .
gnus-group-news-2-face)
- ((and (= unread 0) (not mailp) (eq level 3)) .
+ ((and (= unread 0) (eq level 3)) .
gnus-group-news-3-empty-face)
- ((and (not mailp) (eq level 3)) .
+ ((and (eq level 3)) .
gnus-group-news-3-face)
- ((and (= unread 0) (not mailp) (eq level 4)) .
+ ((and (= unread 0) (eq level 4)) .
gnus-group-news-4-empty-face)
- ((and (not mailp) (eq level 4)) .
+ ((and (eq level 4)) .
gnus-group-news-4-face)
- ((and (= unread 0) (not mailp) (eq level 5)) .
+ ((and (= unread 0) (eq level 5)) .
gnus-group-news-5-empty-face)
- ((and (not mailp) (eq level 5)) .
+ ((and (eq level 5)) .
gnus-group-news-5-face)
- ((and (= unread 0) (not mailp) (eq level 6)) .
+ ((and (= unread 0) (eq level 6)) .
gnus-group-news-6-empty-face)
- ((and (not mailp) (eq level 6)) .
+ ((and (eq level 6)) .
gnus-group-news-6-face)
- ((and (= unread 0) (not mailp)) .
+ ((and (= unread 0)) .
gnus-group-news-low-empty-face)
- ((and (not mailp)) .
- gnus-group-news-low-face)
- ;; Mail.
- ((and (= unread 0) (eq level 1)) .
- gnus-group-mail-1-empty-face)
- ((eq level 1) .
- gnus-group-mail-1-face)
- ((and (= unread 0) (eq level 2)) .
- gnus-group-mail-2-empty-face)
- ((eq level 2) .
- gnus-group-mail-2-face)
- ((and (= unread 0) (eq level 3)) .
- gnus-group-mail-3-empty-face)
- ((eq level 3) .
- gnus-group-mail-3-face)
- ((= unread 0) .
- gnus-group-mail-low-empty-face)
(t .
- gnus-group-mail-low-face))
+ gnus-group-news-low-face))
"*Controls the highlighting of group buffer lines.
Below is a list of `Form'/`Face' pairs. When deciding how a a
For example:
(((nntp \"news.com.cn\") . cn-gb-2312))
"
+ :version "21.1"
:group 'gnus-charset
:type '(repeat (cons (sexp :tag "Method") (symbol :tag "Charset"))))
:group 'gnus-charset
:type '(repeat (cons (regexp :tag "Group") (symbol :tag "Charset"))))
+(defcustom gnus-group-jump-to-group-prompt nil
+ "Default prompt for `gnus-group-jump-to-group'.
+If non-nil, the value should be a string, e.g. \"nnml:\",
+in which case `gnus-group-jump-to-group' offers \"Group: nnml:\"
+in the minibuffer prompt."
+ :group 'gnus-group-various
+ :type '(choice (string :tag "Prompt string")
+ (const :tag "Empty" nil)))
+
+(defvar gnus-group-listing-limit 1000
+ "*A limit of the number of groups when listing.
+If the number of groups is larger than the limit, list them in a
+simple manner.")
+
;;; Internal variables
(defvar gnus-group-sort-alist-function 'gnus-group-sort-flat
(easy-menu-define
gnus-group-reading-menu gnus-group-mode-map ""
- '("Group"
+ `("Group"
["Read" gnus-group-read-group (gnus-group-group-name)]
["Select" gnus-group-select-group (gnus-group-group-name)]
["See old articles" (gnus-group-select-group 'all)
:keys "C-u SPC" :active (gnus-group-group-name)]
- ["Catch up" gnus-group-catchup-current (gnus-group-group-name)]
+ ["Catch up" gnus-group-catchup-current :active (gnus-group-group-name)
+ ,@(if (featurep 'xemacs) nil
+ '(:help "Mark unread articles in the current group as read"))]
["Catch up all articles" gnus-group-catchup-current-all
(gnus-group-group-name)]
["Check for new articles" gnus-group-get-new-news-this-group
- (gnus-group-group-name)]
+ :active (gnus-group-group-name)
+ ,@(if (featurep 'xemacs) nil
+ '(:help "Check for new messages in current group"))]
["Toggle subscription" gnus-group-unsubscribe-current-group
(gnus-group-group-name)]
- ["Kill" gnus-group-kill-group (gnus-group-group-name)]
+ ["Kill" gnus-group-kill-group :active (gnus-group-group-name)
+ ,@(if (featurep 'xemacs) nil
+ '(:help "Kill (remove) current group"))]
["Yank" gnus-group-yank-group gnus-list-of-killed-groups]
- ["Describe" gnus-group-describe-group (gnus-group-group-name)]
+ ["Describe" gnus-group-describe-group :active (gnus-group-group-name)
+ ,@(if (featurep 'xemacs) nil
+ '(:help "Display description of the current group"))]
["Fetch FAQ" gnus-group-fetch-faq (gnus-group-group-name)]
;; Actually one should check, if any of the marked groups gives t for
;; (gnus-check-backend-function 'request-expire-articles ...)
(easy-menu-define
gnus-group-misc-menu gnus-group-mode-map ""
- '("Misc"
+ `("Gnus"
("SOUP"
["Pack replies" nnsoup-pack-replies (fboundp 'nnsoup-request-group)]
["Send replies" gnus-soup-send-replies
["Brew SOUP" gnus-group-brew-soup (fboundp 'gnus-soup-pack-packet)])
["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
+ ,@(if (featurep 'xemacs) '(t)
+ '(:help "Get newly arrived articles"))
+ ]
["Activate all groups" gnus-activate-all-groups t]
["Restart Gnus" gnus-group-restart t]
["Read init file" gnus-group-read-init-file 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 from Gnus" gnus-group-exit
+ ,@(if (featurep 'xemacs) '(t)
+ '(:help "Quit reading news"))]
["Exit without saving" gnus-group-quit t]))
(gnus-run-hooks 'gnus-group-menu-hook)))
+(defvar gnus-group-toolbar-map nil)
+
+;; Emacs 21 tool bar. Should be no-op otherwise.
+(defun gnus-group-make-tool-bar ()
+ (if (and (fboundp 'tool-bar-add-item-from-menu)
+ (default-value 'tool-bar-mode)
+ (not gnus-group-toolbar-map))
+ (setq gnus-group-toolbar-map
+ (let ((tool-bar-map (make-sparse-keymap))
+ (load-path (mm-image-load-path)))
+ (tool-bar-add-item-from-menu
+ 'gnus-group-get-new-news "get-news" gnus-group-mode-map)
+ (tool-bar-add-item-from-menu
+ 'gnus-group-get-new-news-this-group "gnntg" gnus-group-mode-map)
+ (tool-bar-add-item-from-menu
+ 'gnus-group-catchup-current "catchup" gnus-group-mode-map)
+ (tool-bar-add-item-from-menu
+ 'gnus-group-describe-group "describe-group" gnus-group-mode-map)
+ (tool-bar-add-item "subscribe" 'gnus-group-subscribe 'subscribe
+ :help "Subscribe to the current group")
+ (tool-bar-add-item "unsubscribe" 'gnus-group-unsubscribe
+ 'unsubscribe
+ :help "Unsubscribe from the current group")
+ (tool-bar-add-item-from-menu
+ 'gnus-group-exit "exit-gnus" gnus-group-mode-map)
+ tool-bar-map)))
+ (if gnus-group-toolbar-map
+ (set (make-local-variable 'tool-bar-map) gnus-group-toolbar-map)))
+
(defun gnus-group-mode ()
"Major mode for reading news.
\\{gnus-group-mode-map}"
(interactive)
- (when (gnus-visual-p 'group-menu 'menu)
- (gnus-group-make-menu-bar))
(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")
(defun gnus-update-group-mark-positions ()
(save-excursion
(let ((gnus-process-mark ?\200)
+ (gnus-group-update-hook nil)
(gnus-group-marked '("dummy.group"))
(gnus-active-hashtb (make-vector 10 0))
(topic ""))
(let ((item (assoc method gnus-group-name-charset-method-alist))
(alist gnus-group-name-charset-group-alist)
result)
- (if item
+ (if item
(cdr item)
(while (setq item (pop alist))
(if (string-match (car item) group)
(or (and gnus-group-listed-groups
(null gnus-group-list-option)
(member group gnus-group-listed-groups))
- (cond
+ (cond
((null gnus-group-listed-groups) test)
((null gnus-group-list-option) test)
(t (and (member group gnus-group-listed-groups)
(let ((buffer-read-only nil)
(newsrc (cdr gnus-newsrc-alist))
(lowest (or lowest 1))
+ (not-in-list (and gnus-group-listed-groups
+ (copy-sequence gnus-group-listed-groups)))
info clevel unread group params)
(erase-buffer)
(when (or (< lowest gnus-level-zombie)
params (gnus-info-params info)
newsrc (cdr newsrc)
unread (car (gnus-gethash group gnus-newsrc-hashtb)))
- (and
- (gnus-group-prepare-logic
+ (if not-in-list
+ (setq not-in-list (delete group not-in-list)))
+ (and
+ (gnus-group-prepare-logic
group
(and unread ; This group might be unchecked
(or (not (stringp regexp))
(t
(or
(if (eq unread t) ; Unactivated?
- gnus-group-list-inactive-groups
+ gnus-group-list-inactive-groups
; We list unactivated
- (> unread 0))
+ (> unread 0))
; We list groups with unread articles
(and gnus-list-groups-with-ticked-articles
(cdr (assq 'tick (gnus-info-marks info))))
(gnus-group-insert-group-line
group (gnus-info-level info)
(gnus-info-marks info) unread (gnus-info-method info)))))
-
+
;; List dead groups.
(if (or gnus-group-listed-groups
- (and (>= level gnus-level-zombie)
+ (and (>= level gnus-level-zombie)
(<= lowest gnus-level-zombie)))
(gnus-group-prepare-flat-list-dead
(setq gnus-zombie-list (sort gnus-zombie-list 'string<))
gnus-level-zombie ?Z
regexp))
+ (if not-in-list
+ (dolist (group gnus-zombie-list)
+ (setq not-in-list (delete group not-in-list))))
(if (or gnus-group-listed-groups
(and (>= level gnus-level-killed) (<= lowest gnus-level-killed)))
(gnus-group-prepare-flat-list-dead
- (setq gnus-killed-list (sort gnus-killed-list 'string<))
+ (gnus-union
+ not-in-list
+ (setq gnus-killed-list (sort gnus-killed-list 'string<)))
gnus-level-killed ?K regexp))
(gnus-group-set-mode-line)
;; suggested by Jack Vinson <vinson@unagi.cis.upenn.edu>. It does
;; this by ignoring the group format specification altogether.
(let (group)
- (while groups
- (setq group (pop groups))
- (when (gnus-group-prepare-logic
- group
- (or (not regexp)
- (and (stringp regexp) (string-match regexp group))
- (and (functionp regexp) (funcall regexp group))))
- (gnus-add-text-properties
- (point) (prog1 (1+ (point))
- (insert " " mark " *: "
- (gnus-group-name-decode group
- (gnus-group-name-charset
- nil group))
- "\n"))
- (list 'gnus-group (gnus-intern-safe group gnus-active-hashtb)
- 'gnus-unread t
- 'gnus-level level))))))
+ (if (> (length groups) gnus-group-listing-limit)
+ (while groups
+ (setq group (pop groups))
+ (when (gnus-group-prepare-logic
+ group
+ (or (not regexp)
+ (and (stringp regexp) (string-match regexp group))
+ (and (functionp regexp) (funcall regexp group))))
+ (gnus-add-text-properties
+ (point) (prog1 (1+ (point))
+ (insert " " mark " *: "
+ (gnus-group-decoded-name group)
+ "\n"))
+ (list 'gnus-group (gnus-intern-safe group gnus-active-hashtb)
+ 'gnus-unread t
+ 'gnus-level level))))
+ (while groups
+ (setq group (pop groups))
+ (when (gnus-group-prepare-logic
+ group
+ (or (not regexp)
+ (and (stringp regexp) (string-match regexp group))
+ (and (functionp regexp) (funcall regexp group))))
+ (gnus-group-insert-group-line
+ group level nil
+ (let ((active (gnus-active group)))
+ (if active
+ (if (zerop (cdr active))
+ 0
+ (- (1+ (cdr active)) (car active)))
+ nil))
+ (gnus-method-simplify (gnus-find-method-for-group group))))))))
(defun gnus-group-update-group-line ()
"Update the current line in the group buffer."
0
(- (1+ (cdr active)) (car active)))
nil)
- nil))))
+ (gnus-method-simplify (gnus-find-method-for-group group))))))
(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."
(let* ((gnus-tmp-method
- (gnus-server-get-method gnus-tmp-group gnus-tmp-method))
+ (gnus-server-get-method gnus-tmp-group gnus-tmp-method))
(group-name-charset (gnus-group-name-charset gnus-tmp-method
gnus-tmp-group))
(gnus-tmp-active (gnus-active gnus-tmp-group))
((<= gnus-tmp-level gnus-level-unsubscribed) ?U)
((= gnus-tmp-level gnus-level-zombie) ?Z)
(t ?K)))
- (gnus-tmp-qualified-group
+ (gnus-tmp-qualified-group
(gnus-group-name-decode (gnus-group-real-name gnus-tmp-group)
group-name-charset))
(gnus-tmp-newsgroup-description
(if gnus-description-hashtb
(or (gnus-group-name-decode
- (gnus-gethash gnus-tmp-group gnus-description-hashtb)
+ (gnus-gethash gnus-tmp-group gnus-description-hashtb)
group-name-charset) "")
""))
(gnus-tmp-moderated
(info (nth 2 entry))
(method (gnus-server-get-method group (gnus-info-method info)))
(marked (gnus-info-marks info))
- (mailp (memq 'mail (assoc (symbol-name
- (car (or method gnus-select-method)))
- gnus-valid-select-methods)))
+ (mailp (apply 'append
+ (mapcar
+ (lambda (x)
+ (memq x (assoc (symbol-name
+ (car (or method gnus-select-method)))
+ gnus-valid-select-methods)))
+ '(mail post-mail))))
(level (or (gnus-info-level info) gnus-level-killed))
(score (or (gnus-info-score info) 0))
(ticked (gnus-range-length (cdr (assq 'tick marked))))
(defun gnus-group-select-group (&optional all)
"Select this newsgroup.
No article is selected automatically.
+If the group is opened, just switch the summary buffer.
If ALL is non-nil, already read articles become readable.
If ALL is a number, fetch this number of articles."
(interactive "P")
(list (completing-read
"Group: " gnus-active-hashtb nil
(gnus-read-active-file-p)
- nil
+ gnus-group-jump-to-group-prompt
'gnus-group-history)))
(when (equal group "")
(test-marked
(goto-char (point-min))
(let (found)
- (while (and (not found)
+ (while (and (not found)
(gnus-goto-char
(text-property-any
(point) (point-max)
- 'gnus-group
+ 'gnus-group
(gnus-intern-safe group gnus-active-hashtb))))
(if (gnus-group-mark-line-p)
(setq found t)
(t "group info"))
(gnus-group-decoded-name group))
`(lambda (form)
- (gnus-group-edit-group-done ',part ,group form)))))
+ (gnus-group-edit-group-done ',part ,group form)))
+ (local-set-key
+ "\C-c\C-i"
+ (gnus-create-info-command
+ (cond
+ ((eq part 'method)
+ "(gnus)Select Methods")
+ ((eq part 'params)
+ "(gnus)Group Parameters")
+ (t
+ "(gnus)Group Info"))))))
(defun gnus-group-edit-group-method (group)
"Edit the select method of GROUP."
default-login 'gnus-group-warchive-login-history)
user-mail-address))
(method
- `(nnwarchive ,address
+ `(nnwarchive ,address
(nnwarchive-type ,(intern type))
(nnwarchive-login ,login))))
(gnus-group-make-group group method)))
(while (or (not group) (gnus-gethash group gnus-newsrc-hashtb))
(setq group
(gnus-group-prefixed-name
- (concat (file-name-as-directory (directory-file-name dir))
- ext)
+ (expand-file-name ext dir)
'(nndir "")))
(setq ext (format "<%d>" (setq i (1+ i)))))
(gnus-group-make-group
(gnus-group-real-name group)
(list 'nndir (gnus-group-real-name group) (list 'nndir-directory dir)))))
+(eval-when-compile (defvar nnkiboze-score-file))
(defun gnus-group-make-kiboze-group (group address scores)
"Create an nnkiboze group.
The user will be prompted for a name, a regexp to match groups, and
(interactive "P")
(gnus-group-sort-groups 'gnus-group-sort-by-method reverse))
+(defun gnus-group-sort-groups-by-server (&optional reverse)
+ "Sort the group buffer alphabetically by server name.
+If REVERSE, sort in reverse order."
+ (interactive "P")
+ (gnus-group-sort-groups 'gnus-group-sort-by-server reverse))
+
;;; Selected group sorting.
(defun gnus-group-sort-selected-groups (n func &optional reverse)
(symbol-name (car (gnus-find-method-for-group
(gnus-info-group info2) info2)))))
+(defun gnus-group-sort-by-server (info1 info2)
+ "Sort alphabetically by server name."
+ (string< (gnus-method-to-server-name
+ (gnus-find-method-for-group
+ (gnus-info-group info1) info1))
+ (gnus-method-to-server-name
+ (gnus-find-method-for-group
+ (gnus-info-group info2) info2))))
+
(defun gnus-group-sort-by-score (info1 info2)
"Sort by group score."
- (< (gnus-info-score info1) (gnus-info-score info2)))
+ (> (gnus-info-score info1) (gnus-info-score info2)))
(defun gnus-group-sort-by-rank (info1 info2)
"Sort by level and score."
(defun gnus-info-clear-data (info)
"Clear all marks and read ranges from INFO."
- (let ((group (gnus-info-group info)))
+ (let ((group (gnus-info-group info))
+ action)
+ (dolist (el (gnus-info-marks info))
+ (push `(,(cdr el) add (,(car el))) action))
+ (push `(,(gnus-info-read info) add (read)) action)
(gnus-undo-register
`(progn
+ (gnus-request-set-mark ,group ',action)
(gnus-info-set-marks ',info ',(gnus-info-marks info) t)
(gnus-info-set-read ',info ',(gnus-info-read info))
(when (gnus-group-goto-group ,group)
+ (gnus-get-unread-articles-in-group ',info ',(gnus-active group) t)
(gnus-group-update-group-line))))
+ (setq action (mapcar (lambda (el) (list (nth 0 el) 'del (nth 2 el)))
+ action))
+ (gnus-request-set-mark group action)
(gnus-info-set-read info nil)
(when (gnus-info-marks info)
(gnus-info-set-marks info nil))))
(gnus-add-text-properties
(point) (prog1 (1+ (point))
(insert " *: "
- (gnus-group-name-decode group
- (gnus-group-name-charset
- nil group))
+ (gnus-group-decoded-name group)
"\n"))
(list 'gnus-group (gnus-intern-safe group gnus-active-hashtb)
'gnus-unread t
(when current-prefix-arg
(completing-read
"Faq dir: " (and (listp gnus-group-faq-directory)
- (mapcar (lambda (file) (list file))
+ (mapcar #'list
gnus-group-faq-directory))))))
(unless group
(error "No group name given"))
(while (and (not found)
(setq dir (pop dirs)))
(let ((name (gnus-group-real-name group)))
- (setq file (concat (file-name-as-directory dir) name)))
+ (setq file (expand-file-name name dir)))
(if (not (file-exists-p file))
(gnus-message 1 "No such file: %s" file)
(let ((enable-local-variables nil))
(lambda (group)
(setq b (point))
(let ((charset (gnus-group-name-charset nil (symbol-name group))))
- (insert (format " *: %-20s %s\n"
+ (insert (format " *: %-20s %s\n"
(gnus-group-name-decode
(symbol-name group) charset)
(gnus-group-name-decode
The hook gnus-suspend-gnus-hook is called before actually suspending."
(interactive)
(gnus-run-hooks 'gnus-suspend-gnus-hook)
+ (gnus-offer-save-summaries)
;; Kill Gnus buffers except for group mode buffer.
(let ((group-buf (get-buffer gnus-group-buffer)))
(mapcar (lambda (buf)
(unless (member buf (list group-buf gnus-dribble-buffer))
- (kill-buffer buf)))
+ (gnus-kill-buffer buf)))
(gnus-buffers))
(gnus-kill-gnus-frames)
(when group-buf
(file-name-nondirectory gnus-current-startup-file))))
(gnus-run-hooks 'gnus-exit-gnus-hook)
(gnus-configure-windows 'group t)
+ (when (and (gnus-buffer-live-p gnus-dribble-buffer)
+ (not (zerop (save-excursion
+ (set-buffer gnus-dribble-buffer)
+ (buffer-size)))))
+ (gnus-dribble-enter
+ ";;; Gnus was exited on purpose without saving the .newsrc files."))
(gnus-dribble-save)
(gnus-close-backends)
(gnus-clear-system)
(setcar (nthcdr 2 entry) info)
(when (and (not (eq (car entry) t))
(gnus-active (gnus-info-group info)))
- (setcar entry (length (gnus-list-of-unread-articles (car info))))))
+ (setcar entry (length
+ (gnus-list-of-unread-articles (car info))))))
(error "No such group: %s" (gnus-info-group info))))))
(defun gnus-group-set-method-info (group select-method)
(sort (nconc (gnus-uncompress-range (cdr m))
(copy-sequence articles)) '<) t))))))
+(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)))
+ (if (gnus-buffer-live-p buffer)
+ (save-excursion
+ (set-buffer (get-buffer buffer))
+ (gnus-summary-add-mark article mark))
+ (gnus-add-marked-articles group (cdr (assq mark gnus-article-mark-lists))
+ (list article)))))
+
;;;
;;; Group timestamps
;;;
"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 (subtract-time (current-time) time)))
+ (delta (subtract-time (current-time) time)))
(+ (* (nth 0 delta) 65536.0)
(nth 1 delta))))
(setq level (prefix-numeric-value level)))
(when (or (not level) (>= level gnus-level-zombie))
(gnus-cache-open))
- (funcall gnus-group-prepare-function
+ (funcall gnus-group-prepare-function
(or level gnus-level-subscribed)
#'(lambda (info)
(let ((marks (gnus-info-marks info)))
(assq 'cache marks)))
lowest
#'(lambda (group)
- (or (gnus-gethash group
+ (or (gnus-gethash group
gnus-cache-active-hashtb)
- ;; Cache active file might use "."
+ ;; Cache active file might use "."
;; instead of ":".
- (gnus-gethash
+ (gnus-gethash
(mapconcat 'identity
(split-string group ":")
".")
(setq level (prefix-numeric-value level)))
(when (or (not level) (>= level gnus-level-zombie))
(gnus-cache-open))
- (funcall gnus-group-prepare-function
+ (funcall gnus-group-prepare-function
(or level gnus-level-subscribed)
#'(lambda (info)
(let ((marks (gnus-info-marks info)))
"Return a list of listed groups."
(let (point groups)
(goto-char (point-min))
- (while (setq point (text-property-not-all (point) (point-max)
+ (while (setq point (text-property-not-all (point) (point-max)
'gnus-group nil))
(goto-char point)
(push (symbol-name (get-text-property point 'gnus-group)) groups)
(let ((gnus-group-list-option 'limit))
(gnus-group-list-plus args)))
+(defun gnus-group-mark-article-read (group article)
+ "Mark ARTICLE read."
+ (gnus-activate-group group)
+ (let ((buffer (gnus-summary-buffer-name group))
+ (mark gnus-read-mark))
+ (unless
+ (and
+ (get-buffer buffer)
+ (with-current-buffer buffer
+ (when gnus-newsgroup-prepared
+ (when (and gnus-newsgroup-auto-expire
+ (memq mark gnus-auto-expirable-marks))
+ (setq mark gnus-expirable-mark))
+ (setq mark (gnus-request-update-mark
+ group article mark))
+ (gnus-mark-article-as-read article mark)
+ (setq gnus-newsgroup-active (gnus-active group))
+ t)))
+ (gnus-group-make-articles-read group
+ (list article))
+ (when (gnus-group-auto-expirable-p group)
+ (gnus-add-marked-articles
+ group 'expire (list article))))))
+
(provide 'gnus-group)
;;; gnus-group.el ends here
projects / gnus / blobdiff