Mercurial > hg > xemacs-beta

comparison lisp/auctex/multi-prompt.el @ 100:4be1180a9e89 r20-1b2

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-1b2
author cvs
date Mon, 13 Aug 2007 09:15:11 +0200
parents 4103f0995bd7
children
comparison
equal deleted inserted replaced
99:2d83cbd90d8d 100:4be1180a9e89
1 ;;; multi-prompt.el --- completing read of multiple strings.
2
3 ;; Copyright (C) 1996, 1997 Per Abrahamsen.
4
5 ;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
6 ;; Keywords: extensions
7 ;; Version: 0.2
8 ;; Bogus-Bureaucratic-Cruft: How 'bout ESR and the LCD people agreed
9 ;; on a common format?
10
11 ;; LCD Archive Entry:
12 ;; multi-prompt|Per Abrahamsen|abraham@dina.kvl.dk|
13 ;; completing read of multiple strings|
14 ;; 1996-08-31|0.1|~/functions/multi-prompt.el.Z|
15
16 ;; This program is free software; you can redistribute it and/or modify
17 ;; it under the terms of the GNU General Public License as published by
18 ;; the Free Software Foundation; either version 2, or (at your option)
19 ;; any later version.
20 ;;
21 ;; This program is distributed in the hope that it will be useful,
22 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
23 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
24 ;; GNU General Public License for more details.
25 ;;
26 ;; You should have received a copy of the GNU General Public License
27 ;; along with this program; if not, write to the Free Software
28 ;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
29
30 ;;; Commentary:
31
32 ;; This package is written for use in emacs lisp programs, where the
33 ;; user is prompted for a string of the form:
34 ;;
35 ;; FOO,BAR,BAZ
36 ;;
37 ;; where FOO, BAR, and BAZ are elements of some table. The function
38 ;; `multi-prompt' is a replacement `completing-read' that will allow
39 ;; the user to enter a string like the above, yet get completion on
40 ;; both FOO, BAR, and BAZ.
41
42 ;;; Change Log:
43 ;;
44 ;; Sat Feb 15 17:58:31 MET 1997
45 ;; * Version 0.2 released.
46 ;; Renamed predicate to `mp-predicate'.
47 ;; Sat Aug 31 18:32:20 MET DST 1996
48 ;; * Version 0.1 released.
49 ;; Fixed `predicate' bug.
50 ;; Added provide.
51 ;; Added `multi-prompt-found' variable.
52 ;; Sat Aug 31 16:29:14 MET DST 1996
53 ;; * Created.
54
55 ;;; Code:
56
57 (provide 'multi-prompt)
58
59 (defvar multi-prompt-found nil
60 "List of entries currently added during a `multi-prompt'.")
61
62 (defun multi-prompt (separator
63 unique prompt table
64 &optional mp-predicate require-match initial history)
65 "Completing prompt for a list of strings.
66 The first argument SEPARATOR should be the string (of length 1) to
67 separate the elements in the list. The second argument UNIQUE should
68 be non-nil, if each element must be unique. The remaining elements
69 are the arguments to `completing-read'. See that."
70 (let ((old-map (if require-match
71 minibuffer-local-must-match-map
72 minibuffer-local-completion-map))
73 (new-map (make-sparse-keymap)))
74 (if (fboundp 'set-keymap-parent)
75 ;; `set-keymap-parent' was introduced in Emacs 19.32.
76 (set-keymap-parent new-map old-map)
77 (setq new-map (copy-keymap old-map)))
78 (define-key new-map separator (if require-match
79 'multi-prompt-next-must-match
80 'multi-prompt-next))
81 (define-key new-map "\C-?" 'multi-prompt-delete)
82 (let* ((minibuffer-local-completion-map new-map)
83 (minibuffer-local-must-match-map new-map)
84 (multi-prompt-found nil)
85 (done nil)
86 (filter (cond (unique
87 (lambda (x)
88 (and (not (member (car x) multi-prompt-found))
89 (or (null mp-predicate)
90 (funcall mp-predicate x)))))
91 (mp-predicate)))
92 (answer (catch 'multi-prompt-exit
93 (while t
94 (let ((extra (catch 'multi-prompt-next
95 (throw 'multi-prompt-exit
96 (completing-read prompt
97 table
98 filter
99 require-match
100 initial
101 history)))))
102 (cond ((eq extra 'back)
103 (when multi-prompt-found
104 (setq prompt (substring
105 prompt 0
106 (- 0 (length separator)
107 (length
108 (car multi-prompt-found))))
109 initial (car multi-prompt-found))
110 (setq multi-prompt-found
111 (cdr multi-prompt-found))))
112 (t
113 (setq prompt (concat prompt extra separator)
114 initial nil)
115 (setq multi-prompt-found
116 (cons extra multi-prompt-found)))))))))
117 (if answer
118 (nreverse (cons answer multi-prompt-found))
119 multi-prompt-found))))
120
121 (defun multi-prompt-delete ()
122 (interactive)
123 (if (bobp)
124 (throw 'multi-prompt-next 'back)
125 (call-interactively 'backward-delete-char)))
126
127 (defun multi-prompt-next ()
128 (interactive)
129 (throw 'multi-prompt-next
130 (buffer-substring-no-properties (point-min) (point-max))))
131
132 (defun multi-prompt-next-must-match ()
133 (interactive)
134 (if (call-interactively 'minibuffer-complete)
135 (throw 'multi-prompt-next
136 (buffer-substring-no-properties (point-min) (point-max)))))
137
138 ;;; multi-prompt.el ends here