;;AUTOLOAD: sub-toplevel
;;AUTODOC: sub-toplevel "interactive sub-toplevel read/eval/print loop"
;;(sub-toplevel)
;;
;;Enters a sub-toplevel loop, prompts given by *:prompt which must be a list of
;;    (FirstPrompt SecondaryPrompt IndentationString BeforeResult Padding)
;;quits on entering a specific Klone expression given by the :end keyword
;;(defaults to a dot, ".") :end () never returns.
;;Traps errors and throw to external tags, except if given a tag via the 
;;keyword :tag

(defun sub-toplevel (&key (:end '.) tag
    &aux (*last-caught-tag* ())
    expr
    prompt
    res
  )
  (if (and (boundp 'klone:prompt)
      (typep klone:prompt List)
      (typep (getn klone:prompt 3) String)
    )
    (setq prompt (get 'klone:prompt 3 " = "))
    (setq prompt " = ")
  )
  (if (catch 'sub-toplevel:exit
      (while t
	(setq stream (Stream (read-lines-pooled *standard-input* ())))
	(if (not stream) (throw 'sub-toplevel:exit)) ;EOF
	(catch 'EOF
	  (while t
	    (setq *last-caught-tag* ())
	    (catch 'ALL (setq expr (read stream)))
	    (if (= 'EOF *last-caught-tag*) (throw 'EOF)
	      (not *last-caught-tag*) (progn
		(if (and end (= end expr)) (throw 'sub-toplevel:exit))
		(setq res (catch 'ALL (setq expr (eval expr))))
		(if (and tag (= *last-caught-tag* tag)) 
		  (throw 'sub-toplevel:exit tag))
		(print-format "%0%1\n" prompt 
		  (if (not *last-caught-tag*) expr
		    (= *last-caught-tag* 'ERROR) "***ERROR***"
		    (print-format String "***Throw to uncaught tag: %r0 ***"
		      *last-caught-tag*
    )))))))))
    (throw tag res)
  )
)

