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-08-01 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * 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 <tzz@lifelogs.com>
* gnus-srvr.el (gnus-server-close-all-servers): Close servers not only
(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))
(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)
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"))
(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.
"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)
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
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
(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
(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
(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:
(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
(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
(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:
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)
(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
projects / gnus / commitdiff