From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Paul Landes Newsgroups: gmane.emacs.devel Subject: completing-read enhancement Date: Tue, 11 Aug 2009 03:01:57 +0000 (UTC) Message-ID: NNTP-Posting-Host: lo.gmane.org Mime-Version: 1.0 Content-Type: text/plain; charset=us-ascii Content-Transfer-Encoding: 7bit X-Trace: ger.gmane.org 1249960228 21324 80.91.229.12 (11 Aug 2009 03:10:28 GMT) X-Complaints-To: usenet@ger.gmane.org NNTP-Posting-Date: Tue, 11 Aug 2009 03:10:28 +0000 (UTC) To: emacs-devel@gnu.org Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Tue Aug 11 05:10:21 2009 Return-path: Envelope-to: ged-emacs-devel@m.gmane.org Original-Received: from lists.gnu.org ([199.232.76.165]) by lo.gmane.org with esmtp (Exim 4.50) id 1Mahki-0007nl-D8 for ged-emacs-devel@m.gmane.org; Tue, 11 Aug 2009 05:10:20 +0200 Original-Received: from localhost ([127.0.0.1]:50098 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1Mahkh-0001r4-4Y for ged-emacs-devel@m.gmane.org; Mon, 10 Aug 2009 23:10:19 -0400 Original-Received: from mailman by lists.gnu.org with tmda-scanned (Exim 4.43) id 1Mahkb-0001qa-7y for emacs-devel@gnu.org; Mon, 10 Aug 2009 23:10:13 -0400 Original-Received: from exim by lists.gnu.org with spam-scanned (Exim 4.43) id 1MahkW-0001pl-IG for emacs-devel@gnu.org; Mon, 10 Aug 2009 23:10:12 -0400 Original-Received: from [199.232.76.173] (port=32900 helo=monty-python.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1MahkW-0001pb-8I for emacs-devel@gnu.org; Mon, 10 Aug 2009 23:10:08 -0400 Original-Received: from main.gmane.org ([80.91.229.2]:52618 helo=ciao.gmane.org) by monty-python.gnu.org with esmtps (TLS-1.0:RSA_AES_256_CBC_SHA1:32) (Exim 4.60) (envelope-from ) id 1MahkU-00038Q-Oe for emacs-devel@gnu.org; Mon, 10 Aug 2009 23:10:07 -0400 Original-Received: from root by ciao.gmane.org with local (Exim 4.43) id 1MahkQ-0000by-HZ for emacs-devel@gnu.org; Tue, 11 Aug 2009 03:10:02 +0000 Original-Received: from 74-94-104-250-Illinois.hfc.comcastbusiness.net ([74.94.104.250]) by main.gmane.org with esmtp (Gmexim 0.1 (Debian)) id 1AlnuQ-0007hv-00 for ; Tue, 11 Aug 2009 03:10:02 +0000 Original-Received: from landes by 74-94-104-250-Illinois.hfc.comcastbusiness.net with local (Gmexim 0.1 (Debian)) id 1AlnuQ-0007hv-00 for ; Tue, 11 Aug 2009 03:10:02 +0000 X-Injected-Via-Gmane: http://gmane.org/ Original-Lines: 111 Original-X-Complaints-To: usenet@ger.gmane.org X-Gmane-NNTP-Posting-Host: main.gmane.org User-Agent: Loom/3.14 (http://gmane.org/) X-Loom-IP: 74.94.104.250 (Mozilla/5.0 (Macintosh; U; Intel Mac OS X 10_5_7; en-us) AppleWebKit/530.19.2 (KHTML, like Gecko) Version/4.0.2 Safari/530.19) X-detected-operating-system: by monty-python.gnu.org: GNU/Linux 2.6, seldom 2.4 (older, 4) X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.5 Precedence: list List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Original-Sender: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Errors-To: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Xref: news.gmane.org gmane.emacs.devel:114020 Archived-At: This isn't a patch to completing-read, instead it is a new function. I think of it more as a facade with bells and whistles. In summary, it makes prompting for user input easy requiring terse, in the context of a function invocation, code for this purpose. (defun read-completing-choice (prompt choices &optional return-as-string require-match initial-contents history default allow-empty-p no-initial-contents-on-singleton-p add-prompt-default-p) "Read from the user a choice. See `completing-read'. PROMPT is a string to prompt with; normally it ends in a colon and a space. CHOICES the list of things to auto-complete and allow the user to choose from. Each element is analyzed independently If each element is not a string, it is written with `prin1-to-string'. RETURN-AS-STRING is non-nil, return the symbol as a string (i.e. `symbol-name). If REQUIRE-MATCH is non-nil, the user is not allowed to exit unless the input is (or completes to) an element of TABLE or is null. If it is also not t, Return does not exit if it does non-null completion. If INITIAL-CONTENTS is non-nil, insert it in the minibuffer initially. If it is (STRING . POSITION), the initial input is STRING, but point is placed POSITION characters into the string. HISTORY, if non-nil, specifies a history list and optionally the initial position in the list. It can be a symbol, which is the history list variable to use, or it can be a cons cell (HISTVAR . HISTPOS). In that case, HISTVAR is the history list variable to use, and HISTPOS is the initial position (the position in the list which INITIAL-CONTENTS corresponds to). If HISTORY is `t', no history will be recorded. Positions are counted starting from 1 at the beginning of the list. DEFAULT, if non-nil, will be returned when the user enters an empty string. ALLOW-EMPTY-P, if non-nil, allow no data (empty string) to be returned. In this case, nil is returned, otherwise, an error is raised. NO-INITIAL-CONTENTS-ON-SINGLETON-P, if non-nil, don't populate with initialial contents when there is only one choice to pick from. ADD-PROMPT-DEFAULT-P, if non-nil, munge the prompt using the default notation \(i.e. ` (default CHOICE)')." (let* ((choice-alist-p (listp (car choices))) (choice-options (if choice-alist-p (mapcar #'car choices) choices)) (sym-list (mapcar #'(lambda (arg) (list (typecase arg (string arg) (t (prin1-to-string arg)) ))) choice-options)) (initial (if initial-contents (if (symbolp initial-contents) (symbol-name initial-contents) initial-contents))) (def (if default (typecase default (nil nil) (symbol default (symbol-name default)) (string default) ))) res-str) (when (not no-initial-contents-on-singleton-p) (if (and (null initial) (= 1 (length sym-list))) (setq initial (car (car sym-list)))) (let (tc) (if (and (null initial) ;; cases where a default is given and the user can't then just ;; press return; instead, the user has to clear the minibuffer ;; contents first (null def) (setq tc (try-completion "" sym-list))) (setq initial tc)))) (if (and add-prompt-default-p def) (setq prompt (concat prompt (format " (default %s): " def)))) (block wh (while t (setq res-str (completing-read prompt sym-list nil require-match initial history def)) (if (or allow-empty-p (> (length res-str) 0)) (return-from wh) (ding) (message (substitute-command-keys "Input required or type `\\[keyboard-quit]' to quit")) (sit-for 5)))) (when (> (length res-str) 0) (if choice-alist-p (let ((choices (if (symbolp (caar choices)) (mapcar #'(lambda (arg) (cons (symbol-name (car arg)) (cdr arg))) choices) choices))) (setq res-str (cdr (assoc res-str choices)))) (setq res-str (if return-as-string res-str (intern res-str))))) res-str))