From mboxrd@z Thu Jan 1 00:00:00 1970 X-Msuck: nntp://news.gmane.io/gmane.emacs.gnus.general/72135 Path: news.gmane.org!not-for-mail From: Florian Ragwitz Newsgroups: gmane.emacs.gnus.general Subject: Re: [PATCH] Introduce gnus-completing-read Date: Tue, 28 Sep 2010 21:31:09 +0200 Message-ID: <87eicdacn6.fsf@tardis.home.perldition.org> References: <1285688153-19680-1-git-send-email-julien@danjou.info> <87wrq5ammm.fsf@tardis.home.perldition.org> NNTP-Posting-Host: lo.gmane.org Mime-Version: 1.0 Content-Type: multipart/signed; boundary="==-=-="; micalg=pgp-sha1; protocol="application/pgp-signature" X-Trace: dough.gmane.org 1285702345 8102 80.91.229.12 (28 Sep 2010 19:32:25 GMT) X-Complaints-To: usenet@dough.gmane.org NNTP-Posting-Date: Tue, 28 Sep 2010 19:32:25 +0000 (UTC) To: ding@gnus.org Original-X-From: ding-owner+M20508@lists.math.uh.edu Tue Sep 28 21:32:22 2010 Return-path: Envelope-to: ding-account@gmane.org Original-Received: from util0.math.uh.edu ([129.7.128.18]) by lo.gmane.org with esmtp (Exim 4.69) (envelope-from ) id 1P0fuX-0003es-AF for ding-account@gmane.org; Tue, 28 Sep 2010 21:32:22 +0200 Original-Received: from localhost ([127.0.0.1] helo=lists.math.uh.edu) by util0.math.uh.edu with smtp (Exim 4.63) (envelope-from ) id 1P0fuO-00052w-JF; Tue, 28 Sep 2010 14:32:12 -0500 Original-Received: from mx2.math.uh.edu ([129.7.128.33]) by util0.math.uh.edu with esmtps (TLSv1:AES256-SHA:256) (Exim 4.63) (envelope-from ) id 1P0fuL-00052e-55 for ding@lists.math.uh.edu; Tue, 28 Sep 2010 14:32:09 -0500 Original-Received: from quimby.gnus.org ([80.91.231.51]) by mx2.math.uh.edu with esmtp (Exim 4.72) (envelope-from ) id 1P0fuH-0001LS-21 for ding@lists.math.uh.edu; Tue, 28 Sep 2010 14:32:09 -0500 Original-Received: from kief.perldition.org ([78.47.20.161]) by quimby.gnus.org with esmtp (Exim 3.36 #1 (Debian)) id 1P0fuG-0003W5-00 for ; Tue, 28 Sep 2010 21:32:04 +0200 Original-Received: from p4fd76c8a.dip.t-dialin.net ([79.215.108.138] helo=tardis.home.perldition.org) by kief.perldition.org with esmtpsa (TLS1.0:RSA_AES_256_CBC_SHA1:32) (Exim 4.69) (envelope-from ) id 1P0fuA-0002We-1h for ding@gnus.org; Tue, 28 Sep 2010 21:32:03 +0200 Original-Received: from rafl by tardis.home.perldition.org with local (Exim 4.72) (envelope-from ) id 1P0ftP-00041I-Va for ding@gnus.org; Tue, 28 Sep 2010 21:31:12 +0200 Mail-Copies-To: never In-Reply-To: (Julien Danjou's message of "Tue, 28 Sep 2010 18:04:12 +0200") User-Agent: Gnus/5.110011 (No Gnus v0.11) Emacs/23.2 (gnu/linux) X-Spam_score: -3.8 X-Spam_score_int: -37 X-Spam_bar: --- X-Spam_report: Spam detection software, running on the system "kief.perldition.org", has identified this incoming email as possible spam. The original message has been attached to this so you can view it (if it isn't spam) or label similar future email. If you have any questions, see the administrator of that system for details. Content preview: Julien Danjou writes: > On Tue, Sep 28 2010, Florian Ragwitz wrote: > >> This is what I did a couple of months back for pod-mode.el. I believe it >> makes for nicer customisation. If you like this as well, I'd be happy to >> prepare an updated patch using the above, and extending it also support >> REQUIRE-MATCH, INITIAL-INPUT, HISTORY, etc. > > I like that. Please, go ahead! [...] Content analysis details: (-3.8 points, 5.0 required) pts rule name description ---- ---------------------- ------ X-Spam-Score: -0.4 (/) List-ID: Precedence: bulk Xref: news.gmane.org gmane.emacs.gnus.general:72135 Archived-At: --==-=-= Content-Type: multipart/mixed; boundary="=-=-=" --=-=-= Content-Type: text/plain Julien Danjou writes: > On Tue, Sep 28 2010, Florian Ragwitz wrote: > >> This is what I did a couple of months back for pod-mode.el. I believe it >> makes for nicer customisation. If you like this as well, I'd be happy to >> prepare an updated patch using the above, and extending it also support >> REQUIRE-MATCH, INITIAL-INPUT, HISTORY, etc. > > I like that. Please, go ahead! Here's a patch adding what I've been talking about on top of your patch. Note that gnus-icompleting-read ignores its HISTORY argument. I haven't quite figured out how to do that, assuming iswitchb supports some sort of history at all. However, it's already useful to me as is, as I can make use of all my iswitchb customisations while only missing out on a feature I don't particularly care about. --=-=-= Content-Type: text/x-diff Content-Disposition: inline; filename=0001-Make-completing-read-function-configurable.patch Content-Transfer-Encoding: quoted-printable Content-Description: Make completing-read function configurable From=207ed22dee4f254d7af4223213dd8c05b00ca8429d Mon Sep 17 00:00:00 2001 From: Florian Ragwitz Date: Tue, 28 Sep 2010 21:24:45 +0200 Subject: [PATCH] Make completing-read function configurable Also provide some default implementations using completing-read, iswitchb, and ido-completing-read. =2D-- lisp/ChangeLog | 11 ++++++++++ lisp/gnus-util.el | 56 +++++++++++++++++++++++++++++++++++++++++++------= --- 2 files changed, 57 insertions(+), 10 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index d5546f9..f3e5a54 100644 =2D-- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,14 @@ +2010-09-28 Florian Ragwitz + + * gnus-util.el (gnus-use-ido): Removed. + (gnus-std-completing-read): Add wrapper around completing-read. + (gnus-icompleting-read): Add wrapper around ibuffer-read-buffer. + (gnus-ido-completing-read): Add wrapper around ido-completing-read. + (gnus-completing-read-function): Add to chose from the above completion + functions or to provide a custom one. + (gnus-completing-read): Use the completing-read function configured + with gnus-completing-read-function. + 2010-09-28 Katsumi Yamaoka =20 * mail-source.el (mail-source-report-new-mail) diff --git a/lisp/gnus-util.el b/lisp/gnus-util.el index d188eba..1c390c7 100644 =2D-- a/lisp/gnus-util.el +++ b/lisp/gnus-util.el @@ -44,11 +44,18 @@ (defmacro with-no-warnings (&rest body) `(progn ,@body)))) =20 =2D(defcustom gnus-use-ido nil =2D "Whether to use `ido' for `completing-read'." =2D :version "24.1" +(defcustom gnus-completing-read-function + #'gnus-std-completing-read + "Function to do a completing read." :group 'gnus-meta =2D :type 'boolean) + :type '(radio (function-item + :doc "Use Emacs' standard `completing-read' function." + gnus-std-completing-read) + (function-item :doc "Use iswitchb's completing-read functi= on." + gnus-icompleting-read) + (function-item :doc "Use ido's completing-read function." + gnus-ido-completing-read) + (function))) =20 (defcustom gnus-completion-styles (if (and (boundp 'completion-styles-alist) @@ -1583,19 +1590,48 @@ SPEC is a predicate specifier that contains stuff l= ike `or', `and', `(,(car spec) ,@(mapcar 'gnus-make-predicate-1 (cdr spec))) (error "Invalid predicate specifier: %s" spec))))) =20 +(defun gnus-std-completing-read (prompt collection &optional require-match + initial-input history def) + (completing-read prompt collection nil require-match + initial-input history def)) + +(defun gnus-icompleting-read (prompt collection &optional require-match + initial-input history def) + (let ((iswitchb-make-buflist-hook + (lambda () + (setq iswitchb-temp-buflist + (let ((choices (append (list) + (when initial-input (list initial-= input)) + history collection)) + filtered-choices) + (while choices + (when (and (car choices) (not (member (car choices) f= iltered-choices))) + (setq filtered-choices (cons (car choices) filtered= -choices))) + (setq choices (cdr choices))) + (nreverse filtered-choices)))))) + (unwind-protect + (progn + (when (not iswitchb-mode) + (add-hook 'minibuffer-setup-hook 'iswitchb-minibuffer-setup)) + (iswitchb-read-buffer prompt def require-match)) + (when (not iswitchb-mode) + (remove-hook 'minibuffer-setup-hook 'iswitchb-minibuffer-setup))))) + +(defun gnus-ido-completing-read (prompt collection &optional require-match + initial-input history def) + (ido-completing-read prompt collection nil require-match + initial-input history def)) + (defun gnus-completing-read (prompt collection &optional require-match initial-input history def) =2D "Call `completing-read' or `ido-completing-read'. =2DDepends on `gnus-use-ido'." + "Do a completing read with the configured `gnus-completing-read-function= '." (let ((completion-styles gnus-completion-styles)) (funcall =2D (if gnus-use-ido =2D 'ido-completing-read =2D 'completing-read) + gnus-completing-read-function (concat prompt (when def (concat " (default " def ")")) ": ") =2D collection nil require-match initial-input history def))) + collection require-match initial-input history def))) =20 (defun gnus-graphic-display-p () (if (featurep 'xemacs) =2D-=20 1.7.1 --=-=-= Content-Type: text/plain Here's the same thing combined with your initial patch: --=-=-= Content-Type: text/x-diff Content-Disposition: inline; filename=0001-Introduce-gnus-completing-read.patch Content-Transfer-Encoding: quoted-printable Content-Description: Introduce gnus-completing-read From=2070b9d629b53480965639385faa352687a7ef61ca Mon Sep 17 00:00:00 2001 From: Julien Danjou Date: Tue, 28 Sep 2010 18:06:46 +0200 Subject: [PATCH] Introduce gnus-completing-read Signed-off-by: Julien Danjou Signed-off-by: Florian Ragwitz [rafl@debian.org: Added gnus-completing-read-function and iswitchb support] =2D-- lisp/ChangeLog | 87 +++++++++++++++++++++++++++++++++++++++++ lisp/gnus-agent.el | 11 ++--- lisp/gnus-art.el | 17 ++++---- lisp/gnus-bookmark.el | 4 +- lisp/gnus-diary.el | 8 ++-- lisp/gnus-dired.el | 8 +--- lisp/gnus-group.el | 104 ++++++++++++++++++++++-----------------------= --- lisp/gnus-int.el | 9 ++-- lisp/gnus-msg.el | 26 ++++++------ lisp/gnus-registry.el | 11 ++--- lisp/gnus-score.el | 27 +++++++------ lisp/gnus-srvr.el | 7 ++- lisp/gnus-sum.el | 75 ++++++++++++++--------------------- lisp/gnus-topic.el | 24 ++++++----- lisp/gnus-util.el | 93 ++++++++++++++++++++++++++++++++------------ lisp/gnus.el | 6 +- lisp/mm-decode.el | 4 +- lisp/mm-util.el | 14 +++--- lisp/mm-view.el | 9 ++-- lisp/mml-smime.el | 17 ++++---- lisp/mml.el | 26 +++++++------ lisp/nnir.el | 2 +- lisp/nnmairix.el | 26 ++++++------ lisp/nnrss.el | 6 +- lisp/smime.el | 18 +++----- 25 files changed, 371 insertions(+), 268 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index bb8269a..f3e5a54 100644 =2D-- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,14 @@ +2010-09-28 Florian Ragwitz + + * gnus-util.el (gnus-use-ido): Removed. + (gnus-std-completing-read): Add wrapper around completing-read. + (gnus-icompleting-read): Add wrapper around ibuffer-read-buffer. + (gnus-ido-completing-read): Add wrapper around ido-completing-read. + (gnus-completing-read-function): Add to chose from the above completion + functions or to provide a custom one. + (gnus-completing-read): Use the completing-read function configured + with gnus-completing-read-function. + 2010-09-28 Katsumi Yamaoka =20 * mail-source.el (mail-source-report-new-mail) @@ -17,6 +28,82 @@ * gnus-gravatar.el (gnus-gravatar-insert): Search backward for real-name, and then for mail address rather than doing : or , search. =20 +2010-09-27 Julien Danjou + + * gnus-srvr.el (gnus-server-add-server): Use gnus-completing-read. + (gnus-server-goto-server): Use gnus-completing-read. + + * mm-view.el (mm-view-pkcs7-decrypt): Use gnus-completing-read. + + * mm-util.el (defalias): Use gnus-completing-read. + (mm-codepage-setup): Use gnus-completing-read. + + * smime.el (smime-sign-buffer): Use gnus-completing-read. + (smime-decrypt-buffer): Use gnus-completing-read. + + * mml-smime.el (mml-smime-openssl-sign-query): Use gnus-completing-read. + + * mml.el (mml-minibuffer-read-type): Use gnus-completing-read. + (mml-minibuffer-read-disposition): Use gnus-completing-read. + (mml-insert-multipart): Use gnus-completing-read. + + * gnus-msg.el (gnus-summary-yank-message): Use gnus-completing-read. + + * gnus-int.el (gnus-start-news-server): Use gnus-completing-read. + + * mm-decode.el (mm-interactively-view-part): Use gnus-completing-read. + + * gnus-dired.el (gnus-dired-attach): Use gnus-completing-read. + + * gnus.el (gnus-read-method): Use gnus-completing-read. + + * gnus-bookmark.el (gnus-bookmark-jump): Use gnus-completing-read. + + * gnus-art.el (gnus-mime-view-part-as-type): Use gnus-completing-read. + (gnus-mime-action-on-part): Use gnus-completing-read. + (gnus-article-encrypt-body): Use gnus-completing-read. + + * gnus-topic.el (gnus-topic-jump-to-topic): Use gnus-completing-read. + (gnus-topic-move-matching): Use gnus-completing-read. + (gnus-topic-copy-matching): Use gnus-completing-read. + (gnus-topic-sort-topics): Use gnus-completing-read. + (gnus-topic-move): Use gnus-completing-read. + + * gnus-agent.el (gnus-agent-read-group): Remove prompt computing. + (gnus-agent-add-group): Use gnus-completing-read. + + * nnmairix.el (nnmairix-create-server-and-default-group): Use + gnus-completing-read. + (nnmairix-update-groups): Use gnus-completing-read. + (nnmairix-get-server): Use gnus-completing-read. + (nnmairix-backend-to-server): Use gnus-completing-read. + (nnmairix-goto-original-article): Use gnus-completing-read. + (nnmairix-get-group-from-file-path): Use gnus-completing-read. + + * nnrss.el (nnrss-find-rss-via-syndic8): Use gnus-completing-read. + + * gnus-group.el (gnus-group-completing-read): Use gnus-completing-read. + (gnus-group-make-useful-group): Use gnus-completing-read. + (gnus-group-make-web-group): Use gnus-completing-read. + (gnus-group-add-to-virtual): Use gnus-completing-read. + (gnus-group-browse-foreign-server): Use gnus-completing-read. + + * gnus-sum.el (gnus-summary-goto-article): Use gnus-completing-read. + (gnus-summary-limit-to-extra): Use gnus-completing-read. + (gnus-summary-execute-command): Use gnus-completing-read. + (gnus-summary-respool-article): Use gnus-completing-read. + (gnus-read-move-group-name): Use gnus-completing-read. + + * gnus-score.el (gnus-summary-increase-score): Use gnus-completing-read. + (gnus-summary-score-effect): Use gnus-completing-read. + + * gnus-registry.el (gnus-registry-read-mark): Use gnus-completing-read. + + * gnus-util.el (gnus-completing-read): Use gnus-use-ido to apply the + right completing-read function. + (gnus-use-ido): New variable + (gnus-completing-read-with-default): Remove. + 2010-09-28 Katsumi Yamaoka =20 * lpath.el: Remove url-http-file-exists-p, w32-focus-frame, and diff --git a/lisp/gnus-agent.el b/lisp/gnus-agent.el index 4788deb..8043620 100644 =2D-- a/lisp/gnus-agent.el +++ b/lisp/gnus-agent.el @@ -459,10 +459,7 @@ manipulated as follows: (let ((def (or (gnus-group-group-name) gnus-newsgroup-name))) (when def (setq def (gnus-group-decoded-name def))) =2D (gnus-group-completing-read (if def =2D (concat "Group Name (" def "): ") =2D "Group Name: ") =2D nil nil t nil nil def))) + (gnus-group-completing-read nil nil t nil nil def))) =20 ;;; Fetching setup functions. =20 @@ -816,9 +813,9 @@ be a select method." (interactive (list (intern =2D (completing-read =2D "Add to category: " =2D (mapcar (lambda (cat) (list (symbol-name (car cat)))) + (gnus-completing-read + "Add to category" + (mapcar (lambda (cat) (symbol-name (car cat))) gnus-category-alist) nil t)) current-prefix-arg)) diff --git a/lisp/gnus-art.el b/lisp/gnus-art.el index 6e5cd4d..4e2d43c 100644 =2D-- a/lisp/gnus-art.el +++ b/lisp/gnus-art.el @@ -5131,11 +5131,10 @@ available media-types." (unless mime-type (setq mime-type (let ((default (gnus-mime-view-part-as-type-internal))) =2D (completing-read =2D (format "View as MIME type (default %s): " =2D (car default)) =2D (mapcar #'list (mailcap-mime-types)) =2D pred nil nil nil + (gnus-completing-read + "View as MIME type" + (remove-if-not pred (mailcap-mime-types)) + nil nil nil (car default))))) (gnus-article-check-buffer) (let ((handle (get-text-property (point) 'gnus-data))) @@ -5404,7 +5403,7 @@ If no internal viewer is available, use an external v= iewer." (defun gnus-mime-action-on-part (&optional action) "Do something with the MIME attachment at \(point\)." (interactive =2D (list (completing-read "Action: " gnus-mime-action-alist nil t))) + (list (gnus-completing-read "Action" (mapcar 'car gnus-mime-action-alis= t) t))) (gnus-article-check-buffer) (let ((action-pair (assoc action gnus-mime-action-alist))) (if action-pair @@ -8370,9 +8369,9 @@ For example: (interactive (list (or gnus-article-encrypt-protocol =2D (completing-read "Encrypt protocol: " =2D gnus-article-encrypt-protocol-alist =2D nil t)) + (gnus-completing-read "Encrypt protocol" + (mapcar 'car gnus-article-encrypt-protocol-a= list) + t)) current-prefix-arg)) ;; User might hit `K E' instead of `K e', so prompt once. (when (and gnus-article-encrypt-protocol diff --git a/lisp/gnus-bookmark.el b/lisp/gnus-bookmark.el index 137479b..4237508 100644 =2D-- a/lisp/gnus-bookmark.el +++ b/lisp/gnus-bookmark.el @@ -289,8 +289,8 @@ So the cdr of each bookmark is an alist too.") (interactive) (gnus-bookmark-maybe-load-default-file) (let* ((bookmark (or bmk-name =2D (completing-read "Jump to bookmarked article: " =2D gnus-bookmark-alist))) + (gnus-completing-read "Jump to bookmarked article" + (mapcar 'car gnus-bookmark-al= ist)))) (bmk-record (cadr (assoc bookmark gnus-bookmark-alist))) (group (cdr (assoc 'group bmk-record))) (message-id (cdr (assoc 'message-id bmk-record)))) diff --git a/lisp/gnus-diary.el b/lisp/gnus-diary.el index 18130bb..76d469b 100644 =2D-- a/lisp/gnus-diary.el +++ b/lisp/gnus-diary.el @@ -368,11 +368,11 @@ If ARG (or prefix) is non-nil, force prompting for al= l fields." header ": "))) (setq value (if (listp (nth 1 head)) =2D (completing-read prompt (cons '("*" nil) (nth 1 head)) =2D nil t value =2D gnus-diary-header-value-history) + (gnus-completing-read prompt (cons '("*" nil) (nth 1 head)) + t value + 'gnus-diary-header-value-hist= ory) (read-string prompt value =2D gnus-diary-header-value-history)))) + 'gnus-diary-header-value-history)))) (setq ask nil) (setq invalid nil) (condition-case () diff --git a/lisp/gnus-dired.el b/lisp/gnus-dired.el index f9502b4..da20c66 100644 =2D-- a/lisp/gnus-dired.el +++ b/lisp/gnus-dired.el @@ -152,12 +152,8 @@ filenames." (setq destination (if (=3D (length bufs) 1) (get-buffer (car bufs)) =2D (completing-read "Attach to which mail composition buffer: " =2D (mapcar =2D (lambda (b) =2D (cons b (get-buffer b))) =2D bufs) =2D nil t))) + (gnus-completing-read "Attach to which mail composition buffer" + bufs t))) ;; setup a new mail composition buffer (let ((mail-user-agent gnus-dired-mail-mode) ;; A workaround to prevent Gnus from displaying the Gnus diff --git a/lisp/gnus-group.el b/lisp/gnus-group.el index 7dddb9b..eb594f3 100644 =2D-- a/lisp/gnus-group.el +++ b/lisp/gnus-group.el @@ -2164,44 +2164,35 @@ be permanent." group))) (goto-char start))))) =20 =2D(defun gnus-group-completing-read (prompt &optional collection predicate =2D require-match initial-input hist def =2D &rest args) +(defun gnus-group-completing-read (&optional prompt collection + require-match initial-input h= ist 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." =2D (let ((completion-styles (and (boundp 'completion-styles) =2D completion-styles)) =2D group) =2D (push 'substring completion-styles) =2D (mapatoms (lambda (symbol) =2D (setq group (symbol-name symbol)) =2D (set (intern (if (string-match "[^\000-\177]" group) =2D (gnus-group-decoded-name group) =2D group) =2D collection) =2D group)) =2D (prog1 =2D (or collection =2D (setq collection (or gnus-active-hashtb [0]))) =2D (setq collection (gnus-make-hashtable (length collection))))) =2D (setq group (apply 'completing-read prompt collection predicate =2D require-match initial-input =2D (or hist 'gnus-group-history) =2D def args)) =2D (or (prog1 =2D (symbol-value (intern-soft group collection)) =2D (setq collection nil)) =2D (mm-encode-coding-string group (gnus-group-name-charset nil group))))) + (let* ((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 + (or collection (or gnus-active-hashtb [0]))))) + (group + (gnus-completing-read (or prompt "Group") choices + require-match initial-input + (or hist 'gnus-group-history) + def))) + (or (symbol-value (intern-soft group collection)) + (mm-encode-coding-string group (gnus-group-name-charset nil group)= )))) =20 ;;;###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." =2D (interactive (list (gnus-group-completing-read "Group name: " =2D nil nil nil + (interactive (list (gnus-group-completing-read nil + nil nil (gnus-group-name-at-point)))) (unless (gnus-alive-p) (gnus-no-server)) @@ -2261,7 +2252,7 @@ Return the name of the group if selection was success= ful." (interactive (list ;; (gnus-read-group "Group name: ") =2D (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) @@ -2328,7 +2319,7 @@ specified by `gnus-gmane-group-download-format'." ;; See for more information. (interactive (list =2D (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)) @@ -2362,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 =2D (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': @@ -2456,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 =2D "Group: " nil nil (gnus-read-active-file-p) =2D (if current-prefix-arg =2D (cdr (assq current-prefix-arg gnus-group-jump-to-group-prompt)) =2D (or (and (stringp gnus-group-jump-to-group-prompt) =2D gnus-group-jump-to-group-prompt) =2D (let ((p (cdr (assq 0 gnus-group-jump-to-group-prompt)))) =2D (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-promp= t)) + (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))))))) =20 (when (equal group "") (error "Empty group name")) @@ -2653,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." =2D (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)) @@ -2912,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 =2D (let ((entry (assoc (completing-read "Create group: " gnus-useful-gro= ups =2D nil t) + (let ((entry (assoc (gnus-completing-read "Create group" + (mapcar 'car gnus-useful-grou= ps) + t) gnus-useful-groups))) (list (cadr entry) ;; Don't use `caddr' here since macros within the `interactive' @@ -3005,11 +2997,11 @@ If SOLID (the prefix), create a solid group." (symbol-name (caar nnweb-type-definition)))) (type (gnus-string-or =2D (completing-read =2D (format "Search engine type (default %s): " default-type) =2D (mapcar (lambda (elem) (list (symbol-name (car elem)))) + (gnus-completing-read + "Search engine type" + (mapcar (lambda (elem) (symbol-name (car elem))) nnweb-type-definition) =2D nil t nil 'gnus-group-web-type-history) + t nil 'gnus-group-web-type-history) default-type)) (search (read-string @@ -3100,8 +3092,8 @@ mail messages or news articles in files that have num= eric names." "Add the current group to a virtual group." (interactive (list current-prefix-arg =2D (completing-read "Add to virtual group: " gnus-newsrc-hashtb nil t =2D "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) @@ -3672,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 =2D "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) @@ -4013,7 +4005,7 @@ If DONT-SCAN is non-nil, scan non-activated groups as= well." If given a prefix argument, prompt for a group." (interactive (list (or (when current-prefix-arg =2D (gnus-group-completing-read "Group: ")) + (gnus-group-completing-read)) (gnus-group-group-name) gnus-newsgroup-name))) (unless group @@ -4314,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 =2D (list (let ((how (completing-read =2D "Which back end: " =2D (append gnus-valid-select-methods gnus-server-alist) =2D 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. =2D (completing-read =2D "Address: " =2D (mapcar 'list gnus-secondary-servers))) + (gnus-completing-read + "Address" + gnus-secondary-servers)) ;; We got a server name. how)))) (gnus-browse-foreign-server method)) diff --git a/lisp/gnus-int.el b/lisp/gnus-int.el index 3245b16..33d020f 100644 =2D-- a/lisp/gnus-int.el +++ b/lisp/gnus-int.el @@ -94,11 +94,10 @@ If CONFIRM is non-nil, the user will be asked for an NN= TP server." (when confirm ;; Read server name with completion. (setq gnus-nntp-server =2D (completing-read "NNTP server: " =2D (mapcar 'list =2D (cons (list gnus-nntp-server) =2D gnus-secondary-servers)) =2D nil nil gnus-nntp-server))) + (gnus-completing-read "NNTP server" + (cons gnus-nntp-server + gnus-secondary-servers) + nil gnus-nntp-server))) =20 (when (and gnus-nntp-server (stringp gnus-nntp-server) diff --git a/lisp/gnus-msg.el b/lisp/gnus-msg.el index a2a2652..a3794f2 100644 =2D-- a/lisp/gnus-msg.el +++ b/lisp/gnus-msg.el @@ -578,8 +578,8 @@ If ARG is 1, prompt for a group name to find the postin= g style." (if arg (if (=3D 1 (prefix-numeric-value arg)) (gnus-group-completing-read =2D "Use posting style of group: " =2D nil nil (gnus-read-active-file-p)) + "Use posting style of group" + nil (gnus-read-active-file-p)) (gnus-group-group-name)) "")) ;; #### see comment in gnus-setup-message -- drv @@ -607,8 +607,8 @@ network. The corresponding back end must have a 'reque= st-post method." (setq gnus-newsgroup-name (if arg (if (=3D 1 (prefix-numeric-value arg)) =2D (gnus-group-completing-read "Use group: " =2D nil nil + (gnus-group-completing-read "Use group" + nil (gnus-read-active-file-p)) (gnus-group-group-name)) "")) @@ -628,7 +628,7 @@ a news." (let ((gnus-newsgroup-name (if arg (if (=3D 1 (prefix-numeric-value arg)) =2D (gnus-group-completing-read "Newsgroup: " nil nil + (gnus-group-completing-read "Newsgroup" nil (gnus-read-active-file-p)) (gnus-group-group-name)) "")) @@ -654,8 +654,8 @@ posting style." (setq gnus-newsgroup-name (if arg (if (=3D 1 (prefix-numeric-value arg)) =2D (gnus-group-completing-read "Use group: " =2D nil nil + (gnus-group-completing-read "Use group" + nil (gnus-read-active-file-p)) "") gnus-newsgroup-name)) @@ -684,8 +684,8 @@ network. The corresponding back end must have a 'reque= st-post method." (setq gnus-newsgroup-name (if arg (if (=3D 1 (prefix-numeric-value arg)) =2D (gnus-group-completing-read "Use group: " =2D nil nil + (gnus-group-completing-read "Use group" + nil (gnus-read-active-file-p)) "") gnus-newsgroup-name)) @@ -710,7 +710,7 @@ a news." (let ((gnus-newsgroup-name (if arg (if (=3D 1 (prefix-numeric-value arg)) =2D (gnus-group-completing-read "Newsgroup: " nil nil + (gnus-group-completing-read "Newsgroup" nil (gnus-read-active-file-p)) "") gnus-newsgroup-name)) @@ -1028,8 +1028,8 @@ If SILENT, don't prompt the user." gnus-last-posting-server) ;; Just use the last value. gnus-last-posting-server =2D (completing-read =2D "Posting method: " method-alist nil t + (gnus-completing-read + "Posting method" (mapcar 'car method-alist) t (cons (or gnus-last-posting-server "") 0)))) method-alist)))) ;; Override normal method. @@ -1487,7 +1487,7 @@ If YANK is non-nil, include the original article." (defun gnus-summary-yank-message (buffer n) "Yank the current article into a composed message." (interactive =2D (list (completing-read "Buffer: " (mapcar 'list (message-buffers)) ni= l t) + (list (gnus-completing-read "Buffer" (message-buffers) t) current-prefix-arg)) (gnus-summary-iterate n (let ((gnus-inhibit-treatment t)) diff --git a/lisp/gnus-registry.el b/lisp/gnus-registry.el index a30847b..984890a 100644 =2D-- a/lisp/gnus-registry.el +++ b/lisp/gnus-registry.el @@ -857,12 +857,11 @@ Uses `gnus-registry-marks' to find what shortcuts to = install." =20 (defun gnus-registry-read-mark () "Read a mark name from the user with completion." =2D (let ((mark (gnus-completing-read-with-default =2D (symbol-name gnus-registry-default-mark) =2D "Label" =2D (mapcar (lambda (x) ; completion list =2D (cons (symbol-name (car-safe x)) (car-safe x))) =2D gnus-registry-marks)))) + (let ((mark (gnus-completing-read + "Label" + (mapcar 'symbol-name (mapcar 'car gnus-registry-marks)) + nil nil nil + (symbol-name gnus-registry-default-mark)))) (when (stringp mark) (intern mark)))) =20 diff --git a/lisp/gnus-score.el b/lisp/gnus-score.el index 03ff30d..26c3ca3 100644 =2D-- a/lisp/gnus-score.el +++ b/lisp/gnus-score.el @@ -680,14 +680,14 @@ file for the command instead of the current score fil= e." (and gnus-extra-headers (equal (nth 1 entry) "extra") (intern ; need symbol =2D (gnus-completing-read-with-default =2D (symbol-name (car gnus-extra-headers)) ; default response =2D "Score extra header" ; prompt =2D (mapcar (lambda (x) ; completion list =2D (cons (symbol-name x) x)) =2D gnus-extra-headers) =2D nil ; no completion limit =2D t)))) ; require match + (let ((collection (mapcar 'symbol-name gnus-extra-headers)= )) + (gnus-completing-read + "Score extra header" ; prompt + collection ; completion list + t ; require match + nil ; no history + nil ; no initial-input + (car collection)))))) ; default value ;; extra is now nil or a symbol. =20 ;; We have all the data, so we enter this score. @@ -913,10 +913,13 @@ MATCH is the string we are looking for. TYPE is the score type. SCORE is the score to add. EXTRA is the possible non-standard header." =2D (interactive (list (completing-read "Header: " =2D gnus-header-index =2D (lambda (x) (fboundp (nth 2 x))) =2D t) + (interactive (list (gnus-completing-read "Header" + (mapcar + 'car + (remove-if-not + (lambda (x) (fboundp (nth 2 x= ))) + gnus-header-index)) + t) (read-string "Match: ") (if (y-or-n-p "Use regexp match? ") 'r 's) (string-to-number (read-string "Score: ")))) diff --git a/lisp/gnus-srvr.el b/lisp/gnus-srvr.el index 11164a8..2b13f39 100644 =2D-- a/lisp/gnus-srvr.el +++ b/lisp/gnus-srvr.el @@ -571,8 +571,9 @@ The following commands are available: =20 (defun gnus-server-add-server (how where) (interactive =2D (list (intern (completing-read "Server method: " =2D gnus-valid-select-methods nil t)) + (list (intern (gnus-completing-read "Server method" + (mapcar 'car gnus-valid-select-meth= ods) + t)) (read-string "Server name: "))) (when (assq where gnus-server-alist) (error "Server with that name already defined")) @@ -582,7 +583,7 @@ The following commands are available: (defun gnus-server-goto-server (server) "Jump to a server line." (interactive =2D (list (completing-read "Goto server: " gnus-server-alist nil t))) + (list (gnus-completing-read "Goto server" (mapcar 'car gnus-server-alis= t) t))) (let ((to (text-property-any (point-min) (point-max) 'gnus-server (intern server)))) (when to diff --git a/lisp/gnus-sum.el b/lisp/gnus-sum.el index b8b17b3..59b9682 100644 =2D-- a/lisp/gnus-sum.el +++ b/lisp/gnus-sum.el @@ -7999,10 +7999,9 @@ If FORCE, go to the article even if it isn't display= ed. If FORCE is a number, it is the line the article is to be displayed on." (interactive (list =2D (completing-read =2D "Article number or Message-ID: " =2D (mapcar (lambda (number) (list (int-to-string number))) =2D gnus-newsgroup-limit)) + (gnus-completing-read + "Article number or Message-ID" + (mapcar 'int-to-string gnus-newsgroup-limit)) current-prefix-arg t)) (prog1 @@ -8256,16 +8255,13 @@ articles that are younger than AGE days." (interactive (let ((header (intern =2D (gnus-completing-read-with-default =2D (symbol-name (car gnus-extra-headers)) + (gnus-completing-read (if current-prefix-arg "Exclude extra header" "Limit extra header") =2D (mapcar (lambda (x) =2D (cons (symbol-name x) x)) =2D gnus-extra-headers) =2D nil =2D t)))) + (mapcar 'symbol-name gnus-extra-headers) + t nil nil + (symbol-name (car gnus-extra-headers)))))) (list header (read-string (format "%s header %s (regexp): " (if current-prefix-arg "Exclude" "Limit to") @@ -9234,14 +9230,14 @@ If HEADER is an empty string (or nil), the match is= done on the entire article. If BACKWARD (the prefix) is non-nil, search backward instead." (interactive (list (let ((completion-ignore-case t)) =2D (completing-read =2D "Header name: " =2D (mapcar (lambda (header) (list (format "%s" header))) + (gnus-completing-read + "Header name" + (mapcar 'symbol-name (append =2D '("Number" "Subject" "From" "Lines" "Date" =2D "Message-ID" "Xref" "References" "Body") + '(Number Subject From Lines Date + Message-ID Xref References Body) gnus-extra-headers)) =2D nil 'require-match)) + 'require-match)) (read-string "Regexp: ") (read-key-sequence "Command: ") current-prefix-arg)) @@ -9937,9 +9933,9 @@ latter case, they will be copied into the relevant gr= oups." (car (gnus-find-method-for-group gnus-newsgroup-name))))) (method =2D (gnus-completing-read-with-default =2D methname "Backend to use when respooling" =2D methods nil t nil 'gnus-mail-method-history)) + (gnus-completing-read + "Backend to use when respooling" + methods t nil 'gnus-mail-method-history methname)) ms) (cond ((zerop (length (setq ms (gnus-servers-using-backend @@ -9949,7 +9945,7 @@ latter case, they will be copied into the relevant gr= oups." (car ms)) (t (let ((ms-alist (mapcar (lambda (m) (cons (cadr m) m)) ms))) =2D (cdr (assoc (completing-read "Server name: " ms-alist nil t) + (cdr (assoc (gnus-completing-read "Server name" ms-alist t) ms-alist)))))))) (unless method (error "No method given for respooling")) @@ -11921,29 +11917,20 @@ save those articles instead." (format "these %d articles" (length articles)) "this article"))) (to-newsgroup =2D (let (active group) =2D (when (or (null split-name) (=3D 1 (length split-name))) =2D (setq active (gnus-make-hashtable (length gnus-active-hashtb))) =2D (mapatoms (lambda (symbol) =2D (setq group (symbol-name symbol)) =2D (when (string-match "[^\000-\177]" group) =2D (setq group (gnus-group-decoded-name group))) =2D (set (intern group active) group)) =2D gnus-active-hashtb)) =2D (cond =2D ((null split-name) =2D (gnus-completing-read-with-default =2D default prom active 'gnus-valid-move-group-p nil prefix =2D 'gnus-group-history)) =2D ((=3D 1 (length split-name)) =2D (gnus-completing-read-with-default =2D (car split-name) prom active 'gnus-valid-move-group-p nil nil =2D 'gnus-group-history)) =2D (t =2D (gnus-completing-read-with-default =2D nil prom (mapcar 'list (nreverse split-name)) nil nil nil =2D 'gnus-group-history))))) =2D (to-method (gnus-server-to-method (gnus-group-method to-newsgroup))) + (cond + ((null split-name) + (gnus-group-completing-read + prom + (remove-if-not 'gnus-valid-move-group-p gnus-active-hashtb) + nil prefix nil default)) + ((=3D 1 (length split-name)) + (gnus-group-completing-read + prom (remove-if-not 'gnus-valid-move-group-p gnus-active-hash= tb) + nil prefix 'gnus-group-history (car split-name))) + (t + (gnus-completing-read + prom (nreverse split-name) nil nil 'gnus-group-history)))) + (to-method (gnus-server-to-method (gnus-group-method to-newsgroup= ))) encoded) (when to-newsgroup (if (or (string=3D to-newsgroup "") diff --git a/lisp/gnus-topic.el b/lisp/gnus-topic.el index 7c71035..b600fac 100644 =2D-- a/lisp/gnus-topic.el +++ b/lisp/gnus-topic.el @@ -161,9 +161,7 @@ See Info node `(gnus)Formatting Variables'." (defun gnus-topic-jump-to-topic (topic) "Go to TOPIC." (interactive =2D (list (completing-read "Go to topic: " =2D (mapcar 'list (gnus-topic-list)) =2D nil t))) + (list (gnus-completing-read "Go to topic" (gnus-topic-list) t))) (let ((buffer-read-only nil)) (dolist (topic (gnus-current-topics topic)) (unless (gnus-topic-goto-topic topic) @@ -1303,7 +1301,7 @@ When used interactively, PARENT will be the topic und= er point." If COPYP, copy the groups instead." (interactive (list current-prefix-arg =2D (gnus-completing-read "Move to topic" gnus-topic-alist nil t + (gnus-completing-read "Move to topic" (mapcar 'car gnus-topic-alist) t 'gnus-topic-history))) (let ((use-marked (and (not n) (not (gnus-region-active-p)) gnus-group-marked t)) @@ -1350,7 +1348,7 @@ If COPYP, copy the groups instead." "Copy the current group to a topic." (interactive (list current-prefix-arg =2D (completing-read "Copy to topic: " gnus-topic-alist nil t))) + (gnus-completing-read "Copy to topic" (mapcar 'car gnus-topic-alist) t))) (gnus-topic-move-group n topic t)) =20 (defun gnus-topic-kill-group (&optional n discard) @@ -1443,7 +1441,8 @@ If PERMANENT, make it stay shown in subsequent sessio= ns as well." (gnus-topic-remove-topic t nil) (let ((topic (gnus-topic-find-topology =2D (completing-read "Show topic: " gnus-topic-alist nil t)))) + (gnus-completing-read "Show topic" + (mapcar 'car gnus-topic-alist) t)))) (setcar (cddr (cadr topic)) nil) (setcar (cdr (cadr topic)) 'visible) (gnus-group-list-groups))))) @@ -1491,7 +1490,8 @@ If NON-RECURSIVE (which is the prefix) is t, don't un= mark its subtopics." (let (topic) (nreverse (list =2D (setq topic (completing-read "Move to topic: " gnus-topic-alist n= il t)) + (setq topic (gnus-completing-read "Move to topic" + (mapcar 'car gnus-topic-alist) t)) (read-string (format "Move to %s (regexp): " topic)))))) (gnus-group-mark-regexp regexp) (gnus-topic-move-group nil topic copyp)) @@ -1502,7 +1502,8 @@ If NON-RECURSIVE (which is the prefix) is t, don't un= mark its subtopics." (let (topic) (nreverse (list =2D (setq topic (completing-read "Copy to topic: " gnus-topic-alist n= il t)) + (setq topic (gnus-completing-read "Copy to topic" + (mapcar 'car gnus-topic-alist) t)) (read-string (format "Copy to %s (regexp): " topic)))))) (gnus-topic-move-matching regexp topic t)) =20 @@ -1723,8 +1724,9 @@ If REVERSE, sort in reverse order." "Sort topics in TOPIC alphabetically by topic name. If REVERSE, reverse the sorting order." (interactive =2D (list (completing-read "Sort topics in : " gnus-topic-alist nil t =2D (gnus-current-topic)) + (list (gnus-completing-read "Sort topics in" + (mapcar 'car gnus-topic-alist) t + (gnus-current-topic)) current-prefix-arg)) (let ((topic-topology (or (and topic (cdr (gnus-topic-find-topology topi= c))) gnus-topic-topology))) @@ -1738,7 +1740,7 @@ If REVERSE, reverse the sorting order." (interactive (list (gnus-group-topic-name) =2D (completing-read "Move to topic: " gnus-topic-alist nil t))) + (gnus-completing-read "Move to topic" (mapcar 'car gnus-topic-alist) t= ))) (unless (and current to) (error "Can't find topic")) (let ((current-top (cdr (gnus-topic-find-topology current))) diff --git a/lisp/gnus-util.el b/lisp/gnus-util.el index 5ebccc0..1c390c7 100644 =2D-- a/lisp/gnus-util.el +++ b/lisp/gnus-util.el @@ -44,6 +44,32 @@ (defmacro with-no-warnings (&rest body) `(progn ,@body)))) =20 +(defcustom gnus-completing-read-function + #'gnus-std-completing-read + "Function to do a completing read." + :group 'gnus-meta + :type '(radio (function-item + :doc "Use Emacs' standard `completing-read' function." + gnus-std-completing-read) + (function-item :doc "Use iswitchb's completing-read functi= on." + gnus-icompleting-read) + (function-item :doc "Use ido's completing-read function." + gnus-ido-completing-read) + (function))) + +(defcustom gnus-completion-styles + (if (and (boundp 'completion-styles-alist) + (boundp 'completion-styles)) + (append (when (and (assq 'substring completion-styles-alist) + (not (memq 'substring completion-styles))) + (list 'substring)) + completion-styles) + nil) + "Value of `completion-styles' to use when completing." + :version "24.1" + :group 'gnus-meta + :type 'list) + ;; Fixme: this should be a gnus variable, not nnmail-. (defvar nnmail-pathname-coding-system) (defvar nnmail-active-file-coding-system) @@ -344,16 +370,6 @@ TIME defaults to the current time." (define-key keymap key (pop plist)) (pop plist))))) =20 =2D(defun gnus-completing-read-with-default (default prompt &rest args) =2D ;; Like `completing-read', except that DEFAULT is the default argument. =2D (let* ((prompt (if default =2D (concat prompt " (default " default "): ") =2D (concat prompt ": "))) =2D (answer (apply 'completing-read prompt args))) =2D (if (or (null answer) (zerop (length answer))) =2D default =2D answer))) =2D ;; Two silly functions to ensure that all `y-or-n-p' questions clear ;; the echo area. ;; @@ -1574,21 +1590,48 @@ SPEC is a predicate specifier that contains stuff l= ike `or', `and', `(,(car spec) ,@(mapcar 'gnus-make-predicate-1 (cdr spec))) (error "Invalid predicate specifier: %s" spec))))) =20 =2D(defun gnus-completing-read (prompt table &optional predicate require-ma= tch =2D history) =2D (when (and history =2D (not (boundp history))) =2D (set history nil)) =2D (completing-read =2D (if (symbol-value history) =2D (concat prompt " (" (car (symbol-value history)) "): ") =2D (concat prompt ": ")) =2D table =2D predicate =2D require-match =2D nil =2D history =2D (car (symbol-value history)))) +(defun gnus-std-completing-read (prompt collection &optional require-match + initial-input history def) + (completing-read prompt collection nil require-match + initial-input history def)) + +(defun gnus-icompleting-read (prompt collection &optional require-match + initial-input history def) + (let ((iswitchb-make-buflist-hook + (lambda () + (setq iswitchb-temp-buflist + (let ((choices (append (list) + (when initial-input (list initial-= input)) + history collection)) + filtered-choices) + (while choices + (when (and (car choices) (not (member (car choices) f= iltered-choices))) + (setq filtered-choices (cons (car choices) filtered= -choices))) + (setq choices (cdr choices))) + (nreverse filtered-choices)))))) + (unwind-protect + (progn + (when (not iswitchb-mode) + (add-hook 'minibuffer-setup-hook 'iswitchb-minibuffer-setup)) + (iswitchb-read-buffer prompt def require-match)) + (when (not iswitchb-mode) + (remove-hook 'minibuffer-setup-hook 'iswitchb-minibuffer-setup))))) + +(defun gnus-ido-completing-read (prompt collection &optional require-match + initial-input history def) + (ido-completing-read prompt collection nil require-match + initial-input history def)) + +(defun gnus-completing-read (prompt collection &optional require-match + initial-input history def) + "Do a completing read with the configured `gnus-completing-read-function= '." + (let ((completion-styles gnus-completion-styles)) + (funcall + gnus-completing-read-function + (concat prompt (when def + (concat " (default " def ")")) + ": ") + collection require-match initial-input history def))) =20 (defun gnus-graphic-display-p () (if (featurep 'xemacs) diff --git a/lisp/gnus.el b/lisp/gnus.el index dafaafc..c01cd62 100644 =2D-- a/lisp/gnus.el +++ b/lisp/gnus.el @@ -4240,9 +4240,9 @@ Allow completion over sensible values." gnus-predefined-server-alist gnus-server-alist)) (method =2D (completing-read =2D prompt servers =2D nil t nil 'gnus-method-history))) + (gnus-completing-read + prompt (mapcar 'car servers) + t nil 'gnus-method-history))) (cond ((equal method "") (setq method gnus-select-method)) diff --git a/lisp/mm-decode.el b/lisp/mm-decode.el index 9b756ed..7562e57 100644 =2D-- a/lisp/mm-decode.el +++ b/lisp/mm-decode.el @@ -1323,11 +1323,11 @@ Use CMD as the process." "Display HANDLE using METHOD." (let* ((type (mm-handle-media-type handle)) (methods =2D (mapcar (lambda (i) (list (cdr (assoc 'viewer i)))) + (mapcar (lambda (i) (cdr (assoc 'viewer i))) (mailcap-mime-info type 'all))) (method (let ((minibuffer-local-completion-map mm-viewer-completion-map)) =2D (completing-read "Viewer: " methods)))) + (gnus-completing-read "Viewer" methods)))) (when (string=3D method "") (error "No method given")) (if (string-match "^[^% \t]+$" method) diff --git a/lisp/mm-util.el b/lisp/mm-util.el index 7f0d338..c408c61 100644 =2D-- a/lisp/mm-util.el +++ b/lisp/mm-util.el @@ -68,11 +68,11 @@ . ,(lambda (prompt) "Return a charset." (intern =2D (completing-read + (gnus-completing-read prompt =2D (mapcar (lambda (e) (list (symbol-name (car e)))) + (mapcar (lambda (e) (symbol-name (car e))) mm-mime-mule-charset-alist) =2D nil t)))) + t)))) ;; `subst-char-in-string' is not available in XEmacs 21.4. (subst-char-in-string . ,(lambda (from to string &optional inplace) @@ -281,8 +281,8 @@ to the contents of the accessible portion of the buffer= ." 'read-coding-system)) (t (lambda (prompt &optional default-coding-system) "Prompt the user for a coding system." =2D (completing-read =2D prompt (mapcar (lambda (s) (list (symbol-name (car s)))) + (gnus-completing-read + prompt (mapcar (lambda (s) (symbol-name (car s))) mm-mime-mule-charset-alist))))))) =20 (defvar mm-coding-system-list nil) @@ -316,8 +316,8 @@ the alias. Else windows-NUMBER is used." (cp-supported-codepages) ;; Removed in Emacs 23 (unicode), so signal an error: (error "`codepage-setup' not present in this Emacs version")))) =2D (list (completing-read "Setup DOS Codepage: (default 437) " candida= tes =2D nil t nil nil "437")))) + (list (gnus-completing-read "Setup DOS Codepage" candidates + t nil nil "437")))) (when alias (setq alias (if (stringp alias) (intern alias) diff --git a/lisp/mm-view.el b/lisp/mm-view.el index 1a2d940..566908c 100644 =2D-- a/lisp/mm-view.el +++ b/lisp/mm-view.el @@ -31,6 +31,7 @@ (require 'mm-decode) (require 'smime) =20 +(autoload 'gnus-completing-read "gnus-util") (autoload 'gnus-article-prepare-display "gnus-art") (autoload 'vcard-parse-string "vcard") (autoload 'vcard-format-string "vcard") @@ -676,11 +677,9 @@ (if (=3D (length smime-keys) 1) (cadar smime-keys) (smime-get-key-by-email =2D (completing-read =2D (concat "Decipher using key" =2D (if smime-keys (concat "(default " (caar smime-keys) "): ") =2D ": ")) =2D smime-keys nil nil nil nil (car-safe (car-safe smime-keys)))))) + (gnus-completing-read + "Decipher using key" + smime-keys nil nil nil (car-safe (car-safe smime-keys)))))) (goto-char (point-min)) (while (search-forward "\r\n" nil t) (replace-match "\n")) diff --git a/lisp/mml-smime.el b/lisp/mml-smime.el index a99538b..62e742f 100644 =2D-- a/lisp/mml-smime.el +++ b/lisp/mml-smime.el @@ -161,10 +161,10 @@ Whether the passphrase is cached at all is controlled= by ""))))) (and from (smime-get-key-by-email from))) (smime-get-key-by-email =2D (completing-read "Sign this part with what signature? " =2D smime-keys nil nil =2D (and (listp (car-safe smime-keys)) =2D (caar smime-keys)))))))) + (gnus-completing-read "Sign this part with what signature" + smime-keys nil nil + (and (listp (car-safe smime-keys)) + (caar smime-keys)))))))) =20 (defun mml-smime-get-file-cert () (ignore-errors @@ -213,15 +213,16 @@ Whether the passphrase is cached at all is controlled= by (quit)) result)) =20 =2D(autoload 'gnus-completing-read-with-default "gnus-util") +(autoload 'gnus-completing-read "gnus-util") =20 (defun mml-smime-openssl-encrypt-query () ;; todo: try dns/ldap automatically first, before prompting user (let (certs done) (while (not done) =2D (ecase (read (gnus-completing-read-with-default =2D "ldap" "Fetch certificate from" =2D '(("dns") ("ldap") ("file")) nil t)) + (ecase (read (gnus-completing-read + "Fetch certificate from" + '(("dns") ("ldap") ("file")) t nil nil + "ldap")) (dns (setq certs (append certs (mml-smime-get-dns-cert)))) (ldap (setq certs (append certs diff --git a/lisp/mml.el b/lisp/mml.el index 15b1bb7..3cf0f37 100644 =2D-- a/lisp/mml.el +++ b/lisp/mml.el @@ -40,6 +40,7 @@ (autoload 'message-make-message-id "message") (declare-function gnus-setup-posting-charset "gnus-msg" (group)) (autoload 'gnus-make-local-hook "gnus-util") +(autoload 'gnus-completing-read "gnus-util") (autoload 'message-fetch-field "message") (autoload 'message-mark-active-p "message") (autoload 'message-info "message") @@ -1188,9 +1189,10 @@ If not set, `default-directory' will be used." ;; looks like, and offer text/plain if it looks ;; like text/plain. "application/octet-stream")) =2D (string (completing-read =2D (format "Content type (default %s): " default) =2D (mapcar 'list (mailcap-mime-types))))) + (string (gnus-completing-read + "Content type" + (mailcap-mime-types) + nil nil nil default))) (if (not (equal string "")) string default))) @@ -1204,10 +1206,10 @@ If not set, `default-directory' will be used." (defun mml-minibuffer-read-disposition (type &optional default filename) (unless default (setq default (mml-content-disposition type filename))) =2D (let ((disposition (completing-read =2D (format "Disposition (default %s): " default) =2D '(("attachment") ("inline") ("")) =2D nil t nil nil default))) + (let ((disposition (gnus-completing-read + "Disposition" + '("attachment" "inline") + t nil nil default))) (if (not (equal disposition "")) disposition default))) @@ -1395,11 +1397,11 @@ TYPE is the MIME type to use." =20 (defun mml-insert-multipart (&optional type) (interactive (if (message-in-body-p) =2D (list (completing-read "Multipart type (default mixed): " =2D '(("mixed") ("alternative") =2D ("digest") ("parallel") =2D ("signed") ("encrypted")) =2D nil nil "mixed")) + (list (gnus-completing-read "Multipart type" + '("mixed" "alternative" + "digest" "parallel" + "signed" "encrypted") + nil "mixed")) (error "Use this command in the message body"))) (or type (setq type "mixed")) diff --git a/lisp/nnir.el b/lisp/nnir.el index db8b397..455a0fd 100644 =2D-- a/lisp/nnir.el +++ b/lisp/nnir.el @@ -1588,7 +1588,7 @@ Tested with Namazu 2.0.6 on a GNU/Linux system." (let ((sym (car parmspec)) (prompt (cdr parmspec))) (if (listp prompt) =2D (let* ((result (apply 'completing-read prompt)) + (let* ((result (gnus-completing-read prompt nil)) (mapping (or (assoc result nnir-imap-search-arguments) (assoc nil nnir-imap-search-arguments)))) (cons sym (format (cdr mapping) result))) diff --git a/lisp/nnmairix.el b/lisp/nnmairix.el index bca549a..9672c04 100644 =2D-- a/lisp/nnmairix.el +++ b/lisp/nnmairix.el @@ -848,8 +848,8 @@ called interactively, user will be asked for parameters= ." All necessary information will be queried from the user." (interactive) (let* ((name (read-string "Name of the mairix server: ")) =2D (server (completing-read "Back end server (TAB for completion): " =2D (nnmairix-get-valid-servers) nil 1)) + (server (gnus-completing-read "Back end server" + (nnmairix-get-valid-servers) t)) (mairix (read-string "Command to call mairix: " "mairix")) (defaultgroup (read-string "Default search group: ")) (backend (symbol-name (car (gnus-server-to-method server)))) @@ -1165,7 +1165,7 @@ nnmairix server. Only marks from current session will= be set." If SKIPDEFAULT is t, the default search group will not be updated. If UPDATEDB is t, database for SERVERNAME will be updated first." =2D (interactive (list (completing-read "Update groups on server: " + (interactive (list (gnus-completing-read "Update groups on server" (nnmairix-get-nnmairix-servers)))) (save-excursion (when (string-match ".*:\\(.*\\)" servername) @@ -1302,7 +1302,7 @@ Otherwise, ask user for server." (while (equal '("") (setq nnmairix-last-server =2D (list (completing-read "Server: " openedserver nil 1 + (list (gnus-completing-read "Server" openedserver t (or nnmairix-last-server "nnmairix:")))))) nnmairix-last-server) @@ -1492,10 +1492,10 @@ group." (when (not found) (setq mairixserver (gnus-server-to-method =2D (completing-read =2D (format "Cannot determine which nnmairix server indexes %s. Please= specify: " + (gnus-completing-read + (format "Cannot determine which nnmairix server indexes %s. Please s= pecify" (gnus-method-to-server server)) =2D (nnmairix-get-nnmairix-servers) nil nil "nnmairix:"))) + (nnmairix-get-nnmairix-servers) nil "nnmairix:"))) ;; Save result in parameter of default search group so that ;; we don't have to ask again (setq defaultgroup (gnus-group-prefixed-name @@ -1643,9 +1643,9 @@ search in raw mode." (gnus-registry-add-group mid cur))))) (if (> (length allgroups) 1) (setq group =2D (completing-read =2D "Message exists in more than one group. Choose: " =2D allgroups nil t)) + (gnus-completing-read + "Message exists in more than one group. Choose" + allgroups t)) (setq group (car allgroups)))) (if group ;; show article in summary buffer @@ -1748,9 +1748,9 @@ SERVER." (gnus-group-prefixed-name group (car cur)) allgroups)))) (if (> (length allgroups) 1) =2D (setq group (completing-read =2D "Group %s exists on more than one IMAP server. Choose: " =2D allgroups nil t)) + (setq group (gnus-completing-read + "Group %s exists on more than one IMAP server. Choose" + allgroups t)) (setq group (car allgroups)))) group)) =20 diff --git a/lisp/nnrss.el b/lisp/nnrss.el index 379fee2..8897b37 100644 =2D-- a/lisp/nnrss.el +++ b/lisp/nnrss.el @@ -1058,9 +1058,9 @@ whether they are `offsite' or `onsite'." (cdr (assoc "feedid" listinfo))))) feedinfo))) (cdr (assoc =2D (completing-read =2D "Multiple feeds found. Select one: " =2D selection nil t) urllist))))))))) + (gnus-completing-read + "Multiple feeds found. Select one" + selection t) urllist))))))))) =20 (defun nnrss-rss-p (data) "Test if DATA is an RSS feed. diff --git a/lisp/smime.el b/lisp/smime.el index a266819..2492007 100644 =2D-- a/lisp/smime.el +++ b/lisp/smime.el @@ -371,12 +371,9 @@ KEYFILE should contain a PEM encoded key and certifica= te." (if keyfile keyfile (smime-get-key-with-certs-by-email =2D (completing-read =2D (concat "Sign using key" =2D (if smime-keys =2D (concat " (default " (caar smime-keys) "): ") =2D ": ")) =2D smime-keys nil nil (car-safe (car-safe smime-keys)))))) + (gnus-completing-read + "Sign using key" + smime-keys nil (car-safe (car-safe smime-keys)))))) (error "Signing failed")))) =20 (defun smime-encrypt-buffer (&optional certfiles buffer) @@ -502,11 +499,9 @@ in the buffer specified by `smime-details-buffer'." (expand-file-name (or keyfile (smime-get-key-by-email =2D (completing-read =2D (concat "Decipher using key" =2D (if smime-keys (concat " (default " (caar smime-keys) "): ") =2D ": ")) =2D smime-keys nil nil (car-safe (car-safe smime-keys))))))))) + (gnus-completing-read + "Decipher using key" + smime-keys nil (car-safe (car-safe smime-keys))))))))) =20 ;; Various operations =20 @@ -660,6 +655,7 @@ A string or a list of strings is returned." (define-key smime-mode-map "f" 'smime-certificate-info)) =20 (autoload 'gnus-run-mode-hooks "gnus-util") +(autoload 'gnus-completing-read "gnus-util") =20 (defun smime-mode () "Major mode for browsing, viewing and fetching certificates. =2D-=20 1.7.1 --=-=-=-- --==-=-= Content-Type: application/pgp-signature -----BEGIN PGP SIGNATURE----- Version: GnuPG v1.4.10 (GNU/Linux) iEYEARECAAYFAkyiQn0ACgkQdC8qQo5jWl46fQCbBH5akI2Od1Rq5TOw6mh5Wo3k 9bIAnjCaP7Ii8yqNUJoWJZF6OBObntAk =2Unb -----END PGP SIGNATURE----- --==-=-=--