;;; Code:
-;; For Emacs < 22.2.
+;; For Emacs <22.2 and XEmacs.
(eval-and-compile
(unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
(autoload 'gnus-agent-total-fetched-for "gnus-agent")
(autoload 'gnus-cache-total-fetched-for "gnus-cache")
+(autoload 'gnus-group-make-nnir-group "nnir")
+
(defcustom gnus-no-groups-message "No Gnus is good news"
"*Message displayed by Gnus when no groups are available."
:group 'gnus-start
:type 'boolean)
(defcustom gnus-group-default-list-level gnus-level-subscribed
- "*Default listing level.
+ "Default listing level.
Ignored if `gnus-group-use-permanent-levels' is non-nil."
:group 'gnus-group-listing
- :type 'integer)
+ :type '(choice (integer :tag "Level")
+ (function :tag "Function returning level")))
(defcustom gnus-group-list-inactive-groups t
"*If non-nil, inactive groups will be listed."
"D" gnus-group-enter-directory
"f" gnus-group-make-doc-group
"w" gnus-group-make-web-group
+ "G" gnus-group-make-nnir-group
"M" gnus-group-read-ephemeral-group
"r" gnus-group-rename-group
"R" gnus-group-make-rss-group
"e" gnus-score-edit-all-score)
(gnus-define-keys (gnus-group-help-map "H" gnus-group-mode-map)
- "C" gnus-group-fetch-control
"d" gnus-group-describe-group
"v" gnus-version)
(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
["Describe" gnus-group-describe-group :active (gnus-group-group-name)
,@(if (featurep 'xemacs) nil
'(:help "Display description 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
["Add the help group" gnus-group-make-help-group t]
["Make a doc group..." gnus-group-make-doc-group t]
["Make a web group..." gnus-group-make-web-group t]
+ ["Make a search group..." gnus-group-make-nnir-group t]
["Make a virtual group..." gnus-group-make-empty-virtual t]
["Add a group to a virtual..." gnus-group-add-to-virtual t]
["Make an ephemeral group..." gnus-group-read-ephemeral-group t]
(when (and (not (featurep 'xemacs))
(boundp 'tool-bar-mode)
tool-bar-mode
- ;; The Gnus 5.10.6 code checked (default-value 'tool-bar-mode).
- ;; Why? --rsteib
+ (display-graphic-p)
(or (not gnus-group-tool-bar-map) force))
(let* ((load-path
(gmm-image-load-path-for-library "gnus"
(mouse-set-point e)
(gnus-group-read-group nil))
+(defun gnus-group-default-list-level ()
+ "Return the real value for `gnus-group-default-list-level'."
+ (if (functionp gnus-group-default-list-level)
+ (funcall gnus-group-default-list-level)
+ gnus-group-default-list-level))
+
;; Look at LEVEL and find out what the level is really supposed to be.
;; If LEVEL is non-nil, LEVEL will be returned, if not, what happens
;; will depend on whether `gnus-group-use-permanent-levels' is used.
(or (setq gnus-group-use-permanent-levels
(or level (if (numberp gnus-group-use-permanent-levels)
gnus-group-use-permanent-levels
- (or gnus-group-default-list-level
+ (or (gnus-group-default-list-level)
gnus-level-subscribed))))
- gnus-group-default-list-level gnus-level-subscribed))
+ (gnus-group-default-list-level) gnus-level-subscribed))
(number-or-nil
level)
(t
- (or level gnus-group-default-list-level gnus-level-subscribed))))
+ (or level (gnus-group-default-list-level) gnus-level-subscribed))))
(defun gnus-group-setup-buffer ()
(set-buffer (gnus-get-buffer-create gnus-group-buffer))
(prefix-numeric-value current-prefix-arg)
(or
(gnus-group-default-level nil t)
- gnus-group-default-list-level
+ (gnus-group-default-list-level)
gnus-level-subscribed))))
(unless level
(setq level (car gnus-group-list-mode)
?m ? ))
(gnus-tmp-moderated-string
(if (eq gnus-tmp-moderated ?m) "(m)" ""))
- (gnus-tmp-group-icon (gnus-group-get-icon gnus-tmp-qualified-group))
+ (gnus-tmp-group-icon (gnus-group-get-icon gnus-tmp-group))
(gnus-tmp-news-server (or (cadr gnus-tmp-method) ""))
(gnus-tmp-news-method (or (car gnus-tmp-method) ""))
(gnus-tmp-news-method-string
(when (inline (gnus-visual-p 'group-highlight 'highlight))
(gnus-group-highlight-line gnus-tmp-group beg end))
(gnus-run-hooks 'gnus-group-update-hook)
- (forward-line)
- ;; Allow XEmacs to remove front-sticky text properties.
- (gnus-group-remove-excess-properties)))
+ (forward-line)))
(defun gnus-group-update-eval-form (group list)
"Eval `car' of each element of LIST, and return the first that return t.
(unless no-advance
(gnus-group-next-group 1))
(decf n))
- (gnus-summary-position-point)
+ (gnus-group-position-point)
n))
(defun gnus-group-unmark-group (n)
require-match initial-input
(or hist 'gnus-group-history)
def))
- (if (if (listp collection)
- (member group choices)
- (symbol-value (intern-soft group collection)))
- group
- (mm-encode-coding-string group (gnus-group-name-charset nil group)))))
+ (unless (if (listp collection)
+ (member group (mapcar 'symbol-name collection))
+ (symbol-value (intern-soft group collection)))
+ (setq group
+ (mm-encode-coding-string
+ group (gnus-group-name-charset nil group))))
+ (gnus-replace-in-string group "\n" "")))
;;;###autoload
(defun gnus-fetch-group (group &optional articles)
(list
;; (gnus-read-group "Group name: ")
(gnus-group-completing-read)
- (gnus-read-method "From method: ")))
+ (gnus-read-method "From method")))
;; Transform the select method into a unique server.
(when (stringp method)
(setq method (gnus-server-to-method method)))
(while (re-search-forward "^To: " nil t)
(end-of-line)
(insert (format ", %s@%s" number
- (replace-regexp-in-string
- "/.*$" ""
- (replace-regexp-in-string "^http://" "" mbox-url)))))
+ (gnus-replace-in-string
+ (gnus-replace-in-string mbox-url "^http://" "")
+ "/.*$" ""))))
(write-region (point-min) (point-max) tmpfile)
(gnus-group-read-ephemeral-group
"gnus-read-ephemeral-bug"
(interactive
(list
(gnus-read-group "Group name: ")
- (gnus-read-method "From method: ")))
+ (gnus-read-method "From method")))
(when (stringp method)
(setq method (or (gnus-server-to-method method) method)))
(nnweb-ephemeral-p t))))
(if solid
(progn
- (gnus-pull 'nnweb-ephemeral-p method)
+ (gnus-alist-pull 'nnweb-ephemeral-p method)
(gnus-group-make-group group method))
(gnus-group-read-ephemeral-group
group method t
Killed newsgroups are subscribed. If SILENT, don't try to update the
group line."
(interactive (list (gnus-group-completing-read
- nil (gnus-read-active-file-p))))
+ nil nil (gnus-read-active-file-p))))
(let ((newsrc (gnus-group-entry group)))
(cond
((string-match "^[ \t]*$" group)
(let* ((groups (gnus-group-process-prefix n))
(ret (if (numberp n) (- n (length groups)) 0))
(beg (unless n
- (point)))
+ (point-marker)))
group method
(gnus-inhibit-demon t)
;; Binding this variable will inhibit multiple fetchings
(goto-char beg))
(when gnus-goto-next-group-when-activating
(gnus-group-next-unread-group 1 t))
- (gnus-summary-position-point)
+ (gnus-group-position-point)
ret))
-(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
- (gnus-group-completing-read))
- (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 ".gz"))
- (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 ".gz")))
- (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)))
With 2 C-u's, use most complete method possible to query the server
for new groups, and subscribe the new groups as zombies."
(interactive "p")
- (gnus-find-new-newsgroups (or arg 1))
- (gnus-group-list-groups))
+ (let ((new-groups (gnus-find-new-newsgroups (or arg 1)))
+ current-group)
+ (gnus-group-list-groups)
+ (setq current-group (gnus-group-group-name))
+ (dolist (group new-groups)
+ (gnus-group-jump-to-group group))
+ (when current-group
+ (gnus-group-jump-to-group current-group))))
(defun gnus-group-edit-global-kill (&optional article group)
"Edit the global kill file.
(interactive
(list (let ((how (gnus-completing-read
"Which back end"
- (mapcar 'car (append gnus-valid-select-methods gnus-server-alist))
+ (mapcar 'car (append gnus-valid-select-methods
+ gnus-server-alist))
t (cons "nntp" 0) 'gnus-method-history)))
;; We either got a back end name or a virtual server name.
;; If the first, we also need an address.