(in-package "KPML-I")

;;; File: inquiry-editor.lisp
;;; John:Edinburgh:Nov97

;;; Since all the work is more or less already done, add a KPML-only
;;; editing frame for inquiry definitions. This avoids having to edit
;;; these outside in Emacs which is good for the standalone particularly.

(clim:define-presentation-type inq-parameter ())
(clim:define-presentation-type inq-parameter-adder ())
(clim:define-presentation-type inq-gloss-ele  ())
(clim:define-presentation-type inq-type  ())
(clim:define-presentation-type inq-response  ())
(clim:define-presentation-type inq-response-adder  ())
(clim:define-presentation-type association-type  ())
(clim:define-presentation-type created-association-type  ())
(clim:define-presentation-type inq-gloss ())

(clim:define-application-frame 
 INQUIRY-EDITING-FRAME ()
 ((name :initform nil)
  (modified :initform nil)
  (id-inquiry :initform nil)
  (edited-inquiry :initform (kpml::make-inquiry-operator)))
 (:menu-bar nil)
 (:command-table 
  (inquiry-editing-frame
   :inherit-from (clim:user-command-table clim:accept-values-pane)))
 (:top-level (clim:default-frame-top-level))
 (:panes 
  (menu :command-menu
	:foreground menu-fg
	:background menu-bg
	:text-style *menu-font*)
  (inq-pane
   :accept-values :scroll-bars :vertical
   :display-function
   '(clim:accept-values-pane-displayer :displayer edited-inquiry-displayer
     :resynchronize-every-pass T)
   :width #-lispworks 400 #+lispworks 300
   :foreground inspector-fg :background inspector-bg 
   :text-style *sans-serif--bold--10*) ;;*fix--bold--10*
  (gloss-pane
   :application :incremental-redisplay T :scroll-bars :vertical
   :initial-cursor-visibility :inactive
   :display-function 'inquiry-gloss-displayer
   :foreground inspector-fg :background inspector-bg 
   :text-style *fix--bold--10*)
  (used-pane 
   :application :incremental-redisplay T :scroll-bars :vertical
   :initial-cursor-visibility :inactive
   :display-function 'inq-used-where-displayer
   #-lispworks :width #-lispworks 100 
   :foreground inspector-fg :background inspector-bg 
   :text-style *sans-serif--bold--12*)
  (mouse-doc   :pointer-documentation
	       :foreground  mouse-doc-fg
	       :background  mouse-doc-bg))
 (:layouts
  (one-and-only
   (clim:vertically ()
     #-lispworks (25 menu) #+lispworks menu
     (5/8
      (clim:horizontally ()
	(:fill
	 (clim:vertically ()
	   (:fill inq-pane)
	   ))
	(#-lispworks 200 #+lispworks 1/2 used-pane)))
     (:fill gloss-pane)
     #-lispworks (20 mouse-doc)
     ))))


;;; ----------------------------------------------------------------------
;;; Display and link choosers where the inquiry being edited is used...

(defmethod INQ-USED-WHERE-DISPLAYER ((frame inquiry-editing-frame) stream)
  (with-slots (name) frame
    (let ((choosers (sort (append 
			   (kpml::who-can-ask name)
			   (kpml::who-can-pose-identifying-inquiry name))
			  #'string<)))
      (if (and name choosers)
	  (progn
	    (format stream "~%Inquiry used in:~3%")
	    (clim:with-text-style  
	     (stream *fix--bold--8*)
	     (loop for x in choosers
		   do (clim:with-output-as-presentation 
		       (stream x 'chooser)
		       (format stream "~%~A" x)))))
	(progn
	  (format stream "~4%     ")
	  (clim:surrounding-output-with-border
	   (stream :shape :rectangle)
	   (clim:with-drawing-options 
	    (stream :ink clim:+red+)
	    (format stream 
		    "Inquiry ~%    currently ~%     unused."))))))))
	    
(clim:define-presentation-action VIEW-CHOOSER-FROM-INQUIRY-EDITOR
    (chooser nil inquiry-editing-frame)
  (object)
  (kpml::describe-chooser object))

(clim:define-presentation-action SET-CREATED-ASSOCIATION-TYPE
    (created-association-type nil inquiry-editing-frame)
  (object)
  (let* ((association object)
	 (stream (clim::frame-top-level-sheet clim:*application-frame*))
	 (result 
	  (restart-case
	      (clim:accepting-values
		  (stream :own-window T
			  :resynchronize-every-pass t
			  :label "Set created association type" 
			  :exit-boxes 
			  '((:exit "Click to accept")(:abort "Abort")))
                (radio-box-accept association kpml::*micro-function-types* "Set type")
		(kpml-i-terpri stream)
		association)
	    (abort () nil))))
    (if result 
	(progn
	  (setf (kpml::inquiry-operator-createdassociationtype
		 (slot-value clim:*application-frame* 'edited-inquiry))
	    result)
	  (clim:redisplay-frame-pane 
	   clim:*application-frame* 'inq-pane :force-p T))
      object)))

(clim:define-presentation-action SET-ASSOCIATION-TYPE
    (association-type nil inquiry-editing-frame)
  (object)
  (let* ((association (cdr object))
	 (para (car object))
	 (stream (clim::frame-top-level-sheet clim:*application-frame*))
	 (paras (kpml::inquiry-operator-parameters
		 (slot-value clim:*application-frame* 'edited-inquiry)))
	 (result 
	  (restart-case
	      (clim:accepting-values
		  (stream :own-window T
			  :resynchronize-every-pass t
			  :label "Set association type" 
			  :exit-boxes 
			  '((:exit "Click to accept")(:abort "Abort")))
                (radio-box-accept association kpml::*micro-function-types* "Set type")
		(kpml-i-terpri stream)
		association)
	    (abort () nil))))
    (if result 
	(progn
	  (setf (kpml::inquiry-operator-parameters
		 (slot-value clim:*application-frame* 'edited-inquiry))
	    (loop for (para1 . paratype) in paras
		when (equal para1 para)
		collect (cons para result)
		else collect (cons para1 paratype)))
	  (clim:redisplay-frame-pane 
	   clim:*application-frame* 'inq-pane :force-p T))
      object)))



;;; ----------------------------------------------------------------------


(defmethod EDITED-INQUIRY-DISPLAYER  ((frame inquiry-editing-frame) stream)
  (with-slots (modified name edited-inquiry id-inquiry) frame
    (macrolet 
	((opcode () '(kpml::inquiry-operator-operatorcode edited-inquiry))
	 (triv   () '(kpml::inquiry-operator-trivialdefault edited-inquiry))
	 (resps ()  '(kpml::inquiry-operator-answerset edited-inquiry))
	 (paras  () '(kpml::inquiry-operator-parameters edited-inquiry))
	 (created ()
	   '(kpml::inquiry-operator-createdassociationtype edited-inquiry)))
      (flet ((posn (para)
	       (loop for ele in (kpml::inquiry-operator-english edited-inquiry)
		   for i from 0
		   when (and (symbolp ele)(equal ele para))
		   return i)))
	(let ((old-opcode (opcode))(old-name name)(old-triv (triv)))
	  (clim:with-text-face (stream :italic)
	    (clim:with-output-as-presentation (stream id-inquiry 'inq-type)
	      (if id-inquiry (format stream "Identifying inquiry...")
		(format stream "Branching inquiry..."))))
	  (kpml-i-terpri stream)

	  (setf name (clim:accept 'clim:symbol :stream stream
				  #+lispworks :view
				  #+lispworks clim:+textual-dialog-view+
				  :default name :prompt "Inquiry name"))

	  (format stream "~%Parameters: ")
	  (if (paras)
	      (loop for (para . paratype) in (paras)
		  do (clim:with-output-as-presentation
			 (stream (cons (posn para)  para) 'inq-parameter)
		       (format stream " ~A" para))
		     (clim:with-text-style  
			 (stream *sans-serif--roman--6*)
		       (clim:with-output-as-presentation
			   (stream (cons para paratype) 'association-type)
			 (format stream "(~A)" paratype)))
		     (kpml-i-terpri stream)
		     (format stream "                  "))
	    (clim:with-output-as-presentation 
	     (stream nil 'inq-parameter-adder)
	     (format stream "<none>")))
	  (kpml-i-terpri stream)
	  
	  (setf (opcode) 
	    (clim:accept 'clim:symbol :stream stream 
			 #+lispworks :view
			 #+lispworks clim:+textual-dialog-view+
			 :default 
			 (if (opcode) (opcode)
			   (if name
			       (intern 
				(concatenate 'string (string name) "-CODE")
				"KPML")
			     nil))
			 :prompt "Operatorcode"))
	  (kpml-i-terpri stream)
	  (kpml-i-terpri stream)
	  
	  (if id-inquiry
	      (progn
		(format stream "Created association type: ")
		(clim:with-output-as-presentation
		    (stream (created) 'created-association-type)
		  (format stream "~A" (created))))
	    (progn
	      (clim:with-output-as-presentation
		  (stream nil 'inq-response-adder)
		(format stream "Answer set:       "))
	      (if (resps)
		  (loop for resp in (resps) 
		      do (clim:with-output-as-presentation
			     (stream resp 'inq-response)
			   (format stream "~A" resp))
			 (format stream "~%                     "))
		(clim:with-output-as-presentation
		    (stream nil 'inq-response-adder)
		  (format stream "<none>")))))
	  (kpml-i-terpri stream)

	  (setf (triv) 
	    (if id-inquiry
		(clim:accept 'clim:expression :stream stream :default (triv)
			     #+lispworks :view
			     #+lispworks clim:+textual-dialog-view+
			     :prompt "Trivial default")
	      (clim:accept `clim:symbol :stream stream :default (triv)
			   #+lispworks :view
			   #+lispworks clim:+textual-dialog-view+
			   :prompt "Trivial default")))
	  (kpml-i-terpri stream)
	  ;; (format stream "~%Preselection guidance...")
	  
	  (unless (and (equal name old-name)
		       (equal (opcode) old-opcode)
		       (equal (triv) old-triv)
		       )
	    (setf modified T))
	  (setf (kpml::inquiry-operator-name edited-inquiry) name)
	  nil)))))

;;; ----------------------------------------------------------------------
;;; Actions for inputting, changing and editing responses in the
;;; answerset.

(clim:define-presentation-action EDIT-RESPONSE
    (inq-response nil inquiry-editing-frame
		   :documentation "Edit a response")
  (object)
  (with-slots (modified edited-inquiry) clim:*application-frame*
    (let ((edit (edit-element clim:*application-frame* object :expand-p nil)))
      (when edit
	(setf (kpml::inquiry-operator-answerset edited-inquiry)
	  (substitute
	   edit object (kpml::inquiry-operator-answerset edited-inquiry)))
	(setf modified T)
	(clim:redisplay-frame-pane 
       clim:*application-frame* 'inq-pane :force-p T)))))

(clim:define-presentation-action DELETE-RESPONSE
    (inq-response nil inquiry-editing-frame
		   :documentation "Delete a response" :gesture :menu)
  (object)
  (with-slots (modified edited-inquiry) clim:*application-frame*
    (setf (kpml::inquiry-operator-answerset edited-inquiry)
      (remove object (kpml::inquiry-operator-answerset edited-inquiry)))
    (setf modified T)
    (clim:redisplay-frame-pane 
     clim:*application-frame* 'inq-pane :force-p T)))
      
(clim:define-presentation-action ADD-RESPONSE
    (inq-response-adder nil inquiry-editing-frame
			:documentation "Add a response")
  (object)
  (with-slots (modified edited-inquiry) clim:*application-frame*
    (let ((edit (edit-element clim:*application-frame* object :expand-p nil)))
      (when edit
	(pushnew edit (kpml::inquiry-operator-answerset edited-inquiry))
	(setf modified T)
	(clim:redisplay-frame-pane 
	 clim:*application-frame* 'inq-pane :force-p T)))))

(clim:define-presentation-action INQ-PARAMETER-ADDER
   (inq-parameter-adder nil inquiry-editing-frame
			:documentation "Add a parameter")
  (object)
  (with-slots (modified edited-inquiry) clim:*application-frame*
    (let ((edit (edit-element clim:*application-frame* "none" :expand-p nil)))
      (when edit
	    (pushnew (cons (intern (string-upcase edit) "KPML") 'kpml::concept)
		     (kpml::inquiry-operator-parameters edited-inquiry))
	(setf modified T)
	(clim:redisplay-frame-pane 
	 clim:*application-frame* 'inq-pane :force-p T)))))

;;; ----------------------------------------------------------------------
;;; Inquiry gloss handling...

(defun ATOMIZE-INQ-GLOSS (gloss)
  (loop for ele in gloss
      when (symbolp ele) collect ele 
      when (stringp ele) 
      append (break-into-words ele)))

(defun BREAK-INTO-WORDS (string)
  (let ((spaces nil))
    (loop for s from 0 to (1- (length string))
	when (char= (char string s) #\space)
	do (push s spaces))
    (setf spaces (cons -1 (reverse (cons (length string) spaces))))
    (remove ""
	    (loop for b in spaces
		for e in (cdr spaces)
		collect (subseq string (1+ b) e))
	    :test #'string=)))

(defmethod INQUIRY-GLOSS-DISPLAYER ((frame inquiry-editing-frame) stream)
  (with-slots (name edited-inquiry) frame
    (let ((gloss (kpml::inquiry-operator-english edited-inquiry)))
      (clim:with-drawing-options 
	  (stream :ink clim:+green+)
	(clim:with-text-face 
	    (stream '(:bold :italic))
	  (clim:with-output-as-presentation
	      (stream gloss 'inq-gloss)
	    (format stream "~%Gloss..."))))
;;; Following is nice, but squashes the colors with CL4.3, CLIM2.1
;;;      (clim:filling-output (stream :fill-width '(80 :character)))
      (loop for ele in gloss
	  for i from 0
	  do (format stream " " ele)
	  when (equal (mod i 10) 0) do (kpml-i-terpri stream)
				       (format stream "   ")
	  when (symbolp ele)
	  do (clim:with-output-as-presentation
		 (stream (cons i ele) 'inq-parameter)
	       (clim:with-drawing-options 
		   (stream :ink clim:+magenta+)
		 (format stream "~A" ele)))
	  else 
	  do (clim:with-output-as-presentation
		 (stream (cons i ele) 'inq-gloss-ele)
	       (format stream "~A" ele))))))

(clim:define-presentation-action UNPARAMETERIZE-PARAMETER
    (inq-parameter nil inquiry-editing-frame
		   :documentation "Make not a parameter")
  (object)
  (with-slots (modified edited-inquiry) clim:*application-frame*
    (let ((posn (car object))
	  (ele  (cdr object)))
      (setf (kpml::inquiry-operator-parameters edited-inquiry)
	    (remove ele 
		    (kpml::inquiry-operator-parameters edited-inquiry)
		    :key #'car))
      (setf modified T)
      (when posn
	    (setf (elt (kpml::inquiry-operator-english edited-inquiry) posn)
		  (string-downcase (string ele))))
      (clim:redisplay-frame-pane 
       clim:*application-frame* 'gloss-pane :force-p T)
      (clim:redisplay-frame-pane 
       clim:*application-frame* 'inq-pane :force-p T))))

(clim:define-presentation-action PARAMETERIZE-GLOSS-ELEMENT
    (inq-gloss-ele nil inquiry-editing-frame
		   :documentation "Make into a parameter")
  (object)
  (with-slots (modified edited-inquiry) clim:*application-frame*
    (let* ((posn (car object))
	   (ele  (cdr object))
	   (para (intern 
		  (remove-if #'(lambda (x) (member x kpml::*punctuation-bag*))
			     (string-upcase ele))
		  "KPML")))
      (setf (elt (kpml::inquiry-operator-english edited-inquiry) posn) para)
      (push (cons para 'kpml::concept)
	    (kpml::inquiry-operator-parameters edited-inquiry))
      (setf modified T)
      (clim:redisplay-frame-pane 
       clim:*application-frame* 'gloss-pane :force-p T)
      (clim:redisplay-frame-pane 
       clim:*application-frame* 'inq-pane :force-p T))))



(clim:define-presentation-action EDIT-GLOSS-PARAMETER
  (inq-parameter nil inquiry-editing-frame :gesture :menu
		   :documentation "Edit")
  (object)
  (with-slots (modified edited-inquiry) clim:*application-frame*
    (let* ((posn (car object))
	   (ele  (cdr object))
	   (gloss (kpml::inquiry-operator-english edited-inquiry))
	   (edit (edit-element clim:*application-frame* 
			       (string ele)
			       :expand-p nil)))
      (when edit
	    (setf modified T)
	    (setf edit (intern (string-upcase edit) "KPML"))
	    (setf (kpml::inquiry-operator-parameters edited-inquiry)
		  (loop for (para . paratype) 
			in (kpml::inquiry-operator-parameters edited-inquiry)
			when (equal para ele)
			collect (cons edit paratype)
			else collect (cons para paratype)))
	    (when posn (edit-gloss edit posn gloss))
	    (clim:redisplay-frame-pane 
	     clim:*application-frame* 'inq-pane :force-p T)
	    (clim:redisplay-frame-pane 
	     clim:*application-frame* 'gloss-pane :force-p T)))))

(clim:define-presentation-action EDIT-GLOSS-ELEMENT
    (inq-gloss-ele nil inquiry-editing-frame :gesture :menu
		   :documentation "Edit")
  (object)
  (with-slots (modified edited-inquiry) clim:*application-frame*
    (let* ((posn (car object))
	   (ele  (cdr object))
	   (gloss (kpml::inquiry-operator-english edited-inquiry))
	   (edit (edit-element clim:*application-frame* ele)))
      (when edit
	(edit-gloss edit posn gloss)
	(setf modified T)
	(clim:redisplay-frame-pane 
	 clim:*application-frame* 'gloss-pane :force-p T)))))

(defun EDIT-GLOSS (edit posn gloss)
  (with-slots (edited-inquiry) clim:*application-frame*
    (when edit
      (typecase edit
	((or string symbol) 
	 (setf 
	     (elt (kpml::inquiry-operator-english edited-inquiry) posn) edit))
	(cons
	 (setf (kpml::inquiry-operator-english edited-inquiry)
	   (append (subseq gloss 0 posn)
		   edit
		   (subseq gloss (1+ posn)))))
	(otherwise
	 (kpml::warning 
	  "Weird gloss element (" edit ") in gloss: " gloss))))))

(clim:define-presentation-action EDIT-GLOSS-AS-WHOLE
    (inq-gloss nil inquiry-editing-frame
	       :documentation "Edit entire gloss")
  (object)
  (with-slots (modified edited-inquiry) clim:*application-frame*
    (let ((working-result 
	   (if (or (equal object '(""))
		   (null object))
	       nil
	     (apply #'concatenate 
		    (cons 'string 
			  (loop for ele in object
				collect " "
				when (symbolp ele)
				collect (string ele)
				else
				collect ele))))))
      (setf working-result
	    (edit-string-block (if working-result working-result
				 "no gloss yet")
			   :label "Edit gloss (click middle to modify)"))
      (if working-result 
	  (let ((new-gloss (atomize-inq-gloss (list working-result)))
		(paraposns nil))
	    (setf (kpml::inquiry-operator-parameters edited-inquiry)
	      (loop for (para . paratype) 
		  in (kpml::inquiry-operator-parameters edited-inquiry)
		  when (member (string para) new-gloss :test #'string=)
		  collect (cons para paratype)
		  and 
		  do (push (position (string para) new-gloss :test #'string=)
			   paraposns)))
	    (loop for posn in paraposns
		do (setf (elt new-gloss posn)
		     (intern (string-upcase 
			      (elt new-gloss posn))
			     "KPML")))
	    (setf (kpml::inquiry-operator-english edited-inquiry) new-gloss)
	    (setf modified T)
	    (clim:redisplay-frame-pane 
	     clim:*application-frame* 'gloss-pane :force-p T)
	    (clim:redisplay-frame-pane 
	     clim:*application-frame* 'inq-pane :force-p T))
      object))))




;;; ----------------------------------------------------------------------
;;; Menu...

(define-inquiry-editing-frame-command 
    (com-INQUIRY-EDITING-FRAME-QUIT :name "Quit" :menu t)
    ()
  (with-slots (modified id-inquiry edited-inquiry) clim:*application-frame*
    (when (and modified
	       (eq (startup-user-response-frame
		    '("Modified inquiry has not been saved. Save it first?"))
		   :yes))
      (export-edited-inquiry id-inquiry edited-inquiry)
      (setf modified nil))
    (close-a-window clim:*application-frame*)))

(define-inquiry-editing-frame-command 
    (com-INQUIRY-EDITING-FRAME-EXPORT :name "Export" :menu t)
    ()
  (with-slots (modified id-inquiry edited-inquiry) clim:*application-frame*
    (when modified
      (export-edited-inquiry id-inquiry edited-inquiry)
      (setf modified nil))))

(define-inquiry-editing-frame-command 
    (com-INQUIRY-EDITING-FRAME-CLEAR :name "Clear" :menu t)
    ()
  (with-slots (modified name edited-inquiry) clim:*application-frame*
    (setf name nil)
    (setf modified T)
    (setf edited-inquiry (kpml::make-inquiry-operator))))

(define-inquiry-editing-frame-command 
    (com-INQUIRY-EDITING-REVERT :name "Revert" :menu t)
    ()
  (with-slots (name) clim:*application-frame*
    (if (kpml::inquiry-defined-for-lg-p name kpml::curlan)
	(initialize-edited-inquiry name clim:*application-frame*)
      (clim:notify-user 
       clim:*application-frame*
       (concatenate 'string
	 "No inquiry named " 
	 (string name)
	 " currently saved for language: "
	 (string kpml::curlan))))))

(define-inquiry-editing-frame-command 
    (com-INQUIRY-EDITING-FRAME-COMMENTS :name "Comments" :menu t)
    ()
  (with-slots (modified name edited-inquiry) clim:*application-frame*
    (let ((edit (edit-string-block 
		 (let ((c (kpml::inquiry-operator-comments edited-inquiry)))
		   (if (and c (or (and (stringp c)
				       (not (string= c "")))
				  (and (consp c)
				       (not (equal c '(""))))))
		       (kpml::inquiry-operator-comments edited-inquiry)
		     "no comments"))
		 :label "Edit inquiry comment (click middle to modify)"
		 :height 100 :width 200)))
      (when edit
	(setf (kpml::inquiry-operator-comments edited-inquiry) edit)
	(setf modified T)))))

;;; ----------------------------------------------------------------------
;;; Work for exporting, prechecks, saving, and protocolling...

(defun EXPORT-EDITED-INQUIRY (id-inquiry inquiry)
  (when (edited-inquiry-exportable-p id-inquiry inquiry)
    (kpml::load-ml-inquiry
     `(:name ,(list kpml::curlan (kpml::inquiry-operator-name inquiry))
	     :domain ,(kpml::inquiry-operator-domain inquiry)
	     :mode ,(kpml::inquiry-operator-mode inquiry)
	     :parameters 
	     ,(mapcar #'car (kpml::inquiry-operator-parameters inquiry))
	     :parameterassociationtypes
	     ,(mapcar #'cdr (kpml::inquiry-operator-parameters inquiry))
	     :english ,(kpml::inquiry-operator-english inquiry)
	     :operatorcode ,(kpml::inquiry-operator-operatorcode inquiry)
	     :answerset ,(kpml::inquiry-operator-answerset inquiry)
	     :preselectionguidance 
	     ,(kpml::inquiry-operator-preselectionguidance inquiry)
	     :createdassociationtype 
	     ,(kpml::inquiry-operator-createdassociationtype inquiry)
	     :trivialdefault 
	     ,(kpml::inquiry-operator-trivialdefault inquiry)
	     :comments 
	     ,(kpml::inquiry-operator-comments inquiry)
	     :editor
	     ,(kpml::inquiry-operator-editor inquiry)
	     :date ,(list (kpml::time-stamp))))
    ;; and protocol the edit....
    (kpml::protocol-edit
     (kpml::systemic-display (kpml::inquiry-operator-name inquiry)
			     :object-type :inquiry :stream nil)))
  )

    
(defun EDITED-INQUIRY-EXPORTABLE-P (id-inquiry inquiry)
  (cond ((null (kpml::inquiry-operator-name inquiry))
	 (clim:notify-user clim:*application-frame*
			   "No inquiry name defined.")
	 nil)
	((and id-inquiry
	      (null (kpml::inquiry-operator-createdassociationtype inquiry)))
	 (clim:notify-user clim:*application-frame*
			   "No created assocation type defined.")
	 nil)
	((and (not id-inquiry)
	      (null (kpml::inquiry-operator-answerset inquiry)))
	 (clim:notify-user clim:*application-frame*
			   "No answer set defined.")
	 nil)
	((and (kpml::inquiry-operator-parameters inquiry)
	      (not (loop for (p . type) 
		       in (kpml::inquiry-operator-parameters inquiry)
		       always (member type kpml::*micro-function-types*))))
	 (clim:notify-user clim:*application-frame*
			   "Parameter type undefined.")
	 nil)
	(T
	 (or (member :resource-patches kpml::*loading-saving-profile*)
	     (eq (startup-user-response-frame
		  '("Patch versioning is not activated. Do you really want to change the loaded resources?"))
		 :yes)))))


;;; ----------------------------------------------------------------------
;;; Mouse sensitivity and editing commands...

(clim:define-presentation-action set-inquiry-type
    (inq-type nil inquiry-editing-frame)
  (object)
  (with-slots (modified id-inquiry) clim:*application-frame*
    (setf id-inquiry (not object))
    (setf modified T)
    (clim:redisplay-frame-pane 
     clim:*application-frame* 'inq-pane :force-p T)))


;;; ----------------------------------------------------------------------
;;; Get the show on the road...

;;; Initialization...


(defun COPY-ACROSS-INITIALLY-UNCHANGED-INQUIRY-SLOTS (source inq-frame)
  (with-slots (edited-inquiry) inq-frame
    (setf (kpml::inquiry-operator-preselectionguidance edited-inquiry)
      (kpml::fetch-inquiry-info source 'kpml::preselectionguidance))
    (setf (kpml::inquiry-operator-mode edited-inquiry)
      (kpml::fetch-inquiry-info source 'kpml::mode))
    (setf (kpml::inquiry-operator-domain edited-inquiry)
      (kpml::fetch-inquiry-info source 'kpml::domain))
    (setf (kpml::inquiry-operator-editor edited-inquiry)
      (kpml::fetch-inquiry-info source 'kpml::editor))
    (setf (kpml::inquiry-operator-comments edited-inquiry)
      (kpml::fetch-inquiry-info source 'kpml::comments))
    (setf (kpml::inquiry-operator-trivialdefault edited-inquiry)
      (kpml::fetch-inquiry-info source 'kpml::trivialdefault))
    ))

(defun INITIALIZE-EDITED-INQUIRY (inquiry inq-frame)
  (setf (slot-value inq-frame 'name) inquiry)
  (setf (slot-value inq-frame 'id-inquiry) 
    (not (kpml::branching-inquiry-p inquiry)))
  (setf (slot-value inq-frame 'edited-inquiry) 
    (kpml::fetch-inquiry-info inquiry 'kpml::everything))
  (setf (kpml::inquiry-operator-name (slot-value inq-frame 'edited-inquiry))
    (kpml::strip-ml 
     (kpml::inquiry-operator-name (slot-value inq-frame 'edited-inquiry))
     kpml::curlan))
  (setf (kpml::inquiry-operator-english 
	 (slot-value inq-frame 'edited-inquiry))
    (atomize-inq-gloss 
     (kpml::inquiry-operator-english 
      (slot-value inq-frame 'edited-inquiry))))
  (setf (kpml::inquiry-operator-parameters 
	 (slot-value inq-frame 'edited-inquiry))
    (loop for para in (kpml::inquiry-operator-parameters 
		       (slot-value inq-frame 'edited-inquiry))
	for paratype in (kpml::inquiry-operator-parameterassociationtypes
			 (slot-value inq-frame 'edited-inquiry))
	collect (cons para paratype)))
  (copy-across-initially-unchanged-inquiry-slots inquiry inq-frame)
  (setf (slot-value inq-frame 'modified) nil))


;;; Bring up the window...
;;; Extra options for when the inquiry is being built new. This is
;;; triggered by the inquiry given being NIL.
;;; Starting defaults can then include:
;;;   (a) whether it is an id-inquiry or a q-inquiry
;;;   (b) some set of responses for the answerset
;;;   (c) the name it should have.
;;;

(defun STARTUP-AN-INQUIRY-EDITOR-FRAME 
    (inquiry &key (id-inquiry nil)
		  (answerset nil)
		  (name nil))
  (let ((inq-frame
	 (clim:make-application-frame 'inquiry-editing-frame
				      :pretty-name (concatenate 
						       'string 
						     "Inquiry editing frame ("
						     (if inquiry
							 (string inquiry)
						       "new inquiry")
						     ") [alpha version]")
				      :height 400)))
    (cond (inquiry (initialize-edited-inquiry inquiry inq-frame))
	  (t (setf (slot-value inq-frame 'modified) nil)
	     (setf (slot-value inq-frame 'id-inquiry) id-inquiry)
	     (setf (slot-value inq-frame 'name) name)
	     (when answerset
	       (setf (kpml::inquiry-operator-answerset
		      (slot-value inq-frame 'edited-inquiry))
		 answerset))))
    (process-run-function 
     "INQUIRY-EDITOR"
     #'run-packaged-frame
     inq-frame (find-package "KPML"))
    T))

;;; ----------------------------------------------------------------------
;;; General utilities...

;;; Following brings up a pane for editing a block of text as a
;;; string. Clearly a candidate for replacement by something nice
;;; and native that works. Takes a string as default as argument,
;;; returns the modified string or nil if no change (abort).

(defun EDIT-STRING-BLOCK (working-result 
			  &key (width 60)(height 100)(label "Edit string"))
  (let ((stream (clim::frame-top-level-sheet clim:*application-frame*)))
    (restart-case
      (clim:accepting-values
	  (stream :own-window T
		  :right-margin width
		  :bottom-margin height
		  :resynchronize-every-pass t
		  :label label 
		  :exit-boxes 
		  '((:exit "Click to accept")(:abort "Abort")))
        #+lispworks 
        (format stream "Be sure to press return after entering your string!")
        (kpml-i-terpri stream)
	(kpml-i-terpri stream)
	(setf working-result
	  (clim:accept 'clim:string
		       :view
		       #+lispworks clim:+textual-dialog-view+
		       #-lispworks 'clim:list-pane-view
		       :prompt ""
		       :stream stream
		       :default working-result))
	(kpml-i-terpri stream))
    (abort () (setf working-result nil)))
  working-result))


;;; Following brings up a little accepting-values to edit a given
;;; form. Either returns the edited element or nil
;;; if no change. The element after editing is either a single string (if
;;; the edit is 1-1, or if expand-p is T, a list of strings (1-n).
;;; If expand-p is nil and the element is expanded (1-n) then the
;;; n-words of the expansion are still returned as a single element.

(defun EDIT-ELEMENT (frame default &key (expand-p t))
  (let ((stream (clim::frame-top-level-sheet frame))
	(l default))
    (restart-case
	(clim:accepting-values
	    (stream :own-window *wide-own-window*
		    :resynchronize-every-pass t
		    :right-margin 60
		    :bottom-margin 50
		    :label "Edit item" 
		    :exit-boxes 
		    '((:exit "Click to accept")
		      (:abort "Abort")))
	  (kpml-i-terpri stream)
	  (setf l 
	    (if (and (symbolp default)
		     (not expand-p))
		(clim:accept 'clim:symbol :stream stream
			     :view
			     #+lispworks clim:+textual-dialog-view+
			     #-lispworks 'clim:list-pane-view
			     :default l)
	      (clim:accept 'clim:string :stream stream
			   :view
			   #+lispworks clim:+textual-dialog-view+
			   #-lispworks 'clim:list-pane-view
			   :default l))))
      (abort () (return-from EDIT-ELEMENT nil)))
    (if (equal l default)
	nil
      (if expand-p
	  (let ((result (atomize-inq-gloss (list l))))
	    (if (equal (length result) 1)
		(first result)
	      result))
	l))))

