Prompting for multiple groups

Prompting for multiple groups

[Per Abrahamsen]

I wrote this ugly little hack for use with AUC TeX, but I think it can
be useful in Gnus too.  What it does it to prompt for a comma (or
whatever) separated list of strings from a table, with completion.

Nice when you prompt for a list of newsgroups, which is e.g. done when
you crosspost without having a followup-to line.

Try to eval the code below to see how it works.

(defun multi-prompt (separator
		     unique prompt table
		     &optional predicate require-match initial history)
  "Completing prompt for a list of strings.  
The first argument SEPARATOR should be the string (of length 1) to
separate the elements in the list.  The second argument UNIQUE should
be non-nil, if each element must be unique.  The remaining elements
are the arguments to `completing-read'.  See that."
  (let ((old-map minibuffer-local-completion-map)
	(new-map (make-sparse-keymap)))
    (set-keymap-parent new-map old-map)
    (define-key new-map separator 'multi-prompt-next)
    (define-key new-map "\C-?" 'multi-prompt-delete)
    (let* ((minibuffer-local-completion-map new-map)
	   (found nil)
	   (filter (cond (unique
			  (lambda (x)
			    (and (not (member (car x) found))
				 (or (null predicate)
				     (not (predicate x))))))
			 (predicate)))
	   (answer (catch 'multi-prompt-exit
		     (while t
		       (let ((extra (catch 'multi-prompt-next
				      (throw 'multi-prompt-exit
					     (completing-read prompt 
							      table
							      filter
							      require-match
							      initial
							      history)))))
			 (cond ((eq extra 'back)
				(when found
				  (setq prompt (substring
						prompt 0 
						(- 0 (length separator)
						   (length (car found))))
					initial (car found)
					found (cdr found))))
			       (t
				(setq prompt (concat prompt extra separator)
				      initial nil
				      found (cons extra found)))))))))
      (if answer 
	  (nreverse (cons answer found))
	found))))

(defun multi-prompt-delete ()
  (interactive)
  (if (bobp)
      (throw 'multi-prompt-next 'back)
    (call-interactively 'backward-delete-char)))

(defun multi-prompt-next ()
  (interactive)
  (throw 'multi-prompt-next 
	 (buffer-substring-no-properties (point-min) (point-max))))

(setq a-table '(("aaa") ("bbb") ("ccc")))

(multi-prompt "," t "Prompt " a-table)