X-Git-Url: http://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fgnus-group.el;h=5a65d30ec1cbc2b9058233eedb42305131805f2f;hb=8f7952d82c5c6a342b12597a109f25c0ed072391;hp=c14645622084b17f6c453a5a347e88393bba412a;hpb=6f8f8532fa03cc5668788c300f4f2fa5f59f6726;p=gnus diff --git a/lisp/gnus-group.el b/lisp/gnus-group.el index c14645622..5a65d30ec 100644 --- a/lisp/gnus-group.el +++ b/lisp/gnus-group.el @@ -25,7 +25,7 @@ ;;; Code: -;; For Emacs < 22.2. +;; For Emacs <22.2 and XEmacs. (eval-and-compile (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) @@ -55,6 +55,8 @@ (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 @@ -117,10 +119,11 @@ If nil, only list groups that have unread articles." :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." @@ -653,6 +656,7 @@ simple manner.") "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 @@ -737,7 +741,6 @@ simple manner.") "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) @@ -757,7 +760,6 @@ simple manner.") (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 @@ -804,10 +806,6 @@ simple manner.") ["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 @@ -905,6 +903,7 @@ simple manner.") ["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] @@ -1086,8 +1085,7 @@ When FORCE, rebuild the tool bar." (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" @@ -1166,6 +1164,12 @@ The following commands are available: (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. @@ -1175,13 +1179,13 @@ The following commands are available: (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)) @@ -1227,7 +1231,7 @@ Also see the `gnus-group-use-permanent-levels' variable." (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) @@ -1548,7 +1552,7 @@ if it is a string, only list groups matching REGEXP." ?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 @@ -1597,9 +1601,7 @@ if it is a string, only list groups matching REGEXP." (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. @@ -1888,7 +1890,7 @@ If FIRST-TOO, the current line is also eligible as a target." (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) @@ -2190,11 +2192,13 @@ if it is not a list." require-match initial-input (or hist 'gnus-group-history) def)) - (if (if (listp collection) - (member group (mapcar 'symbol-name collection)) - (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) @@ -2424,9 +2428,9 @@ the bug number, and browsing the URL must return mbox output." (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" @@ -3027,7 +3031,7 @@ If SOLID (the prefix), create a solid group." (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 @@ -3677,7 +3681,7 @@ If given numerical prefix, toggle the N next groups." 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) @@ -3979,7 +3983,7 @@ If DONT-SCAN is non-nil, scan non-activated groups as well." (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 @@ -4010,35 +4014,9 @@ If DONT-SCAN is non-nil, scan non-activated groups as well." (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))) @@ -4208,8 +4186,14 @@ groups. 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. @@ -4321,7 +4305,8 @@ and the second element is the address." (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.