;;; gnus-group.el --- group mode commands for Gnus
-;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001
+;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003
;; Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;;; Code:
-(eval-when-compile (require 'cl))
+(eval-when-compile
+ (require 'cl)
+ (defvar tool-bar-map))
(require 'gnus)
(require 'gnus-start)
(require 'time-date)
(require 'gnus-ems)
+(eval-when-compile (require 'mm-url))
+
(defcustom gnus-group-archive-directory
"*ftp@ftp.hpc.uh.edu:/pub/emacs/ding-list/"
"*The address of the (ding) archives."
list."
:group 'gnus-group-listing
:link '(custom-manual "(gnus)Sorting Groups")
- :type '(radio (function-item gnus-group-sort-by-alphabet)
- (function-item gnus-group-sort-by-real-name)
- (function-item gnus-group-sort-by-unread)
- (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)))
-
-(defcustom gnus-group-line-format "%M\%S\%p\%P\%5y: %(%g%)%l\n"
+ :type '(repeat :value-to-internal (lambda (widget value)
+ (if (listp value) value (list value)))
+ :match (lambda (widget value)
+ (or (symbolp value)
+ (widget-editable-list-match widget value)))
+ (choice (function-item gnus-group-sort-by-alphabet)
+ (function-item gnus-group-sort-by-real-name)
+ (function-item gnus-group-sort-by-unread)
+ (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))))
+
+(defcustom gnus-group-line-format "%M\%S\%p\%P\%5y:%B%(%g%)%l %O\n"
"*Format of group lines.
It works along the same lines as a normal formatting string,
with some simple extensions.
%i Number of ticked and dormant (integer)
%T Number of ticked articles (integer)
%R Number of read articles (integer)
+%U Number of unseen articles (integer)
%t Estimated total number of articles (integer)
%y Number of unread, unticked articles (integer)
%G Group name (string)
%g Qualified group name (string)
+%c Short (collapsed) group name. See `gnus-group-uncollapsed-levels'.
+%C Group comment (string)
%D Group description (string)
%s Select method (string)
%o Moderated group (char, \"m\")
%p Process mark (char)
+%B Whether a summary buffer for the group is open (char, \"*\")
%O Moderated group (string, \"(m)\" or \"\")
%P Topic indentation (string)
%m Whether there is new(ish) mail in the group (char, \"%\")
%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
- current header as argument. The function should return a string, which
- will be inserted into the buffer just like information from any other
- group specifier.
-
-Text between %( and %) will be highlighted with `gnus-mouse-face' when
-the mouse point move inside the area. There can only be one such area.
+ where X is the letter following %u. The function will be passed a
+ single dummy parameter as argument. The function should return a
+ string, which will be inserted into the buffer just like information
+ from any other group specifier.
Note that this format specification is not always respected. For
reasons of efficiency, when listing killed groups, this specification
a bit of extra memory will be used. %D will also worsen performance.
Also note that if you change the format specification to include any
of these specs, you must probably re-start Gnus to see them go into
-effect."
+effect.
+
+General format specifiers can also be used.
+See Info node `(gnus)Formatting Variables'."
+ :link '(custom-manual "(gnus)Formatting Variables")
:group 'gnus-group-visual
:type 'string)
:group 'gnus-group-visual
:type 'string)
-(defcustom gnus-group-mode-hook nil
- "Hook for Gnus group mode."
- :group 'gnus-group-various
- :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)
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
+`gnus-group-glyph-directory' or by designating absolute name of the
file.
It is also possible to change and add form fields, but currently that
:type '(repeat (cons (sexp :tag "Form") file)))
(defcustom gnus-group-name-charset-method-alist nil
- "*Alist of method and the charset for group names.
+ "Alist of method and the charset for group names.
For example:
- (((nntp \"news.com.cn\") . cn-gb-2312))
-"
+ (((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.
+(defcustom gnus-group-name-charset-group-alist
+ (if (or (and (fboundp 'find-coding-system) (find-coding-system 'utf-8))
+ (mm-coding-system-p 'utf-8))
+ '((".*" . utf-8))
+ nil)
+ "Alist of group regexp and the charset for group names.
For example:
- ((\"\\.com\\.cn:\" . cn-gb-2312))
-"
+ ((\"\\.com\\.cn:\" . cn-gb-2312))"
:group 'gnus-charset
:type '(repeat (cons (regexp :tag "Group") (symbol :tag "Charset"))))
;;; Internal variables
+(defvar gnus-group-is-exiting-p nil)
+(defvar gnus-group-is-exiting-without-update-p nil)
(defvar gnus-group-sort-alist-function 'gnus-group-sort-flat
"Function for sorting the group buffer.")
(gnus-range-length (cdr (assq 'tick gnus-tmp-marked))))))
(t number)) ?s)
(?R gnus-tmp-number-of-read ?s)
+ (?U (gnus-number-of-unseen-articles-in-group gnus-tmp-group) ?d)
(?t gnus-tmp-number-total ?d)
(?y gnus-tmp-number-of-unread ?s)
(?I (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked))) ?d)
(?g gnus-tmp-group ?s)
(?G gnus-tmp-qualified-group ?s)
(?c (gnus-short-group-name gnus-tmp-group) ?s)
+ (?C gnus-tmp-comment ?s)
(?D gnus-tmp-newsgroup-description ?s)
(?o gnus-tmp-moderated ?c)
(?O gnus-tmp-moderated-string ?s)
(?n gnus-tmp-news-method ?s)
(?P gnus-group-indentation ?s)
(?E gnus-tmp-group-icon ?s)
+ (?B gnus-tmp-summary-live ?c)
(?l gnus-tmp-grouplens ?s)
(?z gnus-tmp-news-method-string ?s)
(?m (gnus-group-new-mail gnus-tmp-group) ?c)
"l" gnus-group-list-groups
"L" gnus-group-list-all-groups
"m" gnus-group-mail
+ "i" gnus-group-news
"g" gnus-group-get-new-news
"\M-g" gnus-group-get-new-news-this-group
"R" gnus-group-restart
"r" gnus-group-mark-regexp
"U" gnus-group-unmark-all-groups)
+ (gnus-define-keys (gnus-group-sieve-map "D" gnus-group-mode-map)
+ "u" gnus-sieve-update
+ "g" gnus-sieve-generate)
+
(gnus-define-keys (gnus-group-group-map "G" gnus-group-mode-map)
"d" gnus-group-make-directory-group
"h" gnus-group-make-help-group
"f" gnus-group-make-doc-group
"w" gnus-group-make-web-group
"r" gnus-group-rename-group
+ "R" gnus-group-make-rss-group
"c" gnus-group-customize
"x" gnus-group-nnimap-expunge
"\177" gnus-group-delete-group
"l" gnus-group-sort-groups-by-level
"v" gnus-group-sort-groups-by-score
"r" gnus-group-sort-groups-by-rank
- "m" gnus-group-sort-groups-by-method)
+ "m" gnus-group-sort-groups-by-method
+ "n" gnus-group-sort-groups-by-real-name)
(gnus-define-keys (gnus-group-sort-selected-map "P" gnus-group-group-map)
"s" gnus-group-sort-selected-groups
"l" gnus-group-sort-selected-groups-by-level
"v" gnus-group-sort-selected-groups-by-score
"r" gnus-group-sort-selected-groups-by-rank
- "m" gnus-group-sort-selected-groups-by-method)
+ "m" gnus-group-sort-selected-groups-by-method
+ "n" gnus-group-sort-selected-groups-by-real-name)
(gnus-define-keys (gnus-group-list-map "A" gnus-group-mode-map)
"k" gnus-group-list-killed
"f" gnus-score-flush-cache)
(gnus-define-keys (gnus-group-help-map "H" gnus-group-mode-map)
+ "c" gnus-group-fetch-charter
+ "C" gnus-group-fetch-control
"d" gnus-group-describe-group
"f" gnus-group-fetch-faq
"v" gnus-version)
"\C-k" gnus-group-kill-level
"z" gnus-group-kill-all-zombies))
+(defun gnus-topic-mode-p ()
+ "Return non-nil in `gnus-topic-mode'."
+ (and (boundp 'gnus-topic-mode)
+ (symbol-value 'gnus-topic-mode)))
+
(defun gnus-group-make-menu-bar ()
(gnus-turn-off-edit-menu 'group)
(unless (boundp 'gnus-group-reading-menu)
(easy-menu-define
gnus-group-reading-menu gnus-group-mode-map ""
`("Group"
- ["Read" gnus-group-read-group (gnus-group-group-name)]
- ["Select" gnus-group-select-group (gnus-group-group-name)]
+ ["Read" gnus-group-read-group
+ :included (not (gnus-topic-mode-p))
+ :active (gnus-group-group-name)]
+ ["Read " gnus-topic-read-group
+ :included (gnus-topic-mode-p)]
+ ["Select" gnus-group-select-group
+ :included (not (gnus-topic-mode-p))
+ :active (gnus-group-group-name)]
+ ["Select " gnus-topic-select-group
+ :included (gnus-topic-mode-p)]
["See old articles" (gnus-group-select-group 'all)
:keys "C-u SPC" :active (gnus-group-group-name)]
- ["Catch up" gnus-group-catchup-current :active (gnus-group-group-name)
+ ["Catch up" gnus-group-catchup-current
+ :included (not (gnus-topic-mode-p))
+ :active (gnus-group-group-name)
,@(if (featurep 'xemacs) nil
'(:help "Mark unread articles in the current group as read"))]
+ ["Catch up " gnus-topic-catchup-articles
+ :included (gnus-topic-mode-p)
+ ,@(if (featurep 'xemacs) nil
+ '(:help "Mark unread articles in the current group or topic 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
+ :included (not (gnus-topic-mode-p))
:active (gnus-group-group-name)
,@(if (featurep 'xemacs) nil
'(:help "Check for new messages in current group"))]
+ ["Check for new articles " gnus-topic-get-new-news-this-topic
+ :included (gnus-topic-mode-p)
+ ,@(if (featurep 'xemacs) nil
+ '(:help "Check for new messages in current group or topic"))]
["Toggle subscription" gnus-group-unsubscribe-current-group
(gnus-group-group-name)]
["Kill" gnus-group-kill-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)]
+ ["Fetch charter" gnus-group-fetch-charter
+ :active (gnus-group-group-name)
+ ,@(if (featurep 'xemacs) nil
+ '(:help "Display the charter of the current group"))]
+ ["Fetch control message" gnus-group-fetch-control
+ :active (gnus-group-group-name)
+ ,@(if (featurep 'xemacs) nil
+ '(:help "Display the archived control message for the current group"))]
;; Actually one should check, if any of the marked groups gives t for
;; (gnus-check-backend-function 'request-expire-articles ...)
["Expire articles" gnus-group-expire-articles
- (or (and (gnus-group-group-name)
- (gnus-check-backend-function
- 'request-expire-articles
- (gnus-group-group-name))) gnus-group-marked)]
- ["Set group level" gnus-group-set-current-level
+ :included (not (gnus-topic-mode-p))
+ :active (or (and (gnus-group-group-name)
+ (gnus-check-backend-function
+ 'request-expire-articles
+ (gnus-group-group-name))) gnus-group-marked)]
+ ["Expire articles " gnus-topic-expire-articles
+ :included (gnus-topic-mode-p)]
+ ["Set group level..." gnus-group-set-current-level
(gnus-group-group-name)]
["Select quick" gnus-group-quick-select-group (gnus-group-group-name)]
["Customize" gnus-group-customize (gnus-group-group-name)]
("Edit"
["Parameters" gnus-group-edit-group-parameters
- (gnus-group-group-name)]
+ :included (not (gnus-topic-mode-p))
+ :active (gnus-group-group-name)]
+ ["Parameters " gnus-topic-edit-parameters
+ :included (gnus-topic-mode-p)]
["Select method" gnus-group-edit-group-method
(gnus-group-group-name)]
["Info" gnus-group-edit-group (gnus-group-group-name)]
["Sort by score" gnus-group-sort-groups-by-score t]
["Sort by level" gnus-group-sort-groups-by-level t]
["Sort by unread" gnus-group-sort-groups-by-unread t]
- ["Sort by name" gnus-group-sort-groups-by-alphabet t])
+ ["Sort by name" gnus-group-sort-groups-by-alphabet t]
+ ["Sort by real name" gnus-group-sort-groups-by-real-name t])
("Sort process/prefixed"
["Default sort" gnus-group-sort-selected-groups
- (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))]
+ (not (gnus-topic-mode-p))]
["Sort by method" gnus-group-sort-selected-groups-by-method
- (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))]
+ (not (gnus-topic-mode-p))]
["Sort by rank" gnus-group-sort-selected-groups-by-rank
- (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))]
+ (not (gnus-topic-mode-p))]
["Sort by score" gnus-group-sort-selected-groups-by-score
- (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))]
+ (not (gnus-topic-mode-p))]
["Sort by level" gnus-group-sort-selected-groups-by-level
- (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))]
+ (not (gnus-topic-mode-p))]
["Sort by unread" gnus-group-sort-selected-groups-by-unread
- (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))]
+ (not (gnus-topic-mode-p))]
["Sort by name" gnus-group-sort-selected-groups-by-alphabet
- (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))])
+ (not (gnus-topic-mode-p))]
+ ["Sort by real name" gnus-group-sort-selected-groups-by-real-name
+ (not (gnus-topic-mode-p))])
("Mark"
["Mark group" gnus-group-mark-group
(and (gnus-group-group-name)
(memq (gnus-group-group-name) gnus-group-marked))]
["Unmark all" gnus-group-unmark-all-groups gnus-group-marked]
["Mark regexp..." gnus-group-mark-regexp t]
- ["Mark region" gnus-group-mark-region t]
+ ["Mark region" gnus-group-mark-region :active (gnus-mark-active-p)]
["Mark buffer" gnus-group-mark-buffer t]
["Execute command" gnus-group-universal-argument
(or gnus-group-marked (gnus-group-group-name))])
("Subscribe"
- ["Subscribe to a group" gnus-group-unsubscribe-group t]
- ["Kill all newsgroups in region" gnus-group-kill-region t]
+ ["Subscribe to a group..." gnus-group-unsubscribe-group t]
+ ["Kill all newsgroups in region" gnus-group-kill-region
+ :active (gnus-mark-active-p)]
["Kill all zombie groups" gnus-group-kill-all-zombies
gnus-zombie-list]
["Kill all groups on level..." gnus-group-kill-level t])
("Foreign groups"
- ["Make a foreign group" gnus-group-make-group t]
- ["Add a directory group" gnus-group-make-directory-group t]
+ ["Make a foreign group..." gnus-group-make-group t]
+ ["Add a directory group..." gnus-group-make-directory-group t]
["Add the help group" gnus-group-make-help-group t]
["Add the archive group" gnus-group-make-archive-group t]
- ["Make a doc group" gnus-group-make-doc-group t]
- ["Make a web group" gnus-group-make-web-group t]
- ["Make a kiboze group" gnus-group-make-kiboze-group t]
- ["Make a virtual group" gnus-group-make-empty-virtual t]
- ["Add a group to a virtual" gnus-group-add-to-virtual t]
- ["Rename group" gnus-group-rename-group
+ ["Make a doc group..." gnus-group-make-doc-group t]
+ ["Make a web group..." gnus-group-make-web-group t]
+ ["Make a kiboze group..." gnus-group-make-kiboze-group t]
+ ["Make a virtual group..." gnus-group-make-empty-virtual t]
+ ["Add a group to a virtual..." gnus-group-add-to-virtual t]
+ ["Rename group..." gnus-group-rename-group
(gnus-check-backend-function
'request-rename-group (gnus-group-group-name))]
["Delete group" gnus-group-delete-group
["Next unread same level" gnus-group-next-unread-group-same-level t]
["Previous unread same level"
gnus-group-prev-unread-group-same-level t]
- ["Jump to group" gnus-group-jump-to-group t]
+ ["Jump to group..." gnus-group-jump-to-group t]
["First unread group" gnus-group-first-unread-group t]
["Best unread group" gnus-group-best-unread-group t])
+ ("Sieve"
+ ["Generate" gnus-sieve-generate t]
+ ["Generate and update" gnus-sieve-update t])
["Delete bogus groups" gnus-group-check-bogus-groups t]
["Find new newsgroups" gnus-group-find-new-groups t]
["Transpose" gnus-group-transpose-groups
["Save areas" gnus-soup-save-areas (fboundp 'gnus-soup-pack-packet)]
["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]
+ ["Send a message (mail or news)" gnus-group-post-news t]
+ ["Create a local message" gnus-group-news t]
["Check for new news" gnus-group-get-new-news
,@(if (featurep 'xemacs) '(t)
'(:help "Get newly arrived articles"))
]
+ ["Send queued messages" gnus-delay-send-queue
+ ,@(if (featurep 'xemacs) '(t)
+ '(:help "Send all messages that are scheduled to be sent now"))
+ ]
["Activate all groups" gnus-activate-all-groups t]
["Restart Gnus" gnus-group-restart t]
["Read init file" gnus-group-read-init-file t]
- ["Browse foreign server" gnus-group-browse-foreign-server t]
+ ["Browse foreign server..." gnus-group-browse-foreign-server t]
["Enter server buffer" gnus-group-enter-server-mode t]
["Expire all expirable articles" gnus-group-expire-all-groups t]
["Generate any kiboze groups" nnkiboze-generate-groups t]
;; 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))
+ (if (and
+ (condition-case nil (require 'tool-bar) (error nil))
+ (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)))
(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 ""))
projects / gnus / blobdiff