(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."
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)
"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)
,@(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-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 (gnus-group-completing-read-group-name
"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 / elisp / gnus.git- / blobdiff