;;; -*- Mode: LISP; Package: :cl-user; BASE: 10; Syntax: ANSI-Common-Lisp; -*-
;;;
;;;   Touched: Sat Mar 19 11:11:17 2005 +0530 <enometh@meer.net>
;;;   Time-stamp: <05/03/24 21:47:18 madhu>
;;;
(in-package "CL-USER")
(export 'choose-with-restarts)

(defmacro choose-with-restarts-internal (choices &body body)
  (let ((choices-list (gensym)))
    `(let ((,choices-list ',choices))
       (restart-case (progn ,@body)
	 ,@(loop for choice in choices for i from 0
		 collect `(nil nil :report ,(format nil "Choose ~S:" choice)
			       (nth ,i ,choices-list)))))))

#+nil
(choose-with-restarts-internal (foo bar car)
  (error "choose one"))

(defun %choose-with-restarts (choices body-fn)
  (funcall (compile nil `(lambda ()
			   (choose-with-restarts-internal
			       ,choices (funcall ,body-fn))))))

#+nil
(%choose-with-restarts (list 'foo 'bar 'car 'var)
		       #'(lambda () (error "foo-error")))

(defmacro choose-with-restarts (choices &body body)
  "CHOICES is evaluated to a list in the current lexical
environment. BODY forms are evaluated in a dynamic environment
where each item of CHOICES can be uniquely chosen by
interactively invoking a particular restart.

If BODY evaluates without entering the debugger, the macro
returns result of evaluating the final form in BODY. However if
the debugger is entered, the user may interactively invoke a
restart and the corresponding item from CHOICES is returned.

Eg: * (let ((choices '(yes no)))
	(ecase (choose-with-restarts choices
		 (error \"Should I Stay or Should I go?\"))
	  (yes 'blue-pill)
	  (no 'yellow-pill)))
"
  `(%choose-with-restarts ,choices (lambda () ,@body)))

#+nil
(defun delete-file-1 (pathname)
  (let ((choices '(YES NO)))
    (ecase (if *ask-annoying-questions*
	       (user::choose-with-restarts choices
		 (error "Really Unlink file ~S ? ~A" pathname choices))
	       'YES)
      (YES (delete-file pathname))	; XXX!
      (NO 'OK))))

;;; Local Variables:
;;; eval: (defindent user::choose-with-restarts (4 &lambda &body))
;;; End: