(in-package "KPML-I")

;;; File: editor-actions.lisp for PC-Lispworks
;;; Author: John.
;;;
;;; THE FOLLOWING SHOULD ONLY BE ACTIVATED
;;; WHEN KPML IS RUNNING IN THE CONTEXT OF KPML-I UNDER CLIM 2.0
;;; USING LISPWORKS 4.0 UNDER WINDOWS.
;;;
;;; ** alternatives for ACL and Unix Allegro are elsewhere. **
;;;
;;; Provides edit actions to all the linguistic objects supported by KPML
;;; when running under PC Lispworks using the Lispworks-internal
;;; emacs-lookalike. Behaviour is different from Unix inasmuch as editing
;;; proceeds asynchronously and the rest of the interface does not
;;; wait any longer.
;;;

(defun EDITING-POSSIBLE? () T)

#+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
			(edit-inquiry-implementation object)) 
		       ;; INSTALLATION DEPENDENT.
		       (otherwise
			(let ((result 
			       (edit-kpml-form-and-wait 
				(let ((kpml::*file-writing* T))  ;; 1.0.5
				  (kpml::systemic-display 
				   object :object-type type :stream nil)))))
			  (format 
			   stream 
			   "~%To make changes, edit and evaluate in
the editing window using M-C-c."))
			)))))))

;;; Normally, the following function  should take a prettified string,
;;; and outputs this  in some editor buffer,  waiting for the modified
;;; strong to be returned.  If  the string  "NOOP" is  returned,  then
;;; nothing   is done and   the function  returns  nil; otherwise, the
;;; result of evaluating   the  string is returned.    However,  under
;;; Windows Lispworks, we  get  a editing window that  sticks  around for as
;;; long as required. Changes can be accepted by evaluating the
;;; modified definition; otherwise (for example if  the window is killed or if
;;; the Cancel button is clicked)  no changes are  made and the window
;;; just goes away. 

(defvar *kpml-buffer-no* 0)

(defun EDIT-KPML-FORM-AND-WAIT (string)
  (let* ((b (editor:make-buffer 
             (concatenate 'string
                          "kpml editor buffer"
                          (format nil " [~A]" (setf *kpml-buffer-no* (1+ *kpml-buffer-no*))))
             :modes '("Lisp")))
         (s (editor:buffers-start b)))
    (setf (editor:buffer-pathname b) (pathname "C:\\tmp\\kpml-edit-buffer"))
    (editor:insert-string s string)
    (editor:goto-buffer b nil)
    ;; go to the beginning of the buffer...
    (editor:beginning-of-buffer-command nil)
    ;; mark the end of the form...
    (editor:mark-form-command nil)
    (editor:indent-region-command nil))
  (values nil))
   
(defun KPML-I::EVALUATE-KPML-EDITED-FORM ()
  nil)

;;; Instead of doing this as a precondition of returning to KPML, we provide
;;; an additional evaluation command that makes sure that changes are 
;;; properly protocolled...

(editor:defcommand "KPML evaluate" (p)
     "Evaluates the current linguistic object, making sure that the
      change is properly protocolled and recorded by KPML."
     "KPML linguistic object evaluation"
  (kpml-lw-editor-evaluation))

(defun KPML-LW-EDITOR-EVALUATION ()
  (when (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))
    ;; go to the beginning of the buffer...
    (editor:beginning-of-buffer-command nil)
    ;; mark the end of the form...
    (editor:mark-form-command nil)
    ;; kpml evaluate the string contained between point and mark...
    (kpml::kpml-eval
     (let ((*package* (find-package "KPML")))
       (read-from-string
       	(kpml::protocol-edit
         (editor:points-to-string (editor:current-point) (editor:current-mark))))))))

(editor:bind-key "KPML evaluate" #\meta-control-\c)

;;; ----------------------------------------------------------------------
;;; Inquiry implementations...
;;;
;;; Based on the 2.0 version of the Unix inquiry implementation editor
;;; minimally adapted for Lispworks. Not quite as nice as the Unix
;;; version but OK for a start. To accept the change, just to have
;;; to evaluate as for a normal Lisp expression with M-C-x.

(defun EDIT-INQUIRY-IMPLEMENTATION (inquiry-implementation)
  (let ((file (second (compiler::source-file inquiry-implementation)))
	(s (clim:get-frame-pane *resource-inspector-frame* 'inspector)))
    (cond ((pathnamep file)
	   (format s "~%Changing edit buffer to find file: ~W" file)
           (format s "~%Make changes by evaluating defuns (M-C-x)")
           (let ((b (editor:find-file-buffer file)))
             (editor:goto-buffer b nil)
             (editor:end-of-buffer-command nil)
             (editor::backward-search-command 
              nil
              (format nil "(defun ~A" (string inquiry-implementation)))))
	  (t
           (if (fboundp inquiry-implementation)
               (format s "~%Inquiry implementation not accessible")
             (progn
               (format s "~%Implementation unknown, making a new definition...")           
               (edit-kpml-form-and-wait
                (with-output-to-string (stream)
                  (format stream "(in-package ~S)~3%~
                             (defun ~A ~S
                               \"Inquiry implementation function not yet defined.\"
                               )~2%"
                          (package-name 
                           (symbol-package inquiry-implementation))
                          inquiry-implementation 
                          (guess-parameters-for inquiry-implementation))))))))
    nil))




