(in-package "KPML")

;;; File: inquiry-interaction.lisp
;;;
;;; Contains the interfacing between the grammar, particularly
;;; its traversal, and the inquiry implementations...
;;;
;;; Mods:
;;; ----------------------------------------------------------------------
;;; FETCH-INQUIRY-ANSWER
;;; ====================  
;;; no longer used: replaced by FETCH-INQUIRY-RESPONSE (BK).
;;; KPML 2.1 REMOVED. May99.
;;; ----------------------------------------------------------------------
;;;
;;; 4.0 -- more comments...
;;;
;;; Functions PARAMETER-MATCH-P and SEARCH-FOR-INQUIRY-RESPONSE
;;; are responsible for finding matching inquiries given in 
;;; the SPL during generation. They need to check whether
;;; any explicitly given actual parameters in the SPL match
;;; the actual parameters as required by the instantiated chooser
;;; that uses those inquiries.

(DEFUN Ask-identify-Fix (Given)
  "Returns a copy of a given chooser with english text replacing the ASK and IDENTIFY operators"
  (let ((informal-chooser (copy-tree given)))
    (ask-identify-fix-1 informal-chooser)
    informal-chooser))

(defun ask-identify-fix-1 (given)
  (dolist (x given)
    (when (listp x)
      (cond ((equal (car x) 'ask)
	     (rplaca (cdr x) (make-english-inquiry (cadr x)))
	     (dolist (y (cddr x))
		 (ask-identify-fix-1 y)))
	    ((equal (car x) 'identify)
	     (rplaca (cddr x) (make-english-inquiry (caddr x))))
	    (t nil)))))

(DEFUN Ask-Manual (Grammar-Inquiry)
  (let ((ans nil)
	(old-flag  Manual-Response-Mode-Flag))
    (SETQ Manual-Response-Mode-Flag T)
    (SETQ ANS (Inquire-Environment Grammar-Inquiry))
    (SETQ Manual-Response-Mode-Flag OLD-FLAG)
    ans))


(DEFUN Ask-Preselected (Outer-Inquiry Grammar-Inquiry)
  (unless (Operator-Definition-P (CAR Grammar-Inquiry))
	  (warning "In " Message-Sender " there is an undefined operator, "
		   (CAR Grammar-Inquiry) ". Ask-Preselected will skip it.")
	  (return-from ask-preselected nil))
  (PROG (Response Pre-Response Env-Response)
	(SETQ Response
	      (cond
		((SETQ Pre-Response (Preselection-Guidance Outer-Inquiry))
		 (cond
		   (Manual-Guidance-Flag
		    (SETQ Env-Response (PROG (Preselection English-Trace-Flag)
					     (RETURN (Ask Grammar-Inquiry))))
		    (printwindow :display-pane (indent-and-fill (format nil "Preselected response:  ~a" Pre-Response  )))
		    (printwindow :display-pane (indent-and-fill (format nil "Environment's response:  ~a" env-Response  )))
		    (printwindow :display-pane (indent-and-fill "Or supply a new value."))
		    (Let ((Case-Var (ASKwindow :choice "You have these 3 options.  What do you want to do?   "
					     '(preselected-response environment-response supply-a-new-value))))

		    (Case Case-Var
			  (preselected-response
			    (printwindow
			      :display-pane
			      (indent-and-fill
				(format nil "Preselected response ~a is going to be used." Pre-Response)
				:left-margin 12))
			     Pre-Response)
			  (environment-response
			    (printwindow
			      :display-pane
			      (indent-and-fill
				(format nil "Environment response ~a is going to be used." env-Response)
				:left-margin 12))
			     Env-Response)
			  (supply-a-new-value
			    (askwindow :value "Supply a new response to be used."))
			  (otherwise (Warning "Improper guidance type:  " (kpml-eval (CAR Case-Var)))))))
		   (T (cond
			(Show-Preselected-Response-Flag
			 (printwindow
			      :display-pane
			      (indent-and-fill
				(format nil "Preselected response ~a is going to be used." Pre-Response)
				:left-margin 12))))
		      Pre-Response)))
		(T (Get-Preselection-Guidance Outer-Inquiry))))
	(when manual-guidance-flag
	  (when (askwindow :yes-or-no (format nil  "Do you want to store the response ~a?" Response))
	    (Put-Guidance (CAR Outer-Inquiry) Preselection Response)))
	(when (and english-trace-flag (not window-interface-flag))
	  (printwindow
	    :display-pane
	    (indent-and-fill
	      (format nil "Preselected response to the system network: ~a" Response)
	      :left-margin 12)))
	(RETURN Response)))


(defun identify-random (inquiry)
  (gentemp (concatenate 'string (symbol-name (car inquiry)) "-")))

(DEFUN ATTACH (item lst)
    (COND
      ((null lst)
        (list item))
      ((listp lst)
        (rplaca (rplacd lst (cons (car lst) (cdr lst))) item))
      (T
       
       (Warning "ATTACH called with argument " lst " which should be a list or NIL" t t))))

(DEFUN Chooser-EVAL (Operator-Calls) ;;;used to have parameter parent
  (clisp::for tail clisp::on Operator-Calls clisp::bind call op choice path
	      clisp::do (SETQ op (CAR (SETQ call (CAR tail))))
	      (cond					
	 ((Eq op 'Ask)  
	  (SETQ choice (Ask (Second call))) 
	  (cond
	    ((SETQ path (assoc choice (CDDR call)))
	     (Chooser-EVAL (CDR path)))   ;;;used to have parameter: path
	    (T (Extend-Alternatives choice call)))
	  (cond
	    ((And (CDR tail) 
		  (not (eq '* (CAAR (CDR tail))))
		  (not (eq '*p (CAAR (CDR tail)))))
	     (Warning "In " Current-Chooser ": Illegal code occurring after " call)))
	  (RETURN NIL))
	 ((member op '(* *p) :test #'eq)
	  nil)
	 (T (apply (car call)(cdr call))))
       finally (Extend-Computation))) ;;;previously had parameters: Operator-Calls Parent



;;; CHOOSER-ITEM-NAME: Returns the name of the given chooser.
(DEFUN Chooser-Item-Name (&REST Chooser-Body)
  (caar Chooser-Body))



;;;Add a new clause to the Ask passed as Current-Ask
(DEFUN Extend-Alternatives (New-Choice Current-Ask)
  (Rplacd (CDR Current-Ask)
	  (Cons (list New-Choice) (CDDR Current-Ask)))
;;;  (MARKASCHANGED Current-Chooser 'CHOOSERS)
  (Extend-Computation))  ;;;previously used argument: (Third Current-Ask)

;;;Add new computation at the end of the current path. Assumes that Current-List AND Parent will only be NIL when starting with
;;;a blank chooser, at which point the new structure can be put directly away via Current-Chooser.
;;;tyg Current-list and Parent no longer used in extend-computation
  ;;;
  ;;; 4.0 ==================================================
  ;;;     Update for more user-helpful messages...
  ;;;
(defun EXTEND-COMPUTATION ()
  ;; KPML4 more context information given in user interactions...
  ;;
  (when (and Current-Choice (not Create-boundary-at-all-choosers-flag))
    (return-from extend-computation NIL))
  (printwindow 
   :display-pane (indent-and-fill (format nil "In system ~a." Message-Sender )))
  (when Current-Choice
    (printwindow 
     :display-pane 
     (indent-and-fill (format nil "There is a choice which is ~a." current-choice))))
  (printwindow 
   :display-pane 
   (indent-and-fill (format nil  "You have reached a boundary.")))
  (loop 
   do
   (Case (askwindow :choice 
		    (generate-generation-context-message "What now?  ")
                    '(force-a-choice-and-continue
                      make-no-choice-and-continue
                      run-chooser-again
                      run-chooser-again-in-manual-mode
                      associate-a-new-chooser-with-this-system
                      enter-debugger
                      ))
	 (force-a-choice-and-continue
	  (let ((possible-choices (fetch-output-features Message-Sender)))
	    (cond ((equal (length possible-choices) 1)
		   (printwindow 
		    :display-pane
		    (indent-and-fill 
		     (format nil "Only one choice, automatically choosing ~a."
			     (car possible-choices))))
		   (choose (car possible-choices))
		   (return-from extend-computation nil))
		  ((> (length possible-choices) 1)
		   (choose 
		    (askwindow 
		     :choice 
		     (generate-generation-context-message "Choose a feature: ")
		     (fetch-output-features Message-Sender)))
		   (return-from extend-computation  nil))
		  (t
		   (warning "No choices for system(gate): " message-sender)
		   (return-from extend-computation nil)))))
	 (enter-debugger (break  "User call to debugger at a boundary condition." ))
	 (run-chooser-again-in-manual-mode (Manual-Choose))
	 (make-no-choice-and-continue (return-from extend-computation NIL))
	 (run-chooser-again (THROW 'Top-Chooser-EVAL-restart 'Restart))
	 (associate-a-new-chooser-with-this-system
	  (printwindow
	   :display-pane
	   (indent-and-fill
	    (format nil 
		    "Currently the system ~a has ~a as its chooser."  
		    Message-Sender current-Chooser )))
	  (setf current-chooser  (askwindow :value "Enter name of new chooser: "))
	  (setf (fetch-system-chooser Message-Sender) current-chooser  )
	  (printwindow
	   :display-pane
	   (indent-and-fill
	    (format nil 
		    "The chooser ~a is now associated with system ~a"  
		    current-Chooser Message-Sender)))))))

;;; 4.0 end ==================================================


(defun choiceerror (&optional (text ""))
  (warning "Choice Error - " text)
  (extend-computation))

  


(DEFUN Get-PT (PARAMETER)
  (askwindow 
   :choice (format nil 
		   "What is the association type of parameter ~a?" PARAMETER )
   *micro-function-types*)) ;; 1.1


(DEFUN Hub-Extract (Environment-List)
  (PROG (HUBS)
	(DECLARE (SPECIAL HUBS))
	(Hub-Extract0 Environment-List)
	(RETURN HUBS)))

;;; ----------------------------------------------------------------------
;;; 1.1. this really really old function was using some extra args
;;;      for warning that have long since disappeared into history...
;;;      removed.
;;; ----------------------------------------------------------------------

(defun ACQUIRE-OPERATOR (Operator-Name) 
  (warning 
   Operator-Name " is undefined. Please define it or remove its use."))

;;; ----------------------------------------------------------------------
;;; Recursive function for determining the value of any kind of inquiry in 
;;; either manual or environment mode from the domain tables. 
;;; 2.0.16 always checking with the user about putting stuff in the
;;;        environment deactivated by default.
;;; ----------------------------------------------------------------------

(defun INQUIRE1 
    (Hub-Name-List Domain-Content Grammar-Inquiry ENV Identifying-Flag)
  (PROG (Domain-Tail Hub-Name RESULT foo (OPN (CAR Grammar-Inquiry)))
	(RETURN
	 (cond 
	  ((Not (CAR Hub-Name-List))
	   (cond ((and
		   (cond ((equal 
			   (length 
			    (setq foo 
			      (assoc opn domain-content :test #'equal))) 2)
			  (setq result (cadr foo)))
			 (t nil))
		   (or (not *check-changed-id-values*)
		       (not  Manual-Response-Mode-Flag)
		       (progn 
			 (printwindow
			  :display-pane
			  (indent-and-fill
			   (format nil "The stored value is ~a" RESULT )))
			 (askwindow :yes-or-no "Is that O.K.?"))))
		  RESULT)
		 ((and (not Domain-Implemented-Value-Compare-Flag)
		       (SETQ RESULT 
			     (Inquire-Response 
			      Grammar-Inquiry Identifying-Flag)))
		  (cond ((Or (And (Not Manual-Response-Mode-Flag)
				  Store-To-Environment-Flag)
			     (And Manual-Response-Mode-Flag
				  *check-store-user-responses*
				  (askwindow 
				   :yes-or-no 
				   "Save this value in the environment?")))
			 (Attach (list opn result) Domain-Content)))
		  RESULT)
		 (T NIL)))
	  (T (SETQ Hub-Name (CAR Hub-Name-List))
	     (cond 
	      ((setq foo 
		 (some #'(lambda (foo-1)
			   (and (listp foo-1) 
				(equal (car foo-1) hub-name) foo-1))
		       domain-content))
	       (setq domain-tail foo)
	       (Inquire1 
		(CDR Hub-Name-List) (CDR Domain-Tail) 
		Grammar-Inquiry ENV Identifying-Flag))
	      (T (attach (list Hub-Name nil) Domain-Content)
		 (Inquire1 
		  Hub-Name-List Domain-Content Grammar-Inquiry 
		  ENV Identifying-Flag))))))))

;;;to allow the RETFROM in Extend-Computation to retry an entire chooser.
(DEFUN Top-Chooser-EVAL (Operator-Calls)
  (loop
  (unless (equal (catch 'top-chooser-eval-restart
		   (Chooser-EVAL Operator-Calls))
		 'restart)
    (return t))))

(defun quiry-operator-name (body)
  (car body))

;;; STORE-TO-ENVIRONMENT1: Recursive function for either assignning
;;; a new value with an inquiry operator or changing an old value
;;; to a new implemented value depending on the existence of
;;; a particular value.
(DEFUN old-Store-To-Environment1 
    (Hub-Name-List Domain-Content Grammar-Inquiry ENV Value-To-Store)
  (PROG (Domain-Content-Tail Hub-Name Operator-Name)
	(SETQ Operator-Name (CAR Grammar-Inquiry))
	(cond
	  ((Not (CAR Hub-Name-List))
	   (cond
	     ((equal (length (assoc operator-name domain-content :test #'equal)) 2)
	      (let ((foo nil))
		(cond
		  ((equal (length (setq foo (assoc operator-name domain-content :test #'equal))) 2)
		   (rplaca (cdr foo) value-to-store))))
	      nil)
	     (T 
	      (attach (LIST Operator-Name Value-To-Store) Domain-Content))))
;;;	   (MARKASCHANGED ENV 'VARS)
	  (T (SETQ Hub-Name (CAR Hub-Name-List))
	     (cond
	       ((let ((foo nil))
		  (cond 
;;; John:Stirling:June97
;;; following did not compile under Acl3.0 cos the number of arguments
;;; in the lambda was wrong... corrected and updated here, although,
;;; unfortunately, it looks like absolute garbage in any case. 
		    ((setq foo (some
;;; was:
;;; (function (lambda (foo-1 foo-2)
;;;    (declare (ignore foo-1))
;;;      (and (car foo-2) 
;;;           (equal (caar foo-2) hub-name))
;;;           hub-name))
				#'(lambda (foo-2)
				    (and (car foo-2) 
					 (equal (caar foo-2) hub-name))
				    hub-name)
				domain-content))
		     (setq domain-content-tail (car foo))))
		nil)
		(Store-To-Environment1 (CDR Hub-Name-List) (CDR Domain-Content-Tail) Grammar-Inquiry ENV Value-To-Store))
	       (T (Store-To-Environment1 Hub-Name-List Domain-Content Grammar-Inquiry ENV Value-To-Store)))))))

(DEFUN Store-To-Environment1 (Hub-Name-List Domain-Content Grammar-Inquiry ENV Value-To-Store)
  ;hub-name-list: parameters to the inquiry being called
  ;domain-content:  initially the contents of KB or TP, suitable for rplacaing.
  ;                 after each call contains the subtree of the domain that begins with next parameter (hubname)
  ;grammar-inquiry: the name of the grammar inquiry
  ;env: the name of the domain, either 'kb or 'tp
  ;value-to-store: the value to be stored in the domain as the answer to the inquiry
  (let((Domain-Content-Tail nil)
       (Hub-Name nil)
       (Operator-Name (car grammar-inquiry))
       (temp nil))
    (cond ((null (car Hub-Name-List ))  ;no more parameters, now find the inquiry
	   (setq temp (some #'(lambda (foo)  ;temp will contain the answer to the grammar inquiry 
			       (and (listp foo)
				    (equal (car foo) Operator-Name)
				    (equal (length foo) 2)
				    foo))
			   domain-content))
	   (cond (temp  ;if the inquiry has an answer replace it with a new one
		  (rplaca (cdr temp) value-to-store))
		 (t     ;otherwise add the new value
		  (attach (list operator-name value-to-store) domain-content))))
	  (T (SETQ Hub-Name (CAR Hub-Name-List))  ;find the list that begins with the hubname
	     (setq Domain-Content-Tail
		   (some #'(lambda (foo)  ;  Domain-Content-Tail will contain the subtree of the
			                  ;  domain that begins with the hubname
			     (and (listp foo)
				  (equal (car foo) hub-name)
				  foo))
			 domain-content))
	     (cond (domain-content-tail ;found the subtree
		    (Store-To-Environment1 (CDR Hub-Name-List) (CDR Domain-Content-Tail) Grammar-Inquiry ENV Value-To-Store))
		   (T  ;no subtree for this hub so we will add one
		    (attach (list hub-name 'nil) domain-content)
		    (Store-To-Environment1 Hub-Name-List Domain-Content Grammar-Inquiry ENV Value-To-Store)))))))
	   

(defun local-inquiry-response (grammar-inquiry term)
  (let* ((first-param (second grammar-inquiry))
	 (feature-list (append (if (and (symbolp first-param)
					(boundp first-param)
					(typep (symbol-value first-param)
					       'term-graph))
				   (term-graph-features
				     (symbol-value first-param)))
			       (if (and (symbolp term)
					(boundp term)
					(typep (symbol-value term) 'term-graph))
				   (term-graph-features (symbol-value term))))))
    (search-for-inquiry-response grammar-inquiry feature-list)))

(defun global-inquiry-response (grammar-inquiry)
  (let* ((first-param (second grammar-inquiry))
	 (global-terms (if (and (symbolp first-param)
				(boundp first-param)
				(typep (symbol-value first-param)
				       'term-graph))
			   (get-global-terms first-param))))
    (dolist (term global-terms)
      (let ((response (search-for-inquiry-response
			grammar-inquiry
			(term-graph-features (symbol-value term)))))
	(when response
	  (return response))))))



;;; Functions PARAMETER-MATCH-P and SEARCH-FOR-INQUIRY-RESPONSE
;;; are responsible for finding matching inquiries given in 
;;; the SPL during generation. They need to check whether
;;; any explicitly given actual parameters in the SPL match
;;; the actual parameters as required by the instantiated chooser
;;; that uses those inquiries.

(defun PARAMETER-MATCH-P (term-value inq-params)
  (if (and (typep term-value 'term-graph) 
	   (eq (term-graph-type term-value) 'inquiry-response))
      (loop for given-arg in inq-params
	    as spec-arg in (term-graph-symbol term-value)
	    always (term-eq-p given-arg spec-arg))
      t))

;;; ----------------------------------------------------------------------
;;; 2.1 pledging should be used more in the choosers so that fine control
;;;     of which options are taken up is explicit and not buried in 
;;;     inquiry code. Add a further trace option here for encouraging this.
;;;     Also allow pledge-p to succeed when the term checked is the *range*
;;;     of a pledged minimal relation. If this has been pledged then it
;;;     entails that the minimal relation is itself expressed so...
;;; ----------------------------------------------------------------------

(defun PLEDGED-P (term)
  "Looks into PLEDGES to find a concept equal to TERM."
  (macrolet ((PLEDGE-TEST (term)
               `(or 
                 (eq association ,term)
                 (term-eq-p ,term (fetch-feature 'range association)))))
    (when *show-pledge-checks*
      (printwindow
       :display-pane
       (indent-and-fill
        (format nil "Pledge check for semantics: ~a. Pledges are: ~a" term pledges))))
    (loop for pledge in pledges
          as association = (find-association (second pledge) 'concept)
          when  (or (pledge-test term)
                    (and
                     (fetch-subc-feature 'range term)
                     (minimal-reified-term-p (symbol-value term))
                     (pledge-test (fetch-subc-feature 'range term))))
          do 
          (when *show-pledge-checks*
            (printwindow :display-pane
                         (indent-and-fill
                          (format nil "Pledge check succeeded at ~a." pledge))))
          (return t)
          finally
          (when *show-pledge-checks* (printwindow :display-pane "Pledge check failed."))
          (return nil))))
        


;;; ----------------------------------------------------------------------
;;; John: don't understand how the following was meant to work,
;;; since the term-graph-symbol is usually *not* a list...
;;; Hacked here to see what happens...
;;; 0.8.24

(defun SEARCH-FOR-INQUIRY-RESPONSE (grammar-inquiry feature-list)
  (dolist (a-feature feature-list)
    (if (and (eq (first a-feature) (first grammar-inquiry))
	     (parameter-match-p (rest a-feature) (rest grammar-inquiry)))
	(return (if (branching-inquiry-p (first grammar-inquiry))
		    (if (symbolp (rest a-feature)) 
			(rest a-feature) 
;;; 0.8.24
		      (let ((symbol (term-graph-symbol (rest a-feature))))
			(typecase symbol
				  (symbol symbol)
				  (otherwise
				   (first (last symbol))))))
		    (if (numberp (rest a-feature))
			(rest a-feature)
			(if (eq (term-graph-type (rest a-feature)) 'inquiry-response)
			    (first (last (term-graph-symbol (rest a-feature))))
			    (term-graph-id (rest a-feature)))))))))


(DEFUN Get-Chooser-Def (Chooser-Name) 
      (Cons 'Chooser (Cons Chooser-Name (fetch-chooser-info Chooser-name 'definition))))


(DEFUN Isolated-Choice (Name)
  (PROG ((Associations `(,(make-function-association :function 'ONUS  :concept 'SEED)))
	 Warning-Stop-Flag
	 (Current-Chooser (cond
			    ((System-P Name)
			     (fetch-system-chooser Name))
			    (Name)
			    (T Current-Chooser)))
	 (Message-Sender (cond
			   ((System-P Name) Name)
			   (T Message-Sender)))
	 Preselection Current-Choice 
         (Create-boundary-at-all-choosers-flag t) 
         Store-To-Environment-Flag 
         Store-Guidance-Flag)

     RETRY
	(SETQ Current-Choice NIL)
	(cond
	  (Current-Chooser
	   (printwindow
	     :display-pane
	     (indent-and-fill
	       (format nil "Running ~a in isolation." Current-Chooser )))
	   (cond
	     ((Eq (Top-Chooser-EVAL (fetch-chooser-info current-chooser 'definition)) 'Retry)
	      (Go RETRY)))
	   (printwindow
	     :display-pane
	     (indent-and-fill
	       (format nil "The choice was: ~a" Current-choice ))))
	  (T
	   (printwindow
	     :display-pane
	     (indent-and-fill "No Chooser."))))))


(DEFUN Manual-Choose NIL
  (PROG ((Manual-Response-Mode-Flag T)
	 (Default-Inquiry-Mode 'MANUAL)
	 (Create-boundary-at-all-choosers-flag nil)
	 (Store-To-Environment-Flag nil))
	(Chooser-EVAL (fetch-chooser-info current-chooser 'definition))))


;------------------------------------------------------------------------
;                     patches on quiry operators
;------------------------------------------------------------------------

(DEFUN Ask (Grammar-Inquiry)
  (let ((inq-op (first grammar-inquiry))
	Outer-Inquiry Params Answer)
    (Push Inq-Op Used-Inquiry-Operators)
	(unless (Operator-Definition-P Inq-Op)
	  (warning "In " Message-Sender " there is an undefined operator, "
		   Inq-Op ". Will skip it.")
	  (return-from ask nil))
	(SETQ Params (Inquiry-Associations-Getter Grammar-Inquiry))
	(SETQ Outer-Inquiry (Cons Inq-Op Params))
	(when (or English-Trace-Flag
		  (and (not (eq *cumulate-chooser-activity* :traced))
		       (member inq-op *traced-inquiries*)))
	  (Print-inquiry-to-window Grammar-Inquiry Outer-Inquiry))
	(when (or (eq *cumulate-chooser-activity* :all)
		  (and (eq *cumulate-chooser-activity* :traced)
		       (trace-inquiry-p inq-op)))
	  (record-inquiry-to-history grammar-inquiry outer-inquiry))
	(SETQ Answer 
	      (cond
	       (Preselection (Ask-Preselected Outer-Inquiry Grammar-Inquiry))
	       (T 
		(Let ((Case-Var 
		       (Or (fetch-inquiry-info  Inq-Op 'mode)
			   Default-Inquiry-Mode)))
		     (Case Case-Var
			   (MANUAL (Ask-Manual Outer-Inquiry))
			   (deimplemented (Inquire-Environment Outer-Inquiry))
			   (IMPLEMENTED (Inquire-Implementation Outer-Inquiry))
			   (DEFAULT (Ask-Default Outer-Inquiry))
			   (RANDOM (Ask-Random  Outer-Inquiry))	;;;when implemented, will use  Outer-Inquiry as a parameter
			   (otherwise 
			    (Warning "Unrecognized operator mode. " 
				     (kpml-eval Case-Var))))))))
	
;;; 0.8.0: Responses to inquiries are forced into the current language
;;;        package (which is currently always :penman)
	(setf answer (intern (string answer) *current-language-package*))

;;; 0.9 tracing that bit more complicated...
	(when (or English-Trace-Flag
		  (and (not (eq *cumulate-chooser-activity* :traced))
		       (member inq-op *traced-inquiries*)))
	  (Print-Response Answer Inq-Op))
	(when (or (eq *cumulate-chooser-activity* :all)
		  (and (eq *cumulate-chooser-activity* :traced)
		       (trace-inquiry-p inq-op)))
	  (record-inquiry-response-to-history answer inq-op))

	(when (member inq-op *inquiries-to-pause-upon*)
	      (Print-Response Answer Inq-Op)
	      (askwindow :any-key-to-continue 
			 `(,(format nil "Pausing at ~a" Inq-Op) 
			   "Hit any key to continue.")))
	(when (equal pause-continue-flag :pause)
	  (printwindow :pause))
	(cond
	  ((Not (member Answer (fetch-inquiry-info (CAR Outer-Inquiry) 'answerset)))
	   (Warning "Under " Message-Sender " the inquiry " Outer-Inquiry 
		    " got answer " Answer 
		    ", which is not in the allowable set: "
		    (fetch-inquiry-info  (CAR Outer-Inquiry) 'answerset))))
	(RETURN-from ask Answer)))



(DEFUN Ask-Default (Grammar-Inquiry)
  "Uses the trivial default as the answer  to the inquiry."
  (let ((operator-name (car grammar-inquiry)))
    (unless operator-name (block nil
       (warning "The grammar inquiry " Grammar-Inquiry " is ill-formed.")
       (return-from ask-default nil)))
    (let ((TrvlDflt (fetch-inquiry-info operator-name 'trivialdefault)))
      (if TrvlDflt
	  (warning 
	   "The operator " operator-name " is not an inquiry operator."))
      TrvlDflt)))




(DEFUN Ask-Random (inquiry)
  (let* ((choices (fetch-inquiry-info (CAR Inquiry) 'answerset))
	 (number-of-choices (length choices)))
    (nth (random number-of-choices) choices)))


(DEFUN Get-Created-Association-Type (Operator-Name)
  (when (fetch-inquiry-info Operator-Name 'createdassociationtype)
    (printwindow
      :display-pane
      (indent-and-fill
	(format nil "This operator creates ~a associations."
		(fetch-inquiry-info Operator-Name 'createdassociationtype))))
    (when (askwindow :yes-or-no "Do you want to change the type?")
      (setf (fetch-inquiry-info Operator-Name 'CREATEDASSOCIATIONTYPE)
	    (askwindow 
	     :choice "What type of associations does the operator create?"
	     *micro-function-types*))))) ;; 1.1

(DEFUN Get-Code-Specification (Operator-Name)
  (when (fetch-inquiry-info Operator-Name 'operatorcode)
    (printwindow
      :display-pane
      (indent-and-fill
	(format nil "The function which currently implements ~a is ~a"
		Operator-Name (fetch-inquiry-info Operator-Name 'operatorcode))))
    (when (askwindow :yes-or-no "Do you want to change it?")
      (setf (fetch-inquiry-info Operator-Name 'operatorcode)
	    (askwindow :value 
             (format nil "What is the name of the function which implements ~a" Operator-Name ))))))

(DEFUN Get-Domain-Definition (OX)
  (when (fetch-inquiry-info OX 'domain)
    (printwindow 
      :display-pane
      (indent-and-fill
	(format nil "The portion of the environment containing the values of ~a is currently shown as ~a"
		OX (fetch-inquiry-info OX 'domain))))
    (when (askwindow :yes-or-no "Do you want to change it?")
      (let ((environs nil))
	(setq environs (askwindow
			 :choice
			 (format nil "What portion of the environment contains the values of ~a?" OX )
			 '(KB TP SS LEXICON)))
	(setf (fetch-inquiry-info OX 'domain) ENVIRONS)))))
  

(DEFUN Get-Mode (OPN)
  (fetch-inquiry-info OPN 'mode))
 

(DEFUN Get-Mode-Definition (OPN)
  (cond
    ((fetch-inquiry-info OPN 'mode)
     (printwindow
       :display-pane
       (indent-and-fill
	 (format nil "Do you want to change the response mode of ~a from ~a?"
		 OPN (fetch-inquiry-info OPN 'mode)))))
    (T
      (printwindow
       :display-pane
       (indent-and-fill
	 (format nil "Do you want to specify a non-default response mode for ~a?" opn)))))
  (when (askwindow :yes-or-no " ")
    (set-mode
      (askwindow :choice "Enter the mode of responding to the inquiry: "
		 '(deimplemented Manual Default Random Implemented))
      opn)))     
                  ; set-mode is a macro which calls set-mode1 which calls replace-inquiry-info


(DEFUN Get-Parameter-Type-Definition (Operator-Name)
  (printwindow
       :display-pane
       (indent-and-fill
	 (format nil "For inquiry operator ~a" Operator-Name )))
  (when (fetch-inquiry-info Operator-Name 'parameterassociationtypes)
    (printwindow
       :display-pane
       (indent-and-fill
	 (format nil "the current parameters are ~a with types ~a respectivly."
		 (fetch-inquiry-info Operator-Name 'parameters)
		 (fetch-inquiry-info Operator-Name 'parameterassociationtypes))))
    (when (askwindow :yes-or-no "Do you want to change types?")
      (setf (fetch-inquiry-info Operator-Name 'parameterassociationtypes)
	    (loop for P in (fetch-inquiry-info Operator-Name 'parameters)
		  collect (Get-PT P)))
      ) ;when
    )  ;when
)
  

;;; ----------------------------------------------------------------------
;;; KPML 4
;;;   User message made more helpful...
;;; ----------------------------------------------------------------------

(DEFUN Get-Preselection-Guidance (Inquiry)
  (let ((info-1 (generate-generation-context-message))
	(info-2 
	 (format 
	  nil "~2%In chooser ~a 
processing the Asking Inquiry ~a with a preselection of ~a"
	  message-sender inquiry preselection)))
    (printwindow :display-pane (indent-and-fill info-2))
    (cond ((fetch-inquiry-info (CAR Inquiry) 'answerset)
	   (Put-Guidance 
	    (CAR Inquiry)
	    Preselection
	    (askwindow :choice 
		       (concatenate 'string info-2 info-1)
		       (fetch-inquiry-info (CAR Inquiry) 'answerset))))
	  (t
	   (Warning "Under " Message-Sender ", attempting to get " 
		      "preselection advice on an Asking operator which has no ANSWERSET: "
		      (CAR Inquiry))))))
	   
 
(DEFUN Get-Parameters-Definition (Operator-Name)
  (when (fetch-inquiry-info Operator-Name 'parameters)
    (printwindow
       :display-pane
       (indent-and-fill
	 (format nil "The parameter list of ~a is ~a"
		 Operator-Name
		 (fetch-inquiry-info Operator-Name 'parameters))))
    (when (askwindow :yes-or-no "Do you want to change it?")
      (setf (fetch-inquiry-info Operator-Name 'parameters) 
	   (loop for P in
		(askwindow :value
			   (format nil "Enter the list of generic parameters of ~a." 
				   Operator-Name ))
		when (symbolp P)
		collect P)))))


;;; ----------------------------------------------------------------------
;;; 3.2.6
;;;
;;;  This one takes some believing... the function TRIVIALDEFAULTCODE from
;;;  generate/inquiry-interaction.lisp has a "GOTO" statement in it!!!
;;;  This must be from one of the original Penman functions, or maybe
;;;  be a  result of the automatic conversion from Interlisp in the mid
;;;  80s. Its effect is cute: whenever we need a trivialdefaultcode for
;;;  an inquiry, and we find nil, it will loop. It is amazing that it
;;;  has not caused any problems before: which is itself very suspicious,
;;;  as if we are ending up in a curious branch of the code for some
;;;  reason that is generally never reached. It appears to be caused
;;;  by the combination of having an OPERATORCODE specified as
;;;  TRIVIALDEFAULTCODE but then not having any specified TRIVIALDEFAULT
;;;  slot. This is enough to get us into the loop.  The original idea
;;;  of the loop was that the function get-trivial-default-definition
;;;  allows you to change the trivial default on the fly: but, only
;;;  if the trivialdefault is itself set to something first! If it
;;;  is not set to something, then we fall through this crack to stay
;;;  in the loop. 
;;;  
;;;  Fixes: (1) Give a warning if an inquiry definition uses the
;;;             trivialdefaultcode but does not specify a value
;;;             for trivialdefault. This is only a warning because
;;;             this is not illegal: we could be relying on an spl-environment
;;;             to set the default later.
;;;         (2) change the definition of get-trivial-default-definition
;;;             so that it always gives an option of changing the
;;;             default, even if the originally there is not default
;;;             specified. If there was no inquiry definition, it now
;;;             gives an explicit warning.
;;; ----------------------------------------------------------------------

(DEFUN Get-Trivial-Default-Definition (OPN)
  (let ((answers (fetch-inquiry-info OPN 'answerset)))
    (unless (fetch-inquiry-info OPN 'trivialdefault)
      (warning "The inquiry: " opn 
	       " (which relies on defaults) "
	       "does not have a trivial default set!!"))
    (printwindow
     :display-pane
     (indent-and-fill
      (format nil "The trivial default of ~a is ~a." OPN 
	      (fetch-inquiry-info OPN 'trivialdefault))))
    (when (askwindow :yes-or-no "Do you want to change the trivial default?")
      (if answers
	  (setf (fetch-inquiry-info OPN 'trivialdefault)
		(askwindow :choice "Choose the new trivial default."
			   (loop for answer 
				 in answers collect (LIST answer))))
	(setf (fetch-inquiry-info OPN 'trivialdefault)
	      (askwindow :value "Enter the new trivial default."))))))


(DEFUN Hub-Extract0 (EL)
  (cond
    ((NIGEL-NLISTP EL) 
     NIL)
    ((fetch-inquiry-info Operator-Name 'createdassociationtype)
     (PushNew (second EL) HUBS))
    (T (loop for x in (CDR EL) do (Hub-Extract0 x)))))


(DEFUN identify-Default (Grammar-Inquiry)
  "Uses the trivial default as the answer  to the inquiry."
  (let ((operator-name (car grammar-inquiry)))
    (cond (operator-name
	   (let ((operator-instance (fetch-inquiry-info operator-name 'trivialdefault)))
	     (cond (operator-instance
		    (warning "The identifying inquiry "
			     operator-name " has been defaulted to "
			     operator-instance)
		    operator-instance)
		   (t (warning "The operator " operator-name " is not an inquiry operator.")
		      nil))))
	  (t (warning "The grammar inquiry " Grammar-Inquiry " is ill-formed.")
	     nil))))





;;; ----------------------------------------------------------------------
;;; 0.9 The previous behavior was that it was only possible to update
;;;     an example record when the stored environment values and the
;;;     calculated values for inquiry responses were compared and 
;;;     checked. For id inquiries this is often bad, since the inquiries
;;;     will return unique responses. For -q inquiries accessing the
;;;     lexicon this is also bad, since the environment does not 
;;;     distinguish sufficiently and lexical gender etc. will be different
;;;     for different Things. To squash this behavior the following flag
;;;     blocks comparisons but still allows the new values to replace
;;;     the old values. When this flag is T, then comparisons will be
;;;     made and differences will be complained about. At some stage
;;;     this should be made compatible with a re-interpretation of the
;;;     old Penman flags DOMAIN-IMPLEMENTED-VALUE-COMPARE-FLAG and
;;;     store to environment. 

(defvar *check-changed-inq-values* nil)

;;;     Following changed to implement the above.

(DEFUN Inquire-Implementation (Grammar-Inquiry &optional (Identifying-Flag nil))
  (PROG 
   ((Implemented-Value (Operator-Run Grammar-Inquiry)) Environment-Value)
   (when (equal implemented-value :no-result)
     (setq implemented-value 
       (if identifying-flag 
	   (identify-manual grammar-inquiry)(ask-manual grammar-inquiry))))
   (RETURN
    (cond
     (domain-implemented-value-compare-flag   ;;;run at first with this off
      (SETQ Environment-Value  
	    (Inquire1 (CDR Grammar-Inquiry)
		      (kpml-eval 
		       (fetch-inquiry-info (CAR Grammar-Inquiry) 'domain))
		      Grammar-Inquiry
		      (fetch-inquiry-info (CAR Grammar-Inquiry) 'domain)
		      Identifying-Flag))
      (cond
       ((Not Environment-Value)
	(Store-To-Environment0 Grammar-Inquiry Implemented-Value)
	Implemented-Value)
       (T (cond
	   ((Equal Implemented-Value Environment-Value)
	    ;Both implementation and environment have the same value
	    Implemented-Value)
	   (T
	    (cond ((or (and
			identifying-flag
			(not *check-changed-id-values*))
		       (and
			example-runner-flag
			(eq *example-running-detail-level* :complete))
		       (equal (car grammar-inquiry) 'where-am-i-id))
		   (Store-To-Environment0 Grammar-Inquiry Implemented-Value)
		   Implemented-Value)
		  (*check-changed-inq-values*
		   (printwindow
		    :display-pane
		    (indent-and-fill
		     (format nil "For the grammar inquiry ~a," Grammar-Inquiry )))
		   (printwindow
		    :display-pane
		    (indent-and-fill
		     "the implemented and environmental values are different."))
		   (printwindow
		    :display-pane
		    (indent-and-fill
		     (format nil "  Implemented value: ~a" Implemented-Value)))
		   (printwindow
		    :display-pane
		    (indent-and-fill
		     (format nil "  Environment value: ~a"   Environment-Value)))
		   (printwindow
		    :display-pane
		    (indent-and-fill
		     (format nil "Do you want to store the implemented value in the Environment and use it for computation rather than the current environment value?")))
		   (cond
		    ((askwindow :yes-or-no " ")
		     (Store-To-Environment0 Grammar-Inquiry Implemented-Value)
		     Implemented-Value)
		    (T Environment-Value)))
		  (t implemented-value)))))))
     (T Implemented-Value)))))



(defun inquiry-associations-getter (grammar-inquiry)
  (let ((formal-parameters (CDR Grammar-Inquiry))
	(formal-parameter-types 
           (fetch-inquiry-info (CAR Grammar-Inquiry) 'parameterassociationtypes)))

    (unless (eq (length formal-parameters) (length formal-parameter-types)) 
      (Warning "Inquiry " Grammar-Inquiry " in " Current-Chooser  " has the wrong number of parameters."))
    (loop for parameter in formal-parameters 
	  as type in formal-parameter-types
	  collect (get-association parameter type))))



(DEFUN Make-English-Inquiry ( Inquiry &optional (outer-inquiry nil))
  (let* ((result-text "")
	(parameters (fetch-inquiry-info (CAR Inquiry) 'parameters))
	(parameter-values (if outer-inquiry (cdr  outer-inquiry) (cdr inquiry)))
	(parameter-to-value-alist (pairlis parameters parameter-values))
	(english (sublis parameter-to-value-alist (fetch-inquiry-info (CAR Inquiry) 'english))))
    (dolist (token english)
      (setq result-text (format nil "~a~a" result-text token)))
    result-text))


;;; ----------------------------------------------------------------------
;;; 2.1 following made a bit more robust in as far as it is conceivable
;;;     that someone (like me) reloaded an inquiry with preselection
;;;     guidance that uses ordinary lists and not dotted lists. This
;;;     then fails here cos we get a list as a response and not an symbol.
;;;     So we make sure that this is seen here and warned about, although
;;;     it probably breaks somewhere else (more immediately obvious as
;;;     to what is wrong hopefully...). Clisp also removed.
;;; ----------------------------------------------------------------------

(defun PRESELECTION-GUIDANCE (Inquiry)
  (loop for G in (fetch-inquiry-info (car inquiry) 'preselectionguidance)
      when (eq preselection (preselection-guide-selection G))
      do (typecase (preselection-guide-answer G)
	   (symbol
	    (return-from PRESELECTION-GUIDANCE
	      (preselection-guide-answer G)))
	   (t
	    (warning "Ill formed preselection guidance for: " inquiry)
	    (return-from  PRESELECTION-GUIDANCE
	      (first (preselection-guide-answer G)))))
      finally
	(Get-Preselection-Guidance Inquiry)))


;;; Used only in preselection when an inquiry operator is seen for the first time

(DEFUN Put-Guidance (Operator Preselection Response)
  (let ((operator-instance (fetch-inquiry-info Operator 'everything))
	(preselection-instance nil))
    (cond (operator-instance
	   (setq preselection-instance
		 (loop 
		  for G 
		  in (inquiry-operator-Preselectionguidance operator-instance)
		  when (Eq Preselection (preselection-guide-selection G))
		  return G))
	   (unless
	       (and preselection-instance 
		    (preselection-guide-answer preselection-instance))
	     (push (make-preselection-guide 
		    :selection preselection :answer response)
		   (fetch-inquiry-info Operator 'Preselectionguidance))
	     (warning 
	      "The preselection guidance "
	      (list preselection response)
	      " has been added to the inquiry operator " operator 
	      ". To keep this change the appropriate resources must be saved out or patched." )
	     ))
	  (t (warning "Trying to add preselection guidance for a non existent inquiry operator: " operator-instance))))
  response)




(DEFUN Set-Mode-1 (VAL OPN)
  (setf (fetch-inquiry-info OPN 'mode) VAL))



(DEFUN Store-To-Environment0 (Grammar-Inquiry Value-To-Store)
  (Store-To-Environment1 (CDR Grammar-Inquiry)
			 (kpml-eval 
			  (fetch-inquiry-info (CAR Grammar-Inquiry) 'domain))
			 Grammar-Inquiry
			 (fetch-inquiry-info (CAR Grammar-Inquiry) 'domain)
			 Value-To-Store))



(DEFUN TrivialDefaultCode (func-name)
  (PROG ((default nil))
     L1  (cond
	   ((SETQ default (fetch-inquiry-info func-name 'trivialdefault))
	    (RETURN default))
 	   (T (Get-Trivial-Default-Definition func-name)))
	(Go L1)))

  ;; 4.0
  ;;  another rather strange inquiry that should have a proper
  ;;  life somewhere...
  ;;
(defun MODE-Q-CODE (concept)
  (if (equal *register-mode* :written)
      'written
    'oral))

;;; -------------------------------------------------------------------
;;; The version of operator-run originally in ML-Penman redefined the
;;; function from systemic-networks/sgchoice. However, this is not the
;;; function that is used when we are in implemented mode with
;;; choosers, inquiries and SPL on board. The original function was
;;; itself redefined in spl/new-operator-run, and so this is the
;;; function that is now redefined here, with the minor changes for
;;; multilinguality included. The original patch is kept in
;;; ml-penman-patch-sgchoice in case anyone is running without SPL.
;;;
;;;                                           John:IPSI:Dec94
;;; -------------------------------------------------------------------
;;; Patches: 0.8; inquiry definitions are now only allowed in the
;;;               Penman/KPML packages; thus operator-run should force
;;;               such symbols into this package (for use from
;;;               multipackage inquiry implementation files)
;;;               June95: active defaults made properly multilingual.
;;;  0.9, also as 0.8.33, curious interaction of non-Penman/KPML package
;;;       inquiry responses and show-inquiry-answer-source fixed.
;;;  1.0.2.
;;;  3.1     CLISP cleaned out (John: March, 2000; Bremen)
;;; -------------------------------------------------------------------
;;;
;;; Original comments from Bob Kasper:
;;;
;;; Implements sequence of appeal to several sources of information for
;;; answering inquiries in implemented mode:
;;;    1. specified by keyword in SPL
;;;    2. value returned by operator code
;;;    3. current default value
;;;    4. :NO-RESULT => caller will use Ask-Manual
;;; 
;;; KPML additions:
;;; 0.9.7. was using the wrong checks for a nonexistent operator code
;;;        landing us in the debugger without need.
;;; 1.0.2
;;; It was not previously possible to examine the source of inquiry
;;; answers for individual inquiries; this information is now 
;;; printed whenever an individual inquiry is explicitly traced.
;;; This information would also be a candidate for adding to the
;;; cumulative history data structure when a more complete update
;;; is produced. Both individual inquiry tracing and tracing of
;;; sets of inquiries used by a chooser result in the source of
;;; inquiry responses being given.

(defun OPERATOR-RUN (grammar-inquiry)
  (let* ((presentation-spec (find-association 'onus 'presentation-spec))
	 (op (intern (string (CAR Grammar-Inquiry)) "KPML"))
	 answer source)

    (if (setq answer (fetch-inquiry-response 
		      Grammar-Inquiry presentation-spec))
	
	;; 1. found spl-keyword
	(setq source 'spl-keyword)
	
	;; 2. Use constant default value OR try to run operator-code 
	(or (if (setq answer (constant-default-value (first grammar-inquiry)))
		(setq source 'constant-default)
	      (let ((inquiry-op (fetch-inquiry-info op 'operatorcode)))
;;; 0.9.7
		(cond (inquiry-op 
		       (if (fboundp inquiry-op)
			   (when 
			       (setq answer 
				 (case inquiry-op
				   (trivialdefaultcode 
				    (trivialdefaultcode (car grammar-inquiry)))
				   (otherwise 
				    (apply inquiry-op (CDR Grammar-Inquiry)))))
			     ;; operator-code returned something non-nil
			     (setq source 'operator-code))
			 (warning "The inquiry operator " (car grammar-inquiry)
				  " references operator code " inquiry-op
				  " which does not exist or has not been loaded!")))
		      (t
		       (Warning "The inquiry operator " (CAR Grammar-Inquiry)
				" has no operator code.")))))))

    ;; 3. Appeal to default value, if necessary.
    (if (and answer
	     (member source '(spl-keyword operator-code))
	     (identifying-inquiry-p (car Grammar-Inquiry))
	     (if (and (symbolp answer)                          
		      (boundp answer)
		      (typep (symbol-value answer) 'term-graph))
		 (term-graph-type (symbol-value answer))))
	;; A. For identifying inquiries, try to merge answer with current default value.
	(let ((default (fetch-inquiry-default op grammar-inquiry))
	      (old-answer answer)
	      (answer-term (if (and (symbolp answer)
				    (boundp answer))
			       (symbol-value answer)
			       answer)))
	  (when (and default
		     (symbolp default)
		     (boundp default)
		     (typep (symbol-value default) 'term-graph)   ;Presume value of default
;		     (term-graph-features (symbol-value default))
		     );is in its features
	    (setq answer (term-id (merge-terms-with-copy answer-term (symbol-value default))))
	    (when (not (eq answer old-answer))
	      (unify-merged-terms)
	      (setq source (list source 'merged-with-default)))))
	;; B. try to use current default value, if still no answer.
	(when (or (not answer)
		  (and (branching-inquiry-p (car Grammar-Inquiry))
;;; 0.8.33
		       (not (member 
			     (find-symbol (string Answer) "KPML")
			     (fetch-inquiry-info op 'answerset)))
		       (print-answerset-warning answer grammar-inquiry source)
		       t))
	  (setq answer (fetch-inquiry-default op grammar-inquiry))
	  (when answer
	    (setq source 'default-value))))
    
    (setf *current-inquiry-answer-source* source)
    (when (and answer (or *show-inquiry-answer-source*
			  (trace-inquiry-p (car Grammar-inquiry))))
      ;; Display source of answer
      (printwindow
	:display-pane
	(indent-and-fill (format nil "System: ~a " Message-Sender) 
			 :left-margin 0))
      (printwindow
	:display-pane
	(indent-and-fill (format nil "Inquiry: ~a " Grammar-Inquiry) 
			 :left-margin 2))
      (printwindow
	:display-pane
	(indent-and-fill
	 (format nil "Inquiry Answer From ~a: ~a " source answer) 
	 :left-margin 4)))
    
    (or answer
	:NO-RESULT)))






;  "Searches for an inquiry answer.
;   For branching inquiries, use only local spec;
;   For identifying inquiries, use both local and global specs."

(defun fetch-inquiry-response (grammar-inquiry term)
  
  (or (local-inquiry-response grammar-inquiry term)
      ;; Answer not found in local spec.
      ;; Should also search all terms that are coreferential with (second grammar-inquiry)
      ;; for identifying inquiries.
      (and (or (identifying-inquiry-p (first grammar-inquiry))
	       (eq (fetch-inquiry-info (first grammar-inquiry) 'domain) 'kb))
	   (global-inquiry-response grammar-inquiry))))

;;;===========================================================================
;;; Functionality added that in the case that a system does not have a
;;; chooser, preselection suffices for choice. Previously, this situation
;;; always threw us out to the user.

(DEFUN Choice-Master (Options Preselection)

  (when Preselection
    (Select-Preselected Options Preselection))
  (SETQ Current-Choice NIL) ;clears current choice so that it can test to see if choice is made after chooser operates
  (PROG (RESULT temp (No-Gate (Not (Gate-P Message-Sender))))
     RETRY
	(when (And English-Trace-Flag  (Not Window-Interface-Flag))
	  (printwindow :display-pane 
		       "________________________________________________________________________________")
	  (printwindow :display-pane " ")
	  (if no-gate
	      (printwindow :display-pane (format nil ">> Entering System ~a" Message-Sender ))
	      (printwindow :display-pane (format nil ">> Triggering Gate ~a" Message-Sender ))))
	(SETQ Current-Chooser
	      (cond
		((setq temp (fetch-system-chooser Message-Sender))
		 (when (And English-Trace-Flag No-Gate (Not Window-Interface-Flag))
		   (printwindow :display-pane (format nil "      Entering Chooser ~a" temp)))
		 temp)
		((And No-Gate Make-New-Choosers-Flag
		      (prog ()
			    (printwindow :display-pane (format nil "Entered system ~a which has no chooser." Message-Sender ))
			    (return (askwindow :yes-or-no "Do you want to specify a new Chooser? "))))
		 (Specify-Chooser Message-Sender))))
	(SETQ RESULT
	      (cond
		(Current-Chooser
		 (when (Eq (Top-Chooser-EVAL
			     (fetch-chooser-info current-chooser 'definition))
			   'Retry)
		   (Go RETRY))
		 (if (Not Current-Choice)
		     (Warning "The chooser for " Message-Sender " did not choose.")
		   (CDR (loop for O in Options 
			      when (Eq (Second O) Current-Choice)
			      return O))))
		;; no chooser; check for preselection before going
		;; to the voters...

		(t (if preselection
		       preselection
		     (Select-Manual Options)))))
	(when (And Preselection (not (equal Preselection (CAR RESULT))))
	  (Warning "Under " Message-Sender " Choice-Master produced a choice of " (CAR RESULT)
		   " given a preselection of " Preselection ". Enforcing preselection.")
	  (SETQ RESULT (CDR (loop for O in Options
				  when (Eq (Second O)  Preselection)
				  return O))))
	(RETURN RESULT)))

;;; also the new inquiry response getting of spl terms is now supported:
;;; 1.1 but make sure that this option is intelligible to the user---
;;;     previously insufficient background information was given for
;;;     the user to recognize what was going on apart from the fact
;;;     that an inquiry response was required.
;;;
(defun INQUIRE-RESPONSE (inquiry identifying-flag)
  (unless English-Trace-Flag 
    ;; inquiry already printed if english-trace-flag is t.
    (Print-inquiry-to-window Inquiry))
  (if Identifying-Flag
      (let ((user-info
	     (format nil "The inquiry ~A has not received an answer
from its implementation or any default. The inquiry was 
posed from the chooser of system ~A. It is possible to
provide a response manually. To do this, provide the symbol
that would have been given in an SPL expression for a
response to this inquiry. 

Enter inquiry answer:" inquiry message-sender)))
	(cond ((eq Default-Inquiry-Mode 'implemented)
		  (let* ((user-raw-response 
			  (askwindow :value user-info))
			 (user-response  ;; 2.0 was not getting symbols...
			  (typecase user-raw-response
			    (string (intern (string-upcase user-raw-response)
					    "KPML"))
			    (t user-raw-response)))
			 (term (get-symbol-term user-response)))
		    (if term
			term
		      user-response)))
	      (t
	       (askwindow :value user-info))))

    ;; 4.0 July 2006: the context information was still missing here,
    ;;                added.
    (let ((user-info
	   (format nil "The inquiry ~A has not received an answer
from its implementation or any default. The inquiry was 
posed from the chooser of system ~A. It is possible to
provide a response manually. 

Enter inquiry answer:" inquiry message-sender)))
    (askwindow :choice 
	       user-info
	       (fetch-inquiry-info (CAR Inquiry) 'answerset)))))

;;; ----------------------------------------------------------------------
;;; corrects the unforeseen evaluation of the value of the 
;;; inquiry domain slot. I wonder what this is meant to do!!!
;;; Better check.
;;; John:IPSI:Dec94
;;; --- What this does is to provide a working store for the
;;; record of the inquiry responses, when generation is finished
;;; the values of these stores is copied into the example record
;;; if required. 4 such stores were evidently foreseen (cf.
;;; sgchoice), TP, KB, SS, and LEXICON.  This is particularly
;;; cute seeing that LEXICON is bound to the lexicon and SS is not
;;; bound at all. Presumably this information should be put
;;; somewhere, so as a working patch (KPML 0.9) FETCH-INQUIRY-INFO
;;; is altered so that it gives back TP instead of LEXICON. This
;;; will be refined later.
;;; John:Ober-Ramstadt:Dec95


(defun INQUIRE-ENVIRONMENT 
	(Inquiry &optional (Identifying-Flag nil))
  (let ((inq-domain (fetch-inquiry-info (CAR Inquiry) 'domain))
	(Response nil))
    (unless (Operator-Definition-P (CAR Inquiry))
	    (Acquire-Operator (CAR Inquiry)))
    (SETQ Response (Inquire1 (CDR Inquiry)
			     (if (eq inq-domain 'lexicon) '(nil)
			       (kpml-eval inq-domain))
			     Inquiry
			     inq-domain
			     Identifying-Flag))
    (cond
     ((And (Not Identifying-Flag)
	   (Not (member Response (fetch-inquiry-info (CAR Inquiry) 'answerset))))
      (Warning "The environment responded with " Response "  to the inquiry:  " Inquiry 
	       ".  This response is not among the legal responses:  "
	       (fetch-inquiry-info (CAR Inquiry) 'answerset))))
    Response))


;;; ----------------------------------------------------------------------
;;; FETCH-INQUIRY-DEFAULT (taken from spl/new-operator-run.lisp and
;;; =====================  updated for multilinguality)
;;; (Note that the parameter is changed from the definition to
;;; the name of the definition!)

(defun FETCH-INQUIRY-DEFAULT (op-name grammar-inquiry)
  (let ((default (fetch-inquiry-info op-name 'activedefault))
	answer)
    (setq answer
	  (if (consp default)
	      (dolist (inq-resp default)
		(when (parameter-match-p inq-resp (rest grammar-inquiry))
		  ;; use this default value
		  (return inq-resp)))
	      default))
    (when answer
      (when (inq-response-term answer)
	(setq answer (first (last (term-graph-symbol
				    (if (typep answer 'term-graph)
					answer
					(symbol-value answer)))))))
      (term-id answer))))

