;;; gnus-group.el --- group mode commands for Gnus
-;; Copyright (C) 1996,97,98,99 Free Software Foundation, Inc.
+;; Copyright (C) 1996, 1997, 1998, 1999, 2000
+;; Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
(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/"
If nil, no groups are permanently visible."
:group 'gnus-group-listing
- :type 'regexp)
+ :type '(choice regexp (const nil)))
(defcustom gnus-list-groups-with-ticked-articles t
"*If non-nil, list groups that have only ticked articles.
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)))
%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.
+%E Icon as defined by `gnus-group-icon-list'.
%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
((= 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
:group 'gnus-group-visual
:type 'character)
+(defgroup gnus-group-icons nil
+ "Add Icons to your group buffer. "
+ :group 'gnus-group-visual)
+
+(defcustom gnus-group-icon-list
+ nil
+ "*Controls the insertion of icons into group buffer lines.
+
+Below is a list of `Form'/`File' pairs. When deciding how a
+particular group line should be displayed, each form is evaluated.
+The icon from the file field after the first true form is used. You
+can change how those group lines are displayed by editing the file
+field. The File will either be found in the
+`gnus-group-glyph-directory' or by designating absolute path to the
+file.
+
+It is also possible to change and add form fields, but currently that
+requires an understanding of Lisp expressions. Hopefully this will
+change in a future release. For now, you can use the following
+variables in the Lisp expression:
+
+group: The name of the group.
+unread: The number of unread articles in the group.
+method: The select method used.
+mailp: Whether it's a mail group or not.
+newsp: Whether it's a news group or not
+level: The level of the group.
+score: The score of the group.
+ticked: The number of ticked articles."
+ :group 'gnus-group-icons
+ :type '(repeat (cons (sexp :tag "Form") file)))
+
+(defcustom gnus-group-name-charset-method-alist nil
+ "*Alist of method and the charset for group names.
+
+For example:
+ (((nntp \"news.com.cn\") . cn-gb-2312))
+"
+ :version "21.1"
+ :group 'gnus-charset
+ :type '(repeat (cons (sexp :tag "Method") (symbol :tag "Charset"))))
+
+(defcustom gnus-group-name-charset-group-alist nil
+ "*Alist of group regexp and the charset for group names.
+
+For example:
+ ((\"\\.com\\.cn:\" . cn-gb-2312))
+"
+ :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)))
+
;;; Internal variables
(defvar gnus-group-sort-alist-function 'gnus-group-sort-flat
(?s gnus-tmp-news-server ?s)
(?n gnus-tmp-news-method ?s)
(?P gnus-group-indentation ?s)
+ (?E gnus-tmp-group-icon ?s)
(?l gnus-tmp-grouplens ?s)
(?z gnus-tmp-news-method-string ?s)
(?m (gnus-group-new-mail gnus-tmp-group) ?c)
(defvar gnus-group-list-mode nil)
+
+(defvar gnus-group-icon-cache nil)
+
+(defvar gnus-group-listed-groups nil)
+(defvar gnus-group-list-option nil)
+
;;;
;;; Gnus group mode
;;;
"=" gnus-group-select-group
"\r" gnus-group-select-group
"\M-\r" gnus-group-quick-select-group
+ "\M- " gnus-group-visible-select-group
[(meta control return)] gnus-group-select-group-ephemerally
"j" gnus-group-jump-to-group
"n" gnus-group-next-unread-group
"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)
"d" gnus-group-description-apropos
"m" gnus-group-list-matching
"M" gnus-group-list-all-matching
- "l" gnus-group-list-level)
+ "l" gnus-group-list-level
+ "c" gnus-group-list-cached
+ "?" gnus-group-list-dormant)
+
+ (gnus-define-keys (gnus-group-list-limit-map "/" gnus-group-list-map)
+ "k" gnus-group-list-limit
+ "z" gnus-group-list-limit
+ "s" gnus-group-list-limit
+ "u" gnus-group-list-limit
+ "A" gnus-group-list-limit
+ "m" gnus-group-list-limit
+ "M" gnus-group-list-limit
+ "l" gnus-group-list-limit
+ "c" gnus-group-list-limit
+ "?" gnus-group-list-limit)
+
+ (gnus-define-keys (gnus-group-list-flush-map "f" gnus-group-list-map)
+ "k" gnus-group-list-flush
+ "z" gnus-group-list-flush
+ "s" gnus-group-list-flush
+ "u" gnus-group-list-flush
+ "A" gnus-group-list-flush
+ "m" gnus-group-list-flush
+ "M" gnus-group-list-flush
+ "l" gnus-group-list-flush
+ "c" gnus-group-list-flush
+ "?" gnus-group-list-flush)
+
+ (gnus-define-keys (gnus-group-list-plus-map "p" gnus-group-list-map)
+ "k" gnus-group-list-plus
+ "z" gnus-group-list-plus
+ "s" gnus-group-list-plus
+ "u" gnus-group-list-plus
+ "A" gnus-group-list-plus
+ "m" gnus-group-list-plus
+ "M" gnus-group-list-plus
+ "l" gnus-group-list-plus
+ "c" gnus-group-list-plus
+ "?" gnus-group-list-plus)
(gnus-define-keys (gnus-group-score-map "W" gnus-group-mode-map)
"f" gnus-score-flush-cache)
(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 ...)
["Group and description apropos..." gnus-group-description-apropos t]
["List groups matching..." gnus-group-list-matching t]
["List all groups matching..." gnus-group-list-all-matching t]
- ["List active file" gnus-group-list-active t])
+ ["List active file" gnus-group-list-active t]
+ ["List groups with cached" gnus-group-list-cached t]
+ ["List groups with dormant" gnus-group-list-dormant t])
("Sort"
["Default sort" gnus-group-sort-groups t]
["Sort by method" gnus-group-sort-groups-by-method t]
(easy-menu-define
gnus-group-misc-menu gnus-group-mode-map ""
- '("Misc"
+ `("Misc"
("SOUP"
["Pack replies" nnsoup-pack-replies (fboundp 'nnsoup-request-group)]
["Send replies" gnus-soup-send-replies
["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]
+ ["Check for new news" gnus-group-get-new-news
+ ,@(if (featurep 'xemacs) nil
+ '(: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) nil
+ '(: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")
(when gnus-carpal
(gnus-carpal-setup-buffer 'group))))
+(defsubst gnus-group-name-charset (method group)
+ (if (null method)
+ (setq method (gnus-find-method-for-group group)))
+ (let ((item (assoc method gnus-group-name-charset-method-alist))
+ (alist gnus-group-name-charset-group-alist)
+ result)
+ (if item
+ (cdr item)
+ (while (setq item (pop alist))
+ (if (string-match (car item) group)
+ (setq alist nil
+ result (cdr item))))
+ result)))
+
+(defsubst gnus-group-name-decode (string charset)
+ (if (and string charset (featurep 'mule))
+ (mm-decode-coding-string string charset)
+ string))
+
+(defun gnus-group-decoded-name (string)
+ (let ((charset (gnus-group-name-charset nil string)))
+ (gnus-group-name-decode string charset)))
+
(defun gnus-group-list-groups (&optional level unread lowest)
"List newsgroups with level LEVEL or lower that have unread articles.
Default is all subscribed groups.
(interactive "nList groups on level: \nP")
(gnus-group-list-groups level all level))
-(defun gnus-group-prepare-flat (level &optional all lowest regexp)
+(defun gnus-group-prepare-logic (group test)
+ (or (and gnus-group-listed-groups
+ (null gnus-group-list-option)
+ (member group gnus-group-listed-groups))
+ (cond
+ ((null gnus-group-listed-groups) test)
+ ((null gnus-group-list-option) test)
+ (t (and (member group gnus-group-listed-groups)
+ (if (eq gnus-group-list-option 'flush)
+ (not test)
+ test))))))
+
+(defun gnus-group-prepare-flat (level &optional predicate lowest regexp)
"List all newsgroups with unread articles of level LEVEL or lower.
-If ALL is non-nil, list groups that have no unread articles.
+If PREDICATE is a function, list groups that the function returns non-nil;
+if it is t, list groups that have no unread articles.
If LOWEST is non-nil, list all newsgroups of level LOWEST or higher.
-If REGEXP, only list groups matching REGEXP."
+If REGEXP is a function, list dead groups that the function returns non-nil;
+if it is a string, only list groups matching REGEXP."
(set-buffer gnus-group-buffer)
(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 (< lowest gnus-level-zombie)
+ (when (or (< lowest gnus-level-zombie)
+ gnus-group-listed-groups)
;; List living groups.
(while newsrc
(setq info (car newsrc)
params (gnus-info-params info)
newsrc (cdr newsrc)
unread (car (gnus-gethash group gnus-newsrc-hashtb)))
- (and unread ; This group might be bogus
- (or (not regexp)
- (string-match regexp group))
- (<= (setq clevel (gnus-info-level info)) level)
- (>= clevel lowest)
- (or all ; We list all groups?
- (if (eq unread t) ; 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))))
+ (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))
+ (string-match regexp group))
+ (<= (setq clevel (gnus-info-level info)) level)
+ (>= clevel lowest)
+ (cond
+ ((functionp predicate)
+ (funcall predicate info))
+ (predicate t) ; We list all groups?
+ (t
+ (or
+ (if (eq unread t) ; 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))))
; And groups with tickeds
- ;; Check for permanent visibility.
- (and gnus-permanently-visible-groups
- (string-match gnus-permanently-visible-groups
- group))
- (memq 'visible params)
- (cdr (assq 'visible params)))
- (gnus-group-insert-group-line
- group (gnus-info-level info)
- (gnus-info-marks info) unread (gnus-info-method info)))))
-
+ ;; Check for permanent visibility.
+ (and gnus-permanently-visible-groups
+ (string-match gnus-permanently-visible-groups group))
+ (memq 'visible params)
+ (cdr (assq 'visible params)))))))
+ (gnus-group-insert-group-line
+ group (gnus-info-level info)
+ (gnus-info-marks info) unread (gnus-info-method info)))))
+
;; List dead groups.
- (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))
- (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-level-killed ?K regexp))
+ (if (or gnus-group-listed-groups
+ (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
+ (gnus-union
+ not-in-list
+ (setq gnus-killed-list (sort gnus-killed-list 'string<)))
+ gnus-level-killed ?K regexp))
(gnus-group-set-mode-line)
- (setq gnus-group-list-mode (cons level all))
+ (setq gnus-group-list-mode (cons level predicate))
(gnus-run-hooks 'gnus-group-prepare-hook)
t))
;; suggested by Jack Vinson <vinson@unagi.cis.upenn.edu>. It does
;; this by ignoring the group format specification altogether.
(let (group)
- (if regexp
- ;; This loop is used when listing groups that match some
- ;; regexp.
- (while groups
- (setq group (pop groups))
- (when (string-match regexp group)
- (gnus-add-text-properties
- (point) (prog1 (1+ (point))
- (insert " " mark " *: " group "\n"))
- (list 'gnus-group (gnus-intern-safe group gnus-active-hashtb)
- 'gnus-unread t
- 'gnus-level level))))
- ;; This loop is used when listing all groups.
- (while groups
- (gnus-add-text-properties
- (point) (prog1 (1+ (point))
- (insert " " mark " *: "
- (setq group (pop groups)) "\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-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))
+ (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
&
projects / gnus / blobdiff