cgit.sxemacs.org Git - packages/blob - xemacs-packages/auctex/multi-prompt.el

   1 ;;; multi-prompt.el --- Completing read of multiple strings
   2
   3 ;; Copyright (C) 1996, 1997, 2000, 2009 Free Software Foundation
   4
   5 ;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
   6 ;; Maintainer: auctex-devel@gnu.org
   7 ;; Created: 1996-08-31
   8 ;; Keywords: extensions
   9
  10 ;; This program is free software; you can redistribute it and/or modify
  11 ;; it under the terms of the GNU General Public License as published by
  12 ;; the Free Software Foundation; either version 3, or (at your option)
  13 ;; any later version.
  14 ;;
  15 ;; This program is distributed in the hope that it will be useful,
  16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;; GNU General Public License for more details.
  19 ;;
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with this program; if not, write to the Free Software
  22 ;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  23
  24 ;;; Commentary:
  25
  26 ;; This package is written for use in emacs lisp programs, where the
  27 ;; user is prompted for a string of the form:
  28 ;;
  29 ;;   FOO,BAR,BAZ
  30 ;;
  31 ;; where FOO, BAR, and BAZ are elements of some table.  The function
  32 ;; `multi-prompt' is a replacement `completing-read' that will allow
  33 ;; the user to enter a string like the above, yet get completion on
  34 ;; all FOO, BAR, and BAZ.
  35
  36 ;;; Code:
  37
  38 (defvar multi-prompt-found nil
  39   "List of entries currently added during a `multi-prompt'.")
  40
  41 ;;;###autoload
  42 (defun multi-prompt (separator
  43                      unique prompt table
  44                      &optional mp-predicate require-match initial history)
  45   "Completing prompt for a list of strings.
  46 The first argument SEPARATOR should be the string (of length 1) to
  47 separate the elements in the list.  The second argument UNIQUE should
  48 be non-nil, if each element must be unique.  The remaining elements
  49 are the arguments to `completing-read'.  See that."
  50   (let ((old-map (if require-match
  51                      minibuffer-local-must-match-map
  52                    minibuffer-local-completion-map))
  53         (new-map (make-sparse-keymap)))
  54     (if (fboundp 'set-keymap-parent)
  55         ;; `set-keymap-parent' was introduced in Emacs 19.32.
  56         (set-keymap-parent new-map old-map)
  57       (setq new-map (copy-keymap old-map)))
  58     (define-key new-map separator (if require-match
  59                                       'multi-prompt-next-must-match
  60                                     'multi-prompt-next))
  61     (define-key new-map "\C-?" 'multi-prompt-delete)
  62     (let* ((minibuffer-local-completion-map new-map)
  63            (minibuffer-local-must-match-map new-map)
  64            (multi-prompt-found nil)
  65            (done nil)
  66            (filter (cond (unique
  67                           (lambda (x)
  68                             (and (not (member (car x) multi-prompt-found))
  69                                  (or (null mp-predicate)
  70                                      (funcall mp-predicate x)))))
  71                          (mp-predicate)))
  72            (answer (catch 'multi-prompt-exit
  73                      (while t
  74                        (let ((extra (catch 'multi-prompt-next
  75                                       (throw 'multi-prompt-exit
  76                                              (completing-read prompt
  77                                                               table
  78                                                               filter
  79                                                               require-match
  80                                                               initial
  81                                                               history)))))
  82                          (cond ((eq extra 'back)
  83                                 (when multi-prompt-found
  84                                   (setq prompt (substring
  85                                                 prompt 0
  86                                                 (- 0 (length separator)
  87                                                    (length
  88                                                     (car multi-prompt-found))))
  89                                         initial (car multi-prompt-found))
  90                                   (setq multi-prompt-found
  91                                         (cdr multi-prompt-found))))
  92                                (t
  93                                 (setq prompt (concat prompt extra separator)
  94                                       initial nil)
  95                                 (setq multi-prompt-found
  96                                       (cons extra multi-prompt-found)))))))))
  97       (if (string= answer "")
  98           multi-prompt-found
  99         (nreverse (cons answer multi-prompt-found))))))
 100
 101 (defun multi-prompt-delete ()
 102   (interactive)
 103   (if (bobp)
 104       (throw 'multi-prompt-next 'back)
 105     (call-interactively 'backward-delete-char)))
 106
 107 (defun multi-prompt-next ()
 108   (interactive)
 109   (throw 'multi-prompt-next
 110          (cond
 111           ((fboundp 'minibuffer-contents-no-properties)
 112            ;; buffer-substring no longer works in emacs-21, it returns
 113            ;; the whole prompt line. Use this instead.
 114            (minibuffer-contents-no-properties))
 115           (t
 116            (buffer-substring-no-properties (point-min) (point-max))))))
 117
 118 (defun multi-prompt-next-must-match ()
 119   (interactive)
 120   (when  (call-interactively 'minibuffer-complete)
 121     (let ((content (buffer-substring-no-properties (point-min) (point-max))))
 122       (when (or (not require-match)
 123                 (assoc content table))
 124         (throw 'multi-prompt-next content)))))
 125
 126
 127 ;;; Support for key=value completion
 128
 129 ;; The following code was ripped out of crm.el
 130 ;; (completing-read-multiple) and extended to support comma-separated
 131 ;; key=value lists.  The code is separate from the code above.
 132
 133 ;; WARNING: This obviously relies on internals of crm.el and
 134 ;; minibuffer.el and will therefore have to be adapted if these
 135 ;; change.
 136
 137 ;; TODO: How to support stuff like "caption={[one]two}" or
 138 ;; "morekeywords={one,three,five}"?
 139
 140 (defvar multi-prompt-key-value-sep "="
 141   "Single-character string separating key=value pairs.")
 142 (defvar multi-prompt-completion-table nil
 143   "Completion table used by `multi-prompt-key-value'.")
 144
 145 (defun multi-prompt-key-value-collection-fn (string predicate flag)
 146   "Function used by `multi-prompt-key-value' to compute completion values.
 147 The value of STRING is the string to be completed.
 148
 149 The value of PREDICATE is a function to filter possible matches, or
 150 nil if none.
 151
 152 The value of FLAG is used to specify the type of completion operation.
 153 A value of nil specifies `try-completion'.  A value of t specifies
 154 `all-completions'.  A value of lambda specifes a test for an exact match.
 155
 156 For more information on STRING, PREDICATE, and FLAG, see the Elisp
 157 Reference sections on 'Programmed Completion' and 'Basic Completion
 158 Functions'."
 159   (let ((beg 0) (last 0) matched)
 160     (while (string-match multi-prompt-key-value-sep string beg)
 161       (setq matched t
 162             last beg
 163             beg (match-end 0)))
 164     (completion-table-with-context
 165      (substring string 0 beg)
 166      (if (not matched)
 167          multi-prompt-completion-table
 168        (cadr (assoc (substring string last (1- beg))
 169                     multi-prompt-completion-table)))
 170      (substring string beg)
 171      predicate
 172      flag)))
 173
 174 (defun multi-prompt-expand-completion-table (table)
 175   "Return an expanded version of completion table TABLE.
 176 This is achieved by eval'ing all variables in the value parts of
 177 the alist elements."
 178   (mapcar (lambda (x)
 179             (if (and (cadr x) (symbolp (cadr x)) (not (functionp (cadr x))))
 180                 (cons (car x) (list (eval (cadr x))))
 181               x))
 182           table))
 183
 184 ;; Silence the byte compiler.
 185 (defvar crm-local-must-match-map)
 186 (defvar crm-local-completion-map)
 187
 188 ;;;###autoload
 189 (defun multi-prompt-key-value
 190   (prompt table &optional predicate require-match initial-input
 191           hist def inherit-input-method)
 192   "Read multiple strings, with completion and key=value support.
 193 PROMPT is a string to prompt with, usually ending with a colon
 194 and a space.  TABLE is an alist.  The car of each element should
 195 be a string representing a key and the optional cdr should be a
 196 list with strings to be used as values for the key.
 197
 198 See the documentation for `completing-read' for details on the
 199 other arguments: PREDICATE, REQUIRE-MATCH, INITIAL-INPUT, HIST,
 200 DEF, and INHERIT-INPUT-METHOD.
 201
 202 The return value is the string as entered in the minibuffer."
 203   (let* ((minibuffer-completion-table #'multi-prompt-key-value-collection-fn)
 204          (minibuffer-completion-predicate predicate)
 205          (minibuffer-completion-confirm
 206           (unless (eq require-match t) require-match))
 207          (multi-prompt-completion-table
 208           ;; Expand the table here because completion would otherwise
 209           ;; interpret symbols in the table as functions.  However, it
 210           ;; would be nicer if this could be done during the actual
 211           ;; completion in order to avoid walking through the whole
 212           ;; table.
 213           (multi-prompt-expand-completion-table table))
 214          (map (if require-match
 215                   crm-local-must-match-map
 216                 crm-local-completion-map))
 217          (input (read-from-minibuffer
 218                  prompt initial-input map
 219                  nil hist def inherit-input-method)))
 220     (and def (string-equal input "") (setq input def))
 221     input))
 222
 223 (provide 'multi-prompt)
 224
 225 ;;; multi-prompt.el ends here