From: Katsumi Yamaoka Date: Wed, 1 Aug 2007 11:07:24 +0000 (+0000) Subject: * gnus-group.el (gnus-group-name-at-point): Rewrite; rename from X-Git-Url: https://cgit.sxemacs.org/?p=gnus;a=commitdiff_plain;h=6651aa07343dec74a216dea4bee91fb8c283ee78 * gnus-group.el (gnus-group-name-at-point): Rewrite; rename from group-name-at-point. (gnus-group-completing-read): New function that offers decoded non-ASCII group names for completion. (gnus-fetch-group, gnus-group-read-ephemeral-group) (gnus-group-jump-to-group, gnus-group-make-group-simple) (gnus-group-unsubscribe-group, gnus-group-fetch-charter) (gnus-group-fetch-control): Use it. (gnus-fetch-group): Use group-name-at-point for the initial value rather than the default value; use gnus-alive-p. * gnus-msg.el (gnus-group-mail, gnus-group-news, gnus-group-post-news) (gnus-summary-mail-other-window, gnus-summary-news-other-window) (gnus-summary-post-news): Use gnus-group-completing-read. * gnus-sum.el (gnus-select-newsgroup): Decode group name in error msg. (gnus-read-move-group-name): Decode group name for completion. --- diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 0cf27231b..f1301b670 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,23 @@ +2007-08-01 Katsumi Yamaoka + + * gnus-group.el (gnus-group-name-at-point): Rewrite; rename from + group-name-at-point. + (gnus-group-completing-read): New function that offers decoded + non-ASCII group names for completion. + (gnus-fetch-group, gnus-group-read-ephemeral-group) + (gnus-group-jump-to-group, gnus-group-make-group-simple) + (gnus-group-unsubscribe-group, gnus-group-fetch-charter) + (gnus-group-fetch-control): Use it. + (gnus-fetch-group): Use group-name-at-point for the initial value + rather than the default value; use gnus-alive-p. + + * gnus-msg.el (gnus-group-mail, gnus-group-news, gnus-group-post-news) + (gnus-summary-mail-other-window, gnus-summary-news-other-window) + (gnus-summary-post-news): Use gnus-group-completing-read. + + * gnus-sum.el (gnus-select-newsgroup): Decode group name in error msg. + (gnus-read-move-group-name): Decode group name for completion. + 2007-07-31 Ted Zlatanov * gnus-srvr.el (gnus-server-close-all-servers): Close servers not only diff --git a/lisp/gnus-group.el b/lisp/gnus-group.el index c647bfc47..cec5a2cf9 100644 --- a/lisp/gnus-group.el +++ b/lisp/gnus-group.el @@ -2113,28 +2113,78 @@ be permanent." (gnus-group-read-ephemeral-group (gnus-group-prefixed-name group method) method))) -(defun group-name-at-point () - (let ((regexp "[^-a-zA-Z+.:_]")) - (save-excursion - (buffer-substring - (progn - (re-search-backward regexp nil t) - (forward-char 1) - (point)) - (progn - (re-search-forward regexp nil t) - (forward-char -1) - (point)))))) +(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 "[\t ]*\\(nn[a-z]+\\(?:\\+[^][\C-@-*,/:-@\\^`{-\C-?]+\\)?:\ +\[^][\C-@-*,./:-@\\^`{-\C-?]+\\(?:\\.[^][\C-@-*,./:-@\\^`{-\C-?]+\\)*\ +\\|[^][\C-@-*,./:-@\\^`{-\C-?]+\\(?:\\.[^][\C-@-*,./:-@\\^`{-\C-?]+\\)+\\)") + (start (point)) + (case-fold-search nil)) + (prog1 + (if (or (and (not (memq (char-after) '(?\t ?\n ? ))) + (skip-chars-backward "^\t ")) + (and (looking-at "[\t ]*$") + (progn + (skip-chars-backward "\t ") + (skip-chars-backward "^\t "))) + (string-match "\\`[\t ]*\\'" (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 "\t ") + (skip-chars-backward "^\t ") + (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 - nil nil nil nil - (group-name-at-point)))) - (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 (if articles nil t) nil group articles)) @@ -2194,10 +2244,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) @@ -2249,17 +2296,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")) @@ -2450,12 +2494,10 @@ 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 encoded) "Add a new newsgroup. @@ -3538,12 +3580,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) @@ -3930,7 +3968,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 @@ -3958,7 +3996,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 diff --git a/lisp/gnus-msg.el b/lisp/gnus-msg.el index 7f20cf73f..1edb60f34 100644 --- a/lisp/gnus-msg.el +++ b/lisp/gnus-msg.el @@ -580,9 +580,9 @@ If ARG is 1, prompt for a group name to find the posting style." (setq gnus-newsgroup-name (if arg (if (= 1 (prefix-numeric-value arg)) - (completing-read "Use posting style of group: " - gnus-active-hashtb nil - (gnus-read-active-file-p)) + (gnus-group-completing-read + "Use posting style of group: " + nil nil (gnus-read-active-file-p)) (gnus-group-group-name)) "")) ;; #### see comment in gnus-setup-message -- drv @@ -611,9 +611,9 @@ network. The corresponding back end must have a 'request-post method." (setq gnus-newsgroup-name (if arg (if (= 1 (prefix-numeric-value arg)) - (completing-read "Use group: " - gnus-active-hashtb nil - (gnus-read-active-file-p)) + (gnus-group-completing-read "Use group: " + nil nil + (gnus-read-active-file-p)) (gnus-group-group-name)) "")) ;; #### see comment in gnus-setup-message -- drv @@ -633,8 +633,8 @@ a news." (let ((gnus-newsgroup-name (if arg (if (= 1 (prefix-numeric-value arg)) - (completing-read "Newsgroup: " gnus-active-hashtb nil - (gnus-read-active-file-p)) + (gnus-group-completing-read "Newsgroup: " nil nil + (gnus-read-active-file-p)) (gnus-group-group-name)) "")) ;; make sure last viewed article doesn't affect posting styles: @@ -659,9 +659,9 @@ posting style." (setq gnus-newsgroup-name (if arg (if (= 1 (prefix-numeric-value arg)) - (completing-read "Use group: " - gnus-active-hashtb nil - (gnus-read-active-file-p)) + (gnus-group-completing-read "Use group: " + nil nil + (gnus-read-active-file-p)) "") gnus-newsgroup-name)) ;; #### see comment in gnus-setup-message -- drv @@ -690,9 +690,9 @@ network. The corresponding back end must have a 'request-post method." (setq gnus-newsgroup-name (if arg (if (= 1 (prefix-numeric-value arg)) - (completing-read "Use group: " - gnus-active-hashtb nil - (gnus-read-active-file-p)) + (gnus-group-completing-read "Use group: " + nil nil + (gnus-read-active-file-p)) "") gnus-newsgroup-name)) ;; #### see comment in gnus-setup-message -- drv @@ -717,8 +717,8 @@ a news." (let ((gnus-newsgroup-name (if arg (if (= 1 (prefix-numeric-value arg)) - (completing-read "Newsgroup: " gnus-active-hashtb nil - (gnus-read-active-file-p)) + (gnus-group-completing-read "Newsgroup: " nil nil + (gnus-read-active-file-p)) "") gnus-newsgroup-name)) ;; make sure last viewed article doesn't affect posting styles: diff --git a/lisp/gnus-sum.el b/lisp/gnus-sum.el index 57398f1d0..b74f72240 100644 --- a/lisp/gnus-sum.el +++ b/lisp/gnus-sum.el @@ -5397,26 +5397,30 @@ If SELECT-ARTICLES, only select those articles from GROUP." t gnus-summary-ignore-duplicates)) (info (nth 2 entry)) - articles fetched-articles cached) + charset articles fetched-articles cached) (unless (gnus-check-server (set (make-local-variable 'gnus-current-select-method) (gnus-find-method-for-group group))) (error "Couldn't open server")) + (setq charset (gnus-group-name-charset gnus-current-select-method group)) (or (and entry (not (eq (car entry) t))) ; Either it's active... (gnus-activate-group group) ; Or we can activate it... (progn ; Or we bug out. (when (equal major-mode 'gnus-summary-mode) (gnus-kill-buffer (current-buffer))) - (error "Couldn't activate group %s: %s" - (gnus-group-decoded-name group) (gnus-status-message group)))) + (error + "Couldn't activate group %s: %s" + (mm-decode-coding-string group charset) + (mm-decode-coding-string (gnus-status-message group) charset)))) (unless (gnus-request-group group t) - (when (equal major-mode 'gnus-summary-mode) - (gnus-kill-buffer (current-buffer))) - (error "Couldn't request group %s: %s" - (gnus-group-decoded-name group) (gnus-status-message group))) + (when (equal major-mode 'gnus-summary-mode) + (gnus-kill-buffer (current-buffer))) + (error "Couldn't request group %s: %s" + (mm-decode-coding-string group charset) + (mm-decode-coding-string (gnus-status-message group) charset))) (when gnus-agent (gnus-agent-possibly-alter-active group (gnus-active group) info) @@ -11702,27 +11706,28 @@ save those articles instead." (format "these %d articles" (length articles)) "this article"))) (to-newsgroup - (cond - ((null split-name) - (gnus-completing-read-with-default - default prom - gnus-active-hashtb - 'gnus-valid-move-group-p - nil prefix - 'gnus-group-history)) - ((= 1 (length split-name)) - (gnus-completing-read-with-default - (car split-name) prom - gnus-active-hashtb - 'gnus-valid-move-group-p - nil nil - 'gnus-group-history)) - (t - (gnus-completing-read-with-default - nil prom - (mapcar 'list (nreverse split-name)) - nil nil nil - 'gnus-group-history)))) + (let (active group) + (when (or (null split-name) (= 1 (length split-name))) + (setq active (gnus-make-hashtable (length gnus-active-hashtb))) + (mapatoms (lambda (symbol) + (setq group (symbol-name symbol)) + (when (string-match "[^\000-\177]" group) + (setq group (gnus-group-decoded-name group))) + (set (intern group active) group)) + gnus-active-hashtb)) + (cond + ((null split-name) + (gnus-completing-read-with-default + default prom active 'gnus-valid-move-group-p nil prefix + 'gnus-group-history)) + ((= 1 (length split-name)) + (gnus-completing-read-with-default + (car split-name) prom active 'gnus-valid-move-group-p nil nil + 'gnus-group-history)) + (t + (gnus-completing-read-with-default + nil prom (mapcar 'list (nreverse split-name)) nil nil nil + 'gnus-group-history))))) (to-method (gnus-server-to-method (gnus-group-method to-newsgroup))) encoded) (when to-newsgroup