X-Git-Url: http://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fgnus-group.el;h=5843214e48a5d994c70b3e50780cf0a631fb837c;hb=b58d62328adf02b341b460a98819a54a0d629b60;hp=286bd7ecaab78123bfd4c1da6554f07012dd3d87;hpb=3e2c3dfde085e2e5ba228a6a2e5dafb266a3ee2f;p=gnus diff --git a/lisp/gnus-group.el b/lisp/gnus-group.el index 286bd7eca..5843214e4 100644 --- a/lisp/gnus-group.el +++ b/lisp/gnus-group.el @@ -1,7 +1,7 @@ ;;; gnus-group.el --- group mode commands for Gnus ;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006 Free Software Foundation, Inc. +;; 2005, 2006, 2007 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: news @@ -10,7 +10,7 @@ ;; GNU Emacs is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) +;; the Free Software Foundation; either version 3, or (at your option) ;; any later version. ;; GNU Emacs is distributed in the hope that it will be useful, @@ -28,8 +28,8 @@ ;;; Code: (eval-when-compile - (require 'cl) - (defvar tool-bar-mode)) + (require 'cl)) +(defvar tool-bar-mode) (require 'gnus) (require 'gnus-start) @@ -135,7 +135,7 @@ for the groups to be sorted. Pre-made functions include `gnus-group-sort-by-score', `gnus-group-sort-by-method', `gnus-group-sort-by-server', and `gnus-group-sort-by-rank'. -This variable can also be a list of sorting functions. In that case, +This variable can also be a list of sorting functions. In that case, the most significant sort function should be the last function in the list." :group 'gnus-group-listing @@ -197,7 +197,7 @@ with some simple extensions. Note that this format specification is not always respected. For reasons of efficiency, when listing killed groups, this specification -is ignored altogether. If the spec is changed considerably, your +is ignored altogether. If the spec is changed considerably, your output may end up looking strange when listing both alive and killed groups. @@ -382,6 +382,7 @@ score: The score of the group. ticked: The number of ticked articles." :group 'gnus-group-visual :type '(repeat (cons (sexp :tag "Form") face))) +(put 'gnus-group-highlight 'risky-local-variable t) (defcustom gnus-new-mail-mark ?% "Mark used for groups with new mail." @@ -419,6 +420,7 @@ score: The score of the group. ticked: The number of ticked articles." :group 'gnus-group-icons :type '(repeat (cons (sexp :tag "Form") file))) +(put 'gnus-group-icon-list 'risky-local-variable t) (defcustom gnus-group-name-charset-method-alist nil "Alist of method and the charset for group names. @@ -1010,8 +1012,9 @@ Setter function for custom variables." (with-current-buffer gnus-group-buffer (gnus-group-make-tool-bar t)))) -;; The default will be changed when the new icons have been checked in: -(defcustom gnus-group-tool-bar 'gnus-group-tool-bar-retro +(defcustom gnus-group-tool-bar (if (eq gmm-tool-bar-style 'gnome) + 'gnus-group-tool-bar-gnome + 'gnus-group-tool-bar-retro) "Specifies the Gnus group tool bar. It can be either a list or a symbol refering to a list. See @@ -1030,31 +1033,38 @@ Pre-defined symbols include `gnus-group-tool-bar-gnome' and :group 'gnus-group) (defcustom gnus-group-tool-bar-gnome - '((gnus-group-post-news "compose") - (gnus-group-get-new-news "inbox") ;; Add... nil :visible gnus-plugged ? - ;; FIXME: gnus-*-read-group should have a better help text. - (gnus-topic-read-group "open" nil :visible gnus-topic-mode) - (gnus-group-read-group "open" nil :visible (not gnus-topic-mode)) - ;; (gnus-group-find-new-groups "???" nil) - (gnus-group-save-newsrc "save") - (gnus-group-describe-group "describe") - (gnus-group-unsubscribe-current-group "toggle-subscription") - ;; (gnus-group-subscribe "subscribe" t - ;; :help "Subscribe to the current group") - ;; (gnus-group-unsubscribe "unsubscribe" t - ;; :help "Unsubscribe from the current group") - ;; + '((gnus-group-post-news "mail/compose") ;; Some useful agent icons? I don't use the agent so agent users should ;; suggest useful commands: - (gnus-group-send-queue "outbox" t - :visible (and gnus-agent gnus-plugged) - :help "Send articles from the queue group") - (gnus-agent-toggle-plugged "connect" nil + (gnus-agent-toggle-plugged "disconnect" t + :help "Gnus is currently unplugged. Click to work online." :visible (and gnus-agent (not gnus-plugged))) - (gnus-agent-toggle-plugged "disconnect" nil + (gnus-agent-toggle-plugged "connect" t + :help "Gnus is currently plugged. Click to work offline." :visible (and gnus-agent gnus-plugged)) - ;; - (gnus-group-exit "exit-mode") + ;; FIXME: gnus-agent-toggle-plugged (in gnus-agent-group-make-menu-bar) + ;; should have a better help text. + (gnus-group-send-queue "mail/outbox" t + :visible (and gnus-agent gnus-plugged) + :help "Send articles from the queue group") + (gnus-group-get-new-news "mail/inbox" nil + :visible (or (not gnus-agent) + gnus-plugged)) + ;; FIXME: gnus-*-read-group should have a better help text. + (gnus-topic-read-group "open" nil + :visible (and (boundp 'gnus-topic-mode) + gnus-topic-mode)) + (gnus-group-read-group "open" nil + :visible (not (and (boundp 'gnus-topic-mode) + gnus-topic-mode))) + ;; (gnus-group-find-new-groups "???" nil) + (gnus-group-save-newsrc "save") + (gnus-group-describe-group "describe") + (gnus-group-unsubscribe-current-group "gnus/toggle-subscription") + (gnus-group-prev-unread-group "left-arrow") + (gnus-group-next-unread-group "right-arrow") + (gnus-group-exit "exit") + (gmm-customize-mode "preferences" t :help "Edit mode preferences") (gnus-info-find-node "help")) "List of functions for the group tool bar (GNOME style). @@ -1066,15 +1076,15 @@ See `gmm-tool-bar-from-list' for the format of the list." :group 'gnus-group) (defcustom gnus-group-tool-bar-retro - '((gnus-group-get-new-news "get-news") - (gnus-group-get-new-news-this-group "gnntg") - (gnus-group-catchup-current "catchup") - (gnus-group-describe-group "describe-group") - (gnus-group-subscribe "subscribe" t + '((gnus-group-get-new-news "gnus/get-news") + (gnus-group-get-new-news-this-group "gnus/gnntg") + (gnus-group-catchup-current "gnus/catchup") + (gnus-group-describe-group "gnus/describe-group") + (gnus-group-subscribe "gnus/subscribe" t :help "Subscribe to the current group") - (gnus-group-unsubscribe "unsubscribe" t + (gnus-group-unsubscribe "gnus/unsubscribe" t :help "Unsubscribe from the current group") - (gnus-group-exit "exit-gnus" gnus-group-mode-map)) + (gnus-group-exit "gnus/exit-gnus" gnus-group-mode-map)) "List of functions for the group tool bar (retro look). See `gmm-tool-bar-from-list' for the format of the list." @@ -1084,17 +1094,6 @@ See `gmm-tool-bar-from-list' for the format of the list." :set 'gnus-group-tool-bar-update :group 'gnus-group) -;; FIXME: Moving through the Group buffer (in topic mode) e.g. with C-n -;; doesn't update the state (enabled/disabled) of the icon -;; `gnus-group-describe-group'. After `C-l' the state is correct. -;; See the following report on emacs-devel -;; : -;; From: Reiner Steib -;; Subject: tool bar icons not updated according to :active condition -;; Newsgroups: gmane.emacs.devel -;; Date: Mon, 23 Jan 2006 19:59:13 +0100 -;; Message-ID: - (defcustom gnus-group-tool-bar-zap-list t "List of icon items from the global tool bar. These items are not displayed in the Gnus group mode tool bar. @@ -1106,6 +1105,8 @@ See `gmm-tool-bar-from-list' for the format of the list." :set 'gnus-group-tool-bar-update :group 'gnus-group) +(defvar image-load-path) + (defun gnus-group-make-tool-bar (&optional force) "Make a group mode tool bar from `gnus-group-tool-bar'. When FORCE, rebuild the tool bar." @@ -1115,7 +1116,13 @@ When FORCE, rebuild the tool bar." ;; The Gnus 5.10.6 code checked (default-value 'tool-bar-mode). ;; Why? --rsteib (or (not gnus-group-tool-bar-map) force)) - (let* ((load-path (mm-image-load-path)) + (let* ((load-path + (gmm-image-load-path-for-library "gnus" + "gnus/toggle-subscription.xpm" + nil t)) + (image-load-path (cons (car load-path) + (when (boundp 'image-load-path) + image-load-path))) (map (gmm-tool-bar-from-list gnus-group-tool-bar gnus-group-tool-bar-zap-list 'gnus-group-mode-map))) @@ -1128,7 +1135,7 @@ When FORCE, rebuild the tool bar." All normal editing commands are switched off. \\ -The group buffer lists (some of) the groups available. For instance, +The group buffer lists (some of) the groups available. For instance, `\\[gnus-group-list-groups]' will list all subscribed groups with unread articles, while `\\[gnus-group-list-zombies]' lists all zombie groups. @@ -1213,7 +1220,10 @@ The following commands are available: (defun gnus-group-name-charset (method group) (if (null method) (setq method (gnus-find-method-for-group group))) - (let ((item (assoc method gnus-group-name-charset-method-alist)) + (let ((item (or (assoc method gnus-group-name-charset-method-alist) + (and (consp method) + (assoc (list (car method) (cadr method)) + gnus-group-name-charset-method-alist)))) (alist gnus-group-name-charset-group-alist) result) (if item @@ -1493,6 +1503,36 @@ if it is a string, only list groups matching REGEXP." (gnus-range-difference (list active) (gnus-info-read info)) seen)))))) +;; Moving through the Group buffer (in topic mode) e.g. with C-n doesn't +;; update the state (enabled/disabled) of the icon `gnus-group-describe-group' +;; automatically. After `C-l' the state is correct. See the following report +;; on emacs-devel +;; : +;; From: Reiner Steib +;; Subject: tool bar icons not updated according to :active condition +;; Newsgroups: gmane.emacs.devel +;; Date: Mon, 23 Jan 2006 19:59:13 +0100 +;; Message-ID: + +(defcustom gnus-group-update-tool-bar + (and (not (featurep 'xemacs)) + (boundp 'tool-bar-mode) + tool-bar-mode + ;; Using `redraw-frame' (see `gnus-tool-bar-update') in Emacs 21 might + ;; be confusing, so maybe we shouldn't call it by default. + (fboundp 'force-window-update)) + "Force updating the group buffer tool bar." + :group 'gnus-group + :version "22.1" + :initialize 'custom-initialize-default + :set (lambda (symbol value) + (set-default symbol value) + (when (gnus-alive-p) + (with-current-buffer gnus-group-buffer + ;; FIXME: Is there a better way to redraw the group buffer? + (gnus-group-get-new-news 0)))) + :type 'boolean) + (defun gnus-group-insert-group-line (gnus-tmp-group gnus-tmp-level gnus-tmp-marked number gnus-tmp-method) @@ -1557,8 +1597,10 @@ if it is a string, only list groups matching REGEXP." (if (member gnus-tmp-group gnus-group-marked) gnus-process-mark ? )) (buffer-read-only nil) + beg end header gnus-tmp-header) ; passed as parameter to user-funcs. (beginning-of-line) + (setq beg (point)) (gnus-add-text-properties (point) (prog1 (1+ (point)) @@ -1573,6 +1615,12 @@ if it is a string, only list groups matching REGEXP." gnus-marked ,gnus-tmp-marked-mark gnus-indentation ,gnus-group-indentation gnus-level ,gnus-tmp-level)) + (setq end (point)) + (when gnus-group-update-tool-bar + (gnus-put-text-property beg end 'point-entered + 'gnus-tool-bar-update) + (gnus-put-text-property beg end 'point-left + 'gnus-tool-bar-update)) (forward-line -1) (when (inline (gnus-visual-p 'group-highlight 'highlight)) (gnus-run-hooks 'gnus-group-update-hook)) @@ -1607,6 +1655,24 @@ if it is a string, only list groups matching REGEXP." (ticked (gnus-range-length (cdr (assq 'tick marked)))) (group-age (gnus-group-timestamp-delta group)) (inhibit-read-only t)) + ;; FIXME: http://thread.gmane.org/gmane.emacs.gnus.general/65451/focus=65465 + ;; ====================================================================== + ;; From: Richard Stallman + ;; Subject: Re: Rewriting gnus-group-highlight-line (was: [...]) + ;; Cc: ding@gnus.org + ;; Date: Sat, 27 Oct 2007 19:41:20 -0400 + ;; Message-ID: + ;; + ;; [...] + ;; The kludge is that the alist elements contain expressions that refer + ;; to local variables with short names. Perhaps write your own tiny + ;; evaluator that handles just `and', `or', and numeric comparisons + ;; and just a few specific variables. + ;; ====================================================================== + ;; + ;; Similar for other evaluated variables. Grep for risky-local-variable + ;; to find them! -- rsteib + ;; ;; Eval the cars of the lists until we find a match. (while (and list (not (eval (caar list)))) @@ -1987,7 +2053,7 @@ and with point over the group in question." If the prefix argument ALL is non-nil, already read articles become readable. IF ALL is a number, fetch this number of articles. If the optional argument NO-ARTICLE is non-nil, no article will be -auto-selected upon group entry. If GROUP is non-nil, fetch that +auto-selected upon group entry. If GROUP is non-nil, fetch that group." (interactive "P") (let ((no-display (eq all 0)) @@ -2028,11 +2094,11 @@ articles in the group." (forward-line -1)) (gnus-group-read-group all t)) -(defun gnus-group-quick-select-group (&optional all) - "Select the current group \"quickly\". -This means that no highlighting or scoring will be performed. -If ALL (the prefix argument) is 0, don't even generate the summary -buffer. +(defun gnus-group-quick-select-group (&optional all group) + "Select the GROUP \"quickly\". +This means that no highlighting or scoring will be performed. If +ALL (the prefix argument) is 0, don't even generate the summary +buffer. If GROUP is nil, use current group. This might be useful if you want to toggle threading before entering the group." @@ -2043,7 +2109,7 @@ before entering the group." gnus-home-score-file gnus-apply-kill-hook gnus-summary-expunge-below) - (gnus-group-read-group all t))) + (gnus-group-read-group all t group))) (defun gnus-group-visible-select-group (&optional all) "Select the current group without hiding any articles." @@ -2067,14 +2133,86 @@ be permanent." (gnus-group-read-ephemeral-group (gnus-group-prefixed-name group method) method))) +(defun gnus-group-name-at-point () + "Return a group name from around point if it exists, or nil." + (if (eq major-mode 'gnus-group-mode) + (let ((group (gnus-group-group-name))) + (when group + (gnus-group-decoded-name group))) + (let ((regexp "[][\C-@-\t\v-*,/:-@\\^`{-\C-?]*\ +\\(nn[a-z]+\\(?:\\+[^][\C-@-*,/:-@\\^`{-\C-?]+\\)?:\ +\[^][\C-@-*,./:-@\\^`{-\C-?]+\\(?:\\.[^][\C-@-*,./:-@\\^`{-\C-?]+\\)*\ +\\|[^][\C-@-*,./:-@\\^`{-\C-?]+\\(?:\\.[^][\C-@-*,./:-@\\^`{-\C-?]+\\)+\\)") + (start (point)) + (case-fold-search nil)) + (prog1 + (if (or (and (not (or (eobp) + (looking-at "[][\C-@-*,/;-@\\^`{-\C-?]"))) + (prog1 t + (skip-chars-backward "^][\C-@-\t\v-*,/;-@\\^`{-\C-?" + (point-at-bol)))) + (and (looking-at "[][\C-@-\t\v-*,/;-@\\^`{-\C-?]*$") + (prog1 t + (skip-chars-backward "][\C-@-\t\v-*,/;-@\\^`{-\C-?") + (skip-chars-backward "^][\C-@-\t\v-*,/;-@\\^`{-\C-?" + (point-at-bol)))) + (string-match "\\`[][\C-@-\t\v-*,/;-@\\^`{-\C-?]*\\'" + (buffer-substring (point-at-bol) (point)))) + (when (looking-at regexp) + (match-string 1)) + (let (group distance) + (when (looking-at regexp) + (setq group (match-string 1) + distance (- (match-beginning 1) (match-beginning 0)))) + (skip-chars-backward "][\C-@-\t\v-*,/;-@\\^`{-\C-?") + (skip-chars-backward "^][\C-@-\t\v-*,/;-@\\^`{-\C-?" + (point-at-bol)) + (if (looking-at regexp) + (if (and group (<= distance (- start (match-end 0)))) + group + (match-string 1)) + group))) + (goto-char start))))) + +(defun gnus-group-completing-read (prompt &optional collection predicate + require-match initial-input hist def + &rest args) + "Read a group name with completion. Non-ASCII group names are allowed. +The arguments are the same as `completing-read' except that COLLECTION +and HIST default to `gnus-active-hashtb' and `gnus-group-history' +respectively if they are omitted." + (let (group) + (mapatoms (lambda (symbol) + (setq group (symbol-name symbol)) + (set (intern (if (string-match "[^\000-\177]" group) + (gnus-group-decoded-name group) + group) + collection) + group)) + (prog1 + (or collection + (setq collection (or gnus-active-hashtb [0]))) + (setq collection (gnus-make-hashtable (length collection))))) + (setq group (apply 'completing-read prompt collection predicate + require-match initial-input + (or hist 'gnus-group-history) + def args)) + (or (prog1 + (symbol-value (intern-soft group collection)) + (setq collection nil)) + (mm-encode-coding-string group (gnus-group-name-charset nil group))))) + ;;;###autoload (defun gnus-fetch-group (group &optional articles) "Start Gnus if necessary and enter GROUP. +If ARTICLES, display those articles. Returns whether the fetching was successful or not." - (interactive (list (completing-read "Group name: " gnus-active-hashtb))) - (unless (get-buffer gnus-group-buffer) + (interactive (list (gnus-group-completing-read "Group name: " + nil nil nil + (gnus-group-name-at-point)))) + (unless (gnus-alive-p) (gnus-no-server)) - (gnus-group-read-group articles nil group)) + (gnus-group-read-group (if articles nil t) nil group articles)) ;;;###autoload (defun gnus-fetch-group-other-frame (group) @@ -2132,10 +2270,7 @@ Return the name of the group if selection was successful." (interactive (list ;; (gnus-read-group "Group name: ") - (completing-read - "Group: " gnus-active-hashtb - nil nil nil - 'gnus-group-history) + (gnus-group-completing-read "Group: ") (gnus-read-method "From method: "))) ;; Transform the select method into a unique server. (when (stringp method) @@ -2187,17 +2322,14 @@ Return the name of the group if selection was successful." If PROMPT (the prefix) is a number, use the prompt specified in `gnus-group-jump-to-group-prompt'." (interactive - (list (mm-string-make-unibyte - (completing-read - "Group: " gnus-active-hashtb nil - (gnus-read-active-file-p) - (if current-prefix-arg - (cdr (assq current-prefix-arg gnus-group-jump-to-group-prompt)) - (or (and (stringp gnus-group-jump-to-group-prompt) - gnus-group-jump-to-group-prompt) - (let ((p (cdr (assq 0 gnus-group-jump-to-group-prompt)))) - (and (stringp p) p)))) - 'gnus-group-history)))) + (list (gnus-group-completing-read + "Group: " nil nil (gnus-read-active-file-p) + (if current-prefix-arg + (cdr (assq current-prefix-arg gnus-group-jump-to-group-prompt)) + (or (and (stringp gnus-group-jump-to-group-prompt) + gnus-group-jump-to-group-prompt) + (let ((p (cdr (assq 0 gnus-group-jump-to-group-prompt)))) + (and (stringp p) p))))))) (when (equal group "") (error "Empty group name")) @@ -2388,17 +2520,16 @@ If EXCLUDE-GROUP, do not go to that group." (defun gnus-group-make-group-simple (&optional group) "Add a new newsgroup. The user will be prompted for GROUP." - (interactive - (list (completing-read "Group: " gnus-active-hashtb - nil nil nil 'gnus-group-history))) - (gnus-group-make-group - (gnus-group-real-name group) - (gnus-group-server group))) + (interactive (list (gnus-group-completing-read "Group: "))) + (gnus-group-make-group (gnus-group-real-name group) + (gnus-group-server group) + nil nil t)) -(defun gnus-group-make-group (name &optional method address args) +(defun gnus-group-make-group (name &optional method address args encoded) "Add a new newsgroup. The user will be prompted for a NAME, for a select METHOD, and an -ADDRESS." +ADDRESS. NAME should be a human-readable string (i.e., not be encoded +even if it contains non-ASCII characters) unless ENCODED is non-nil." (interactive (list (gnus-read-group "Group name: ") @@ -2406,6 +2537,10 @@ ADDRESS." (when (stringp method) (setq method (or (gnus-server-to-method method) method))) + (unless encoded + (setq name (mm-encode-coding-string + name + (gnus-group-name-charset method name)))) (let* ((meth (gnus-method-simplify (when (and method (not (gnus-server-equal method gnus-select-method))) @@ -2496,14 +2631,19 @@ be removed from the server, even when it's empty." When used interactively, GROUP is the group under point and NEW-NAME will be prompted for." (interactive - (list - (gnus-group-group-name) - (progn - (unless (gnus-check-backend-function - 'request-rename-group (gnus-group-group-name)) - (error "This back end does not support renaming groups")) - (gnus-read-group "Rename group to: " - (gnus-group-real-name (gnus-group-group-name)))))) + (let ((group (gnus-group-group-name)) + method new-name) + (unless (gnus-check-backend-function 'request-rename-group group) + (error "This back end does not support renaming groups")) + (setq new-name (gnus-read-group + "Rename group to: " + (gnus-group-real-name (gnus-group-decoded-name group))) + method (gnus-info-method (gnus-get-info group))) + (list group (mm-encode-coding-string + new-name + (gnus-group-name-charset + method + (gnus-group-prefixed-name new-name method)))))) (unless (gnus-check-backend-function 'request-rename-group group) (error "This back end does not support renaming groups")) @@ -2522,29 +2662,34 @@ and NEW-NAME will be prompted for." (gnus-group-real-name new-name) (gnus-info-method (gnus-get-info group))))) - (when (gnus-active new-name) - (error "The group %s already exists" new-name)) + (let ((decoded-group (gnus-group-decoded-name group)) + (decoded-new-name (gnus-group-decoded-name new-name))) + (when (gnus-active new-name) + (error "The group %s already exists" decoded-new-name)) - (gnus-message 6 "Renaming group %s to %s..." group new-name) - (prog1 - (if (progn - (gnus-group-goto-group group) - (not (when (< (gnus-group-group-level) gnus-level-zombie) - (gnus-request-rename-group group new-name)))) - (gnus-error 3 "Couldn't rename group %s to %s" group new-name) - ;; We rename the group internally by killing it... - (gnus-group-kill-group) - ;; ... changing its name ... - (setcar (cdar gnus-list-of-killed-groups) new-name) - ;; ... and then yanking it. Magic! - (gnus-group-yank-group) - (gnus-set-active new-name (gnus-active group)) - (gnus-message 6 "Renaming group %s to %s...done" group new-name) - new-name) - (setq gnus-killed-list (delete group gnus-killed-list)) - (gnus-set-active group nil) - (gnus-dribble-touch) - (gnus-group-position-point))) + (gnus-message 6 "Renaming group %s to %s..." + decoded-group decoded-new-name) + (prog1 + (if (progn + (gnus-group-goto-group group) + (not (when (< (gnus-group-group-level) gnus-level-zombie) + (gnus-request-rename-group group new-name)))) + (gnus-error 3 "Couldn't rename group %s to %s" + decoded-group decoded-new-name) + ;; We rename the group internally by killing it... + (gnus-group-kill-group) + ;; ... changing its name ... + (setcar (cdar gnus-list-of-killed-groups) new-name) + ;; ... and then yanking it. Magic! + (gnus-group-yank-group) + (gnus-set-active new-name (gnus-active group)) + (gnus-message 6 "Renaming group %s to %s...done" + decoded-group decoded-new-name) + new-name) + (setq gnus-killed-list (delete group gnus-killed-list)) + (gnus-set-active group nil) + (gnus-dribble-touch) + (gnus-group-position-point)))) (defun gnus-group-edit-group (group &optional part) "Edit the group on the current line." @@ -2696,15 +2841,18 @@ If called with a prefix argument, ask for the file type." (t (setq err (format "%c unknown. " char)) nil)))) (setq type found))) - (let* ((file (expand-file-name file)) - (name (gnus-generate-new-group-name + (setq file (expand-file-name file)) + (let* ((name (gnus-generate-new-group-name (gnus-group-prefixed-name - (file-name-nondirectory file) '(nndoc ""))))) + (file-name-nondirectory file) '(nndoc "")))) + (method (list 'nndoc file + (list 'nndoc-address file) + (list 'nndoc-article-type (or type 'guess)))) + (coding (gnus-group-name-charset method name))) + (setcar (cdr method) (mm-encode-coding-string file coding)) (gnus-group-make-group - (gnus-group-real-name name) - (list 'nndoc file - (list 'nndoc-address file) - (list 'nndoc-article-type (or type 'guess)))))) + (mm-encode-coding-string (gnus-group-real-name name) coding) + method nil nil t))) (defvar nnweb-type-definition) (defvar gnus-group-web-type-history nil) @@ -2745,8 +2893,8 @@ If SOLID (the prefix), create a solid group." (cons (current-buffer) (if (eq major-mode 'gnus-summary-mode) 'summary 'group)))))) +(defvar nnrss-group-alist) (eval-when-compile - (defvar nnrss-group-alist) (defun nnrss-discover-feed (arg)) (defun nnrss-save-server-data (arg))) (defun gnus-group-make-rss-group (&optional url) @@ -2758,25 +2906,23 @@ If there is, use Gnus to create an nnrss group" (setq url (read-from-minibuffer "URL to Search for RSS: "))) (let ((feedinfo (nnrss-discover-feed url))) (if feedinfo - (let ((title (gnus-newsgroup-savable-name - (read-from-minibuffer "Title: " - (gnus-newsgroup-savable-name - (or (cdr (assoc 'title - feedinfo)) - ""))))) - (desc (read-from-minibuffer "Description: " - (cdr (assoc 'description - feedinfo)))) - (href (cdr (assoc 'href feedinfo))) - (encodable (mm-coding-system-p 'utf-8))) - (when encodable + (let* ((title (gnus-newsgroup-savable-name + (read-from-minibuffer "Title: " + (gnus-newsgroup-savable-name + (or (cdr (assoc 'title + feedinfo)) + ""))))) + (desc (read-from-minibuffer "Description: " + (cdr (assoc 'description + feedinfo)))) + (href (cdr (assoc 'href feedinfo))) + (coding (gnus-group-name-charset '(nnrss "") title))) + (when coding ;; Unify non-ASCII text. (setq title (mm-decode-coding-string - (mm-encode-coding-string title 'utf-8) 'utf-8))) - (gnus-group-make-group (if encodable - (mm-encode-coding-string title 'utf-8) - title) - '(nnrss "")) + (mm-encode-coding-string title coding) + coding))) + (gnus-group-make-group title '(nnrss "")) (push (list title href desc) nnrss-group-alist) (nnrss-save-server-data nil)) (error "No feeds found for %s" url)))) @@ -2836,7 +2982,7 @@ Given a prefix, create a full group." (defun gnus-group-make-directory-group (dir) "Create an nndir group. The user will be prompted for a directory. The contents of this -directory will be used as a newsgroup. The directory should contain +directory will be used as a newsgroup. The directory should contain mail messages or news articles in files that have numeric names." (interactive (list (read-file-name "Create group from directory: "))) @@ -3171,7 +3317,7 @@ sort in reverse order." (defun gnus-group-sort-by-unread (info1 info2) "Sort by number of unread articles." (let ((n1 (gnus-group-unread (gnus-info-group info1))) - (n2 (gnus-group-unread (gnus-info-group info1)))) + (n2 (gnus-group-unread (gnus-info-group info2)))) (< (or (and (numberp n1) n1) 0) (or (and (numberp n2) n2) 0)))) @@ -3291,13 +3437,15 @@ up is returned." (when (eq 'nnvirtual (car method)) (nnvirtual-catchup-group (gnus-group-real-name group) (nth 1 method) all))) - (if (>= (gnus-group-level group) gnus-level-zombie) - (gnus-message 2 "Dead groups can't be caught up") - (if (prog1 - (gnus-group-goto-group group) - (gnus-group-catchup group all)) - (gnus-group-update-group-line) - (setq ret (1+ ret))))) + (cond + ((>= (gnus-group-level group) gnus-level-zombie) + (gnus-message 2 "Dead groups can't be caught up")) + ((prog1 + (gnus-group-goto-group group) + (gnus-group-catchup group all)) + (gnus-group-update-group-line)) + (t + (setq ret (1+ ret))))) (gnus-group-next-unread-group 1) ret))) @@ -3335,10 +3483,12 @@ or nil if no action could be taken." (gnus-add-marked-articles group 'dormant nil nil 'force)) ;; Do auto-expirable marks if that's required. (when (gnus-group-auto-expirable-p group) - (gnus-range-map (lambda (article) - (gnus-add-marked-articles group 'expire (list article)) - (gnus-request-set-mark group (list (list (list article) 'add '(expire))))) - unread)) + (gnus-range-map + (lambda (article) + (gnus-add-marked-articles group 'expire (list article)) + (gnus-request-set-mark group (list (list (list article) + 'add '(expire))))) + unread)) (let ((gnus-newsgroup-name group)) (gnus-run-hooks 'gnus-group-catchup-group-hook)) num))) @@ -3466,12 +3616,8 @@ If given numerical prefix, toggle the N next groups." "Toggle subscription to GROUP. Killed newsgroups are subscribed. If SILENT, don't try to update the group line." - (interactive - (list (completing-read - "Group: " gnus-active-hashtb nil - (gnus-read-active-file-p) - nil - 'gnus-group-history))) + (interactive (list (gnus-group-completing-read + "Group: " nil nil (gnus-read-active-file-p)))) (let ((newsrc (gnus-group-entry group))) (cond ((string-match "^[ \t]*$" group) @@ -3504,7 +3650,7 @@ group line." (defun gnus-group-transpose-groups (n) "Move the current newsgroup up N places. -If given a negative prefix, move down instead. The difference between +If given a negative prefix, move down instead. The difference between N and the number of steps taken is returned." (interactive "p") (unless (gnus-group-group-name) @@ -3755,7 +3901,10 @@ re-scanning. If ARG is non-nil and not a number, this will force ;; We might read in new NoCeM messages here. (when (and gnus-use-nocem - (null arg)) + (or (and (numberp gnus-use-nocem) + (numberp arg) + (>= arg gnus-use-nocem)) + (not arg))) (gnus-nocem-scan-groups)) ;; If ARG is not a number, then we read the active file. (when (and arg (not (numberp arg))) @@ -3855,7 +4004,7 @@ to use." If given a prefix argument, prompt for a group." (interactive (list (or (when current-prefix-arg - (completing-read "Group: " gnus-active-hashtb)) + (gnus-group-completing-read "Group: ")) (gnus-group-group-name) gnus-newsgroup-name))) (unless group @@ -3883,7 +4032,7 @@ If given a prefix argument, prompt for a 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-completing-read "Group: ")) (gnus-group-group-name) gnus-newsgroup-name))) (unless group @@ -4109,12 +4258,12 @@ The hook `gnus-suspend-gnus-hook' is called before actually suspending." (gnus-offer-save-summaries) ;; Kill Gnus buffers except for group mode buffer. (let ((group-buf (get-buffer gnus-group-buffer))) - (mapcar (lambda (buf) - (unless (or (member buf (list group-buf gnus-dribble-buffer)) - (with-current-buffer buf - (eq major-mode 'message-mode))) - (gnus-kill-buffer buf))) - (gnus-buffers)) + (dolist (buf (gnus-buffers)) + (unless (or (eq buf group-buf) + (eq buf gnus-dribble-buffer) + (with-current-buffer buf + (eq major-mode 'message-mode))) + (gnus-kill-buffer buf))) (setq gnus-backlog-articles nil) (gnus-kill-gnus-frames) (when group-buf @@ -4214,7 +4363,7 @@ and the second element is the address." (unless entry (error "Trying to change non-existent group %s" method-only-group)) ;; We have received parts of the actual group info - either the - ;; select method or the group parameters. We first check + ;; select method or the group parameters. We first check ;; whether we have to extend the info, and if so, do that. (let ((len (length info)) (total (if (eq part 'method) 5 6))) @@ -4239,9 +4388,10 @@ and the second element is the address." (if (stringp method) method (prin1-to-string (car method))) (and (consp method) - (nth 1 (gnus-info-method info)))) + (nth 1 (gnus-info-method info))) + nil t) ;; It's a native group. - (gnus-group-make-group (gnus-info-group info)))) + (gnus-group-make-group (gnus-info-group info) nil nil nil t))) (gnus-message 6 "Note: New group created") (setq entry (gnus-group-entry (gnus-group-prefixed-name