X-Git-Url: https://cgit.sxemacs.org/?p=gnus;a=blobdiff_plain;f=lisp%2Fgnus-group.el;h=2ea5cce784697c9ea2c44016228b15929709d5c2;hp=96ac90b1a7c780e98f2cd866910a59f81a0218ae;hb=6596e287aaa6b58bc2603bc113a99ee22a924381;hpb=35ee30ec6b59b0c6739457816fda27c07491cfa0 diff --git a/lisp/gnus-group.el b/lisp/gnus-group.el index 96ac90b1a..2ea5cce78 100644 --- a/lisp/gnus-group.el +++ b/lisp/gnus-group.el @@ -548,8 +548,6 @@ simple manner.") (defvar gnus-group-list-mode nil) -(defvar gnus-group-icon-cache nil) - (defvar gnus-group-listed-groups nil) (defvar gnus-group-list-option nil) @@ -739,10 +737,8 @@ simple manner.") "e" gnus-score-edit-all-score) (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) (gnus-define-keys (gnus-group-sub-map "S" gnus-group-mode-map) @@ -808,11 +804,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 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 @@ -2173,44 +2164,35 @@ be permanent." group))) (goto-char start))))) -(defun gnus-group-completing-read (prompt &optional collection predicate - require-match initial-input hist def - &rest args) +(defun gnus-group-completing-read (&optional prompt collection + require-match initial-input hist def) "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 ((completion-styles (and (boundp 'completion-styles) - completion-styles)) - group) - (push 'substring completion-styles) - (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))))) + (let* ((collection (or collection (or gnus-active-hashtb [0]))) + (choices (mapcar (lambda (symbol) + (let ((group (symbol-name symbol))) + (if (string-match "[^\000-\177]" group) + (gnus-group-decoded-name group) + group))) + (remove-if-not 'symbolp collection))) + (group + (gnus-completing-read (or prompt "Group") choices + require-match initial-input + (or hist 'gnus-group-history) + def))) + (if (symbol-value (intern-soft group collection)) + group + (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 (gnus-group-completing-read "Group name: " - nil nil nil + (interactive (list (gnus-group-completing-read nil + nil nil (gnus-group-name-at-point)))) (unless (gnus-alive-p) (gnus-no-server)) @@ -2229,8 +2211,6 @@ Returns whether the fetching was successful or not." (other-frame 1)))) (gnus-fetch-group group)) -(defvar gnus-ephemeral-group-server 0) - (defcustom gnus-large-ephemeral-newsgroup 200 "The number of articles which indicates a large ephemeral newsgroup. Same as `gnus-large-newsgroup', but only used for ephemeral newsgroups. @@ -2272,7 +2252,7 @@ Return the name of the group if selection was successful." (interactive (list ;; (gnus-read-group "Group name: ") - (gnus-group-completing-read "Group: ") + (gnus-group-completing-read) (gnus-read-method "From method: "))) ;; Transform the select method into a unique server. (when (stringp method) @@ -2339,7 +2319,7 @@ specified by `gnus-gmane-group-download-format'." ;; See for more information. (interactive (list - (gnus-group-completing-read "Gmane group: ") + (gnus-group-completing-read "Gmane group") (read-number "Start article number: ") (read-number "How many articles: "))) (unless range (setq range 500)) @@ -2373,7 +2353,7 @@ Valid input formats include: ;; prompt the user to decide: "View via `browse-url' or in Gnus? " ;; (`gnus-read-ephemeral-gmane-group-url') (interactive - (list (gnus-group-completing-read "Gmane URL: "))) + (list (gnus-group-completing-read "Gmane URL"))) (let (group start range) (cond ;; URLs providing `group', `start' and `range': @@ -2429,6 +2409,14 @@ the bug number, and browsing the URL must return mbox output." (let ((tmpfile (mm-make-temp-file "gnus-temp-group-"))) (with-temp-file tmpfile (url-insert-file-contents (format mbox-url number)) + (goto-char (point-min)) + ;; Add the debbugs address so that we can respond to reports easily. + (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))))) (write-region (point-min) (point-max) tmpfile) (gnus-group-read-ephemeral-group "gnus-read-ephemeral-bug" @@ -2459,13 +2447,13 @@ If PROMPT (the prefix) is a number, use the prompt specified in `gnus-group-jump-to-group-prompt'." (interactive (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))))))) + 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")) @@ -2656,7 +2644,7 @@ 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 (gnus-group-completing-read "Group: "))) + (interactive (list (gnus-group-completing-read))) (gnus-group-make-group (gnus-group-real-name group) (gnus-group-server group) nil nil t)) @@ -2915,8 +2903,9 @@ and NEW-NAME will be prompted for." (defun gnus-group-make-useful-group (group method) "Create one of the groups described in `gnus-useful-groups'." (interactive - (let ((entry (assoc (completing-read "Create group: " gnus-useful-groups - nil t) + (let ((entry (assoc (gnus-completing-read "Create group" + (mapcar 'car gnus-useful-groups) + t) gnus-useful-groups))) (list (cadr entry) ;; Don't use `caddr' here since macros within the `interactive' @@ -3008,11 +2997,11 @@ If SOLID (the prefix), create a solid group." (symbol-name (caar nnweb-type-definition)))) (type (gnus-string-or - (completing-read - (format "Search engine type (default %s): " default-type) - (mapcar (lambda (elem) (list (symbol-name (car elem)))) + (gnus-completing-read + "Search engine type" + (mapcar (lambda (elem) (symbol-name (car elem))) nnweb-type-definition) - nil t nil 'gnus-group-web-type-history) + t nil 'gnus-group-web-type-history) default-type)) (search (read-string @@ -3103,8 +3092,8 @@ mail messages or news articles in files that have numeric names." "Add the current group to a virtual group." (interactive (list current-prefix-arg - (completing-read "Add to virtual group: " gnus-newsrc-hashtb nil t - "nnvirtual:"))) + (gnus-group-completing-read "Add to virtual group" + nil t "nnvirtual:"))) (unless (eq (car (gnus-find-method-for-group vgroup)) 'nnvirtual) (error "%s is not an nnvirtual group" vgroup)) (gnus-close-group vgroup) @@ -3675,7 +3664,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 - "Group: " nil nil (gnus-read-active-file-p)))) + nil (gnus-read-active-file-p)))) (let ((newsrc (gnus-group-entry group))) (cond ((string-match "^[ \t]*$" group) @@ -3957,14 +3946,6 @@ re-scanning. If ARG is non-nil and not a number, this will force (unless gnus-slave (gnus-master-read-slave-newsrc)) - ;; We might read in new NoCeM messages here. - (when (and gnus-use-nocem - (or (and (numberp gnus-use-nocem) - (numberp arg) - (>= arg gnus-use-nocem)) - (not arg))) - (gnus-nocem-scan-groups)) - (gnus-get-unread-articles arg) ;; If the user wants it, we scan for new groups. @@ -4019,68 +4000,12 @@ If DONT-SCAN is non-nil, scan non-activated groups as well." (gnus-summary-position-point) ret)) -(defun gnus-group-fetch-faq (group &optional faq-dir) - "Fetch the FAQ for the current group. -If given a prefix argument, prompt for the FAQ dir -to use." - (interactive - (list - (gnus-group-group-name) - (when current-prefix-arg - (completing-read - "FAQ dir: " (and (listp gnus-group-faq-directory) - (mapcar #'list - gnus-group-faq-directory)))))) - (unless group - (error "No group name given")) - (let ((dirs (or faq-dir gnus-group-faq-directory)) - dir found file) - (unless (listp dirs) - (setq dirs (list dirs))) - (while (and (not found) - (setq dir (pop dirs))) - (let ((name (gnus-group-real-name group))) - (setq file (expand-file-name name dir))) - (if (not (file-exists-p file)) - (gnus-message 1 "No such file: %s" file) - (let ((enable-local-variables nil)) - (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 - (gnus-group-completing-read "Group: ")) - (gnus-group-group-name) - gnus-newsgroup-name))) - (unless group - (error "No group name given")) - (require 'mm-url) - (condition-case nil (require 'url-http) (error nil)) - (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 (and (setq url (cdr (assoc hierarchy gnus-group-charter-alist))) - (if (fboundp 'url-http-file-exists-p) - (url-http-file-exists-p (eval url)) - t)) - (browse-url (eval url)) - (setq url (concat "http://" hierarchy - ".news-admin.org/charters/" name)) - (if (and (fboundp 'url-http-file-exists-p) - (url-http-file-exists-p url)) - (browse-url 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 - (gnus-group-completing-read "Group: ")) + (gnus-group-completing-read)) (gnus-group-group-name) gnus-newsgroup-name))) (unless group @@ -4381,18 +4306,18 @@ If called interactively, this function will ask for a select method If not, METHOD should be a list where the first element is the method and the second element is the address." (interactive - (list (let ((how (completing-read - "Which back end: " - (append gnus-valid-select-methods gnus-server-alist) - nil t (cons "nntp" 0) 'gnus-method-history))) + (list (let ((how (gnus-completing-read + "Which back end" + (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. (if (assoc how gnus-valid-select-methods) (list (intern how) ;; Suggested by mapjph@bath.ac.uk. - (completing-read - "Address: " - (mapcar 'list gnus-secondary-servers))) + (gnus-completing-read + "Address" + gnus-secondary-servers)) ;; We got a server name. how)))) (gnus-browse-foreign-server method))