(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."
%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\")
%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.
+ 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
effect.
General format specifiers can also be used.
-See (gnus)Formatting Variables."
+See Info node `(gnus)Formatting Variables'."
:link '(custom-manual "(gnus)Formatting Variables")
:group 'gnus-group-visual
:type 'string)
(?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)
"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)
,@(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
(gnus-check-backend-function
'request-expire-articles
(gnus-group-group-name))) gnus-group-marked)]
- ["Set group level" gnus-group-set-current-level
+ ["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)]
["Execute command" gnus-group-universal-argument
(or gnus-group-marked (gnus-group-group-name))])
("Subscribe"
- ["Subscribe to a group" gnus-group-unsubscribe-group t]
+ ["Subscribe to a group..." gnus-group-unsubscribe-group t]
["Kill all newsgroups in region" gnus-group-kill-region t]
["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"
["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)))
(gnus-tmp-qualified-group
(gnus-group-name-decode (gnus-group-real-name gnus-tmp-group)
group-name-charset))
+ (gnus-tmp-comment
+ (or (gnus-group-get-parameter gnus-tmp-group 'comment t)
+ gnus-tmp-group))
(gnus-tmp-newsgroup-description
(if gnus-description-hashtb
(or (gnus-group-name-decode
(gnus-group-prefixed-name group method) method)))
;;;###autoload
-(defun gnus-fetch-group (group)
+(defun gnus-fetch-group (group &optional articles)
"Start Gnus if necessary and enter GROUP.
Returns whether the fetching was successful or not."
(interactive (list (completing-read "Group name: " gnus-active-hashtb)))
(unless (get-buffer gnus-group-buffer)
(gnus-no-server))
- (gnus-group-read-group nil nil group))
+ (gnus-group-read-group articles nil group))
;;;###autoload
(defun gnus-fetch-group-other-frame (group)
(gnus-group-goto-group group)
(gnus-group-kill-group 1 t)
(gnus-sethash group nil gnus-active-hashtb)
- (when gnus-cache-active-hashtb
+ (when (and (boundp 'gnus-cache-active-hashtb)
+ gnus-cache-active-hashtb)
(gnus-sethash group nil gnus-cache-active-hashtb)
(setq gnus-cache-active-altered t))
t))
(defun gnus-group-sort-by-method (info1 info2)
"Sort alphabetically by backend name."
- (string< (symbol-name (car (gnus-find-method-for-group
- (gnus-info-group info1) info1)))
- (symbol-name (car (gnus-find-method-for-group
- (gnus-info-group info2) info2)))))
+ (string< (car (gnus-find-method-for-group
+ (gnus-info-group info1) info1))
+ (car (gnus-find-method-for-group
+ (gnus-info-group info2) info2))))
(defun gnus-group-sort-by-server (info1 info2)
"Sort alphabetically by server name."
(gnus-group-group-name)
(when current-prefix-arg
(completing-read
- "Faq dir: " (and (listp gnus-group-faq-directory)
+ "FAQ dir: " (and (listp gnus-group-faq-directory)
(mapcar #'list
gnus-group-faq-directory))))))
(unless group
(find-file file)
(setq found t))))))
+(defun gnus-group-fetch-charter (group)
+ "Fetch the charter for the current group.
+If given a prefix argument, prompt for a group."
+ (interactive
+ (list (or (when current-prefix-arg
+ (completing-read "Group: " gnus-active-hashtb))
+ (gnus-group-group-name)
+ gnus-newsgroup-name)))
+ (unless group
+ (error "No group name given"))
+ (require 'mm-url)
+ (let ((name (mm-url-form-encode-xwfu (gnus-group-real-name group)))
+ url hierarchy)
+ (when (string-match "\\(^[^\\.]+\\)\\..*" name)
+ (setq hierarchy (match-string 1 name))
+ (if (setq url (cdr (assoc hierarchy gnus-group-charter-alist)))
+ (browse-url (eval url))
+ (gnus-group-fetch-control group)))))
+
+(defun gnus-group-fetch-control (group)
+ "Fetch the archived control messages for the current group.
+If given a prefix argument, prompt for a group."
+ (interactive
+ (list (or (when current-prefix-arg
+ (completing-read "Group: " gnus-active-hashtb))
+ (gnus-group-group-name)
+ gnus-newsgroup-name)))
+ (unless group
+ (error "No group name given"))
+ (let ((name (gnus-group-real-name group))
+ hierarchy)
+ (when (string-match "\\(^[^\\.]+\\)\\..*" name)
+ (setq hierarchy (match-string 1 name))
+ (if gnus-group-fetch-control-use-browse-url
+ (browse-url (concat "ftp://ftp.isc.org/usenet/control/"
+ hierarchy "/" name ".Z"))
+ (let ((enable-local-variables nil))
+ (gnus-group-read-ephemeral-group
+ group
+ `(nndoc ,group (nndoc-address
+ ,(find-file-noselect
+ (concat "/ftp@ftp.isc.org:/usenet/control/"
+ hierarchy "/" name ".Z")))
+ (nndoc-article-type mbox)) t nil nil))))))
+
(defun gnus-group-describe-group (force &optional group)
"Display a description of the current newsgroup."
(interactive (list current-prefix-arg (gnus-group-group-name)))
projects / gnus / blobdiff