(in-package "KPML-I")

;;; File: editor-actions.lisp
;;; Author: John.
;;;
;;; Adds edit actions to all the linguistic objects supported by KPML.
;;; This file can be loaded for all KPML configurations/installations.
;;; In KPML 1.1+, the edit actions all pass on their request for editing
;;; to the KPML-I function EDIT-OBJECT: this function is parameterized
;;; for specific editing possibilities. The standard options for 1.1
;;; are: 
;;;      (i)   emacs when running with Allegro CL4.3+ under Unix, 
;;;      (ii)  WinEmacs when running under ACL3.0.2 under Windows.
;;;      (iii) the KPML-internal system, chooser, and inquiry editing
;;;            facilities all written in platform independent CLIM.
;;;
;;; 2.0 selection of editing method by object type (Feb98)

(defvar *kpml-editable-objects* 
    '(:system :chooser :inquiry :lexeme :spl-term :inq-impl))
(defvar *kpml-editing-method* 
    '((:system . :kpml)(:chooser . :kpml)(:inquiry . :kpml)
      (:spl-term . :emacs)(:inq-impl . :emacs)
      (:lexeme . :emacs)))
(defvar *kpml-editing-methods* '(:kpml :emacs))

(defvar *EXAMPLE-SLOTS-SHADOWED-IN-EDIT*
  '(:structure :selectionexpressions :preselections))


;;; Most editing protocols pass the work straight onto the generic
;;; systemic object print methods, displaying the results in Emacs
;;; buffers or wherever. Slightly more has to be done for inquiry 
;;; implementations however, since these are just Lisp functions.
;;; The edit function for these is therefore more installation
;;; dependent and is separated.

;;; N.B. Output to emacs buffer has to be as to a file so that the forms
;;; can be evaluated properly (1.0.5).

;;; ACL version is in: acl-clim/winacl-actions.lisp
;;; LW version in in: pclw-clim/editor-actions.lisp

#-(or acl3.0 lispworks)
(defun EDIT-OBJECT (object type)
  (let ((stream (clim:get-frame-pane *resource-inspector-frame* 'inspector)))
    (cond ((eq (cdr (assoc type *kpml-editing-method*)) :kpml)
	   (direct-kpml-internal-editing-request object type))
	  (T
	   (when (editing-possible?)
		 (case type
		       (:spl-term
			(edit-spl-term object))
		       (:inq-impl
			;; INSTALLATION DEPENDENT.
			(edit-inquiry-implementation object)) 
		       (otherwise
			(let ((result 
			       (edit-kpml-form-and-wait 
				(let ((penman::*file-writing* T))  ;; 1.0.5
				  (penman::systemic-display 
				   object :object-type type :stream nil)))))
			  (if result (kpml::kpml-eval result)
			    (format stream "~%No changes made."))))))))))


  ;; 3.2.39 lexeme editor beta added...

(defun DIRECT-KPML-INTERNAL-EDITING-REQUEST (object type)
  (case type
	(:system 
	 (create-a-system-editing-graph object :frame-tool-label object))
	(:chooser
	 (make-a-chooser-editor object :frame-tool-label object))
	(:inquiry
	 (startup-an-inquiry-editor-frame object :frame-tool-label object))
	(:lexeme
	 (startup-a-lexeme-editor-frame object :frame-tool-label object)) 
	(otherwise 
	 (clim:notify-user
	  clim:*application-frame*
	  (concatenate 
	   'string 
	   "KPML-internal editing of type "
	   (string type)
	   " not supported. Use Emacs, or edit a file externally and load.")
	  ))))

;;; ----------------------------------------------------------------------
;;; individual object edit commands...

(define-kpml-resource-inspector-command 
    (com-EDIT-SYSTEM-OF-FEATURE :name t :menu nil)
    ((feature 'feature :gesture :select))
  (when (gethash feature kpml::all-output-features)
    (loop for s in (kpml::who-has-as-output feature)
	do 
	  (edit-object s :system))))

(define-kpml-resource-inspector-command (com-EDIT-SYSTEM :name t :menu nil)
    ((system 'system :gesture :select))
  (edit-object system :system))

(define-kpml-resource-inspector-command (com-EDIT-CHOOSER :name t :menu nil)
  ((chooser 'chooser :gesture :select))
  (edit-object chooser :chooser))

(define-kpml-resource-inspector-command (com-EDIT-INQUIRY :name t :menu nil)
  ((inquiry 'inquiry :gesture :select))
  (edit-object inquiry :inquiry))

(define-kpml-resource-inspector-command (com-EDIT-LEXICAL-ITEM 
					 :name t :menu nil)
  ((lex-item 'lex-item :gesture :select))
  (edit-object lex-item :lexeme))

(define-kpml-resource-inspector-command 
    (com-EDIT-EXAMPLE :name t :menu nil)
  ((example-name 'example-name :gesture :select))
  (let ((old-slot-shadows kpml::*shadowed-slots*)) 
    ;; don't want to edit this stuff...
    (setf kpml::*shadowed-slots*
          (append kpml::*shadowed-slots* *example-slots-shadowed-in-edit*))
    (edit-object example-name :example)
    (setf kpml::*shadowed-slots* old-slot-shadows)))
  
(define-kpml-resource-development-command (com-Edit-Example-RD
					   :name "Edit Example" :menu nil)
    ((example-name 'example-name :gesture :select))
  (let ((old-slot-shadows kpml::*shadowed-slots*)) 
    ;; don't want to edit this stuff...
    (setf kpml::*shadowed-slots*
          (append kpml::*shadowed-slots* *example-slots-shadowed-in-edit*))
    (edit-object example-name :example)
    (setf kpml::*shadowed-slots* old-slot-shadows)))

;;; Editing from resource graphs

(define-systemic-resource-graph-command 
    (com-EDIT-OBJECT :name t)
    ((object 'resource-graph-node :gesture :menu))
  (let ((object (kpml::monolingualize-node object)))
    (cond ((gethash object kpml::system-table)
	   (edit-object object :system))
	  ((gethash object kpml::all-output-features)
	   (loop for s in (kpml::who-has-as-output object)
	       do 
		 (edit-object s :system)))
	  (t nil))))


;;; ----------------------------------------------------------------------
;;; Editing inquiry implementations...

;;; Following command brings up the definition file for the selected
;;; inquiry implementation and finds the first occurence of a defun
;;; of that implementation. 
;;; (Note: should be the *last* occurence that it finds! John:Jun97)

(define-kpml-resource-inspector-command 
    (com-EDIT-INQUIRY-IMPLEMENTATION :name t :menu nil)
    ((inquiry-implementation 'inquiry-implementation :gesture :select))
  (let ((s (clim:get-frame-pane *resource-inspector-frame* 'inspector)))
    (cond ((not (kpml::inquiry-implementation-p inquiry-implementation))
	   (format s "~%No such inquiry implementation defined."))
	  (t
	   (edit-object inquiry-implementation :inq-impl)))))

;;; ----------------------------------------------------------------------
;;; 1.0.11

(define-kpml-resource-inspector-command 
    (com-EDIT-INQUIRY-IMPLEMENTATION-FROM-INQUIRY 
     :name "Edit Inquiry Implementation" :menu nil)
  ((inquiry 'inquiry :gesture :select))
  (let ((inq-impl-fn 
	 (kpml::fetch-inquiry-info inquiry 'kpml::operatorcode))
	(stream (clim:get-frame-pane *resource-inspector-frame* 'inspector)))
    (cond ((or (null inq-impl-fn)
	       (eq inq-impl-fn 'kpml::trivialdefaultcode))
	   (format stream "~%No inquiry implementation for ~S" inquiry))
	  (t
	   (com-edit-inquiry-implementation inq-impl-fn)))))

;;; ----------------------------------------------------------------------
;;; Add editing of SPL terms as consistent with KPML, replacing
;;; the Penman-style of editing SPL.

;;; Delete the following definition from inspection.lisp
;;; And also the definition of the function: edit-spl-function.
   
(define-kpml-resource-inspector-command (com-EDIT-SPL
				  :name t			      
				  :menu nil)
  ()
  (kpml::warning "This Penman command removed: see Edit SPL term for"
		   "its replacement"))

(define-kpml-resource-inspector-command (com-EDIT-SPL-Term
				  :name t			      
				  :menu nil)
    ((term 'spl-term :gesture :select))
  (let ((stream (clim:get-frame-pane *resource-inspector-frame* 'inspector)))
    (when (numberp term)
      (format stream "~%This term is simply the number: ~A" term)
      (return-from com-EDIT-SPL-Term nil))
    (edit-object term :spl-term)
    ))

;;; ----------------------------------------------------------------------
;;; SPL terms...
;;; 
;;; ... since there is no generic function for SPL term displaying
;;; we use the kpml display function and send the output to a string
;;; instead. This is a bit backwards, because we usually do just the
;;; opposite. Note that there is an old SPL function GRAPH-TO-TERM
;;; (in spl-parse.lisp) that would do approximately what we want,
;;; this just needs to be fixed up since it is not working at present.
;;; Need also to get the result of graph-to-term pretty printed though.

(defun EDIT-SPL-TERM (term)
  (let ((stream (clim:get-frame-pane *resource-inspector-frame* 'inspector))
	(result 
	 (EDIT-KPML-FORM-AND-WAIT 
	  (if (and (kpml::term-graph-p (symbol-value term))
		   (eq (kpml::term-graph-type (symbol-value term)) 
		       'kpml::um-set))
	      (with-output-to-string (s)
		(kpml-i::pen-pprint-for-clim 
		 (kpml::term-graph-symbol (symbol-value term))
		 nil s))
	    (with-output-to-string (s)
	      (kpml-i::pen-pprint-for-clim 
	       (symbol-value term) term s))))))
    (if result (spawn-an-spl-generation term result)
	    (format stream "~%No action."))))

;;; ----------------------------------------------------------------------
;;; Find the most recent inquiry definition that used the mentioned
;;; implementation code function and return its parameter declaration.
(defun GUESS-PARAMETERS-FOR (imp-code)
  (loop for x in kpml::inquiry-operators 
      when (eq imp-code (kpml::fetch-inquiry-info x 'kpml::operatorcode))
      do (return-from GUESS-PARAMETERS-FOR 
	   (kpml::fetch-inquiry-info x 'kpml::parameters))))

;;; ----------------------------------------------------------------------
;;; 2.0
;;; Editing options... note these options do not guarantee that any
;;; editing option chosen is actually available to KPML as configured
;;; and installed (e.g., no emacs, no sockets, etc.).

(define-kpml-resource-inspector-command (com-EDITING-METHODS 
					 :name "Editing Methods" :menu nil)
    ()
  (let ((stream (clim::frame-top-level-sheet clim:*application-frame*)))
    (clim:accepting-values
     (#-acl3.0 stream #+acl3.0 *query-io* :own-window t
	       :resynchronize-every-pass t
	       :label "Editing method selection" :exit-boxes 
	       '((:exit "Click here when selection made")
		 (:abort "Click here to cancel")))
     (let ((stream #-acl3.0 stream #+acl3.0 *query-io*))
       (setf *kpml-editing-method*
	 (loop for object in *kpml-editable-objects*
	     collect
	       (let ((selection (cdr (assoc object *kpml-editing-method*)))
                     (prompt-string 
                      (concatenate 'string "Editing method ("
					     (string object) ")"))
                     )
                 (radio-box-accept selection *kpml-editing-methods* prompt-string)
		 (cons object selection))))
       (radio-box-accept *kpml-internal-new-object-creation* (T nil)
                         "Always Use KPML editing method for new objects")
       (kpml-i-terpri stream)
       #+lispworks (kpml-i::dialog-end-spacing)
       ))))








