(in-package :lep)
;;; File: lisp-side-interaction.el
;;;
;;; Code for enabling interaction between KPML and the emacs for
;;; editing resource definitions.
;;; Taken from ACL FAQ: 4.2: LEP Protocol
;;; Patched at KPML 2.1 for ACL5.0 and emacs fonts.
;;;            KPML 4 (Mar 2002) removed the unused but troublesome
;;;                              definition of ED-WAIT since it does
;;;                              appear to do anything and breaks in
;;;                              ACL5 on Windows at least.
;;;
;;; Usage based on:
;;; user(14): (lep::ed-sexp-wait '(foo bar))
;;;  >>> right here, the *ed* buffer popped up and I added `baz' to the
;;;  >>> end of the list, then typed C-cC-c.  Then, lep::ed-sexp-wait returned:
;;; (foo bar baz)
;;;
;;; user(15):


   ;;;; ED-WAIT (at KPML4 removed to prevent package errors in MP)

#+ignore
   (defun ed-wait (symbol)
     (let ((process (make-session nil 'metadot-session
                                  :fspec symbol
                                  :lisp-initiated-p t)))
       (mp:process-wait "for ED-WAIT to complete"
                        #'(lambda (process)
                            (null (mp:process-stack-group process)))
                        process)))

   ;;;; ED-SEXP

   (define-query ed-sexp-query (form) (simple-query)
     (:replyp t)
     ("lep::edit-form" form))

   (defun ed-sexp (form)
     (ed-sexp-query :form form))

   ;;;; ED-SEXP-WAIT

   (defun ed-sexp-wait (form)
     (let* ((string (with-output-to-string (s)
                      (write form :stream s :pretty t)))
            (new-string
             (wait-for-reply (ed-sexp-wait-1 :string string))))
       (values (read-from-string new-string))))

   (define-query ed-sexp-wait-1 (string) (simple-query)
     (:oncep nil)
     ("lep::edit-string-wait" string))

;;; KPML additions -------------------------------------------------------

(defun DEFONTIFY-EMACS-STRING (new-string)
  ;; 2.1 necessary to be more careful about what emacs gives back,
  ;; Fancy emacs might give an array with the string plus font
  ;; information back. Have to head this off at the pass.
  (setf new-string
    (if (stringp new-string) new-string
      (if (arrayp new-string)
	  (aref new-string 0)
	"KPML: Error in emacs-lisp info passing"))))

;;; KPML variant of ed-sexp-wait. string is already prettified...
;;; 1.1 protocoling added.

(defun EDIT-KPML-FORM-AND-WAIT (string)
  (let* ((new-string
	  (defontify-emacs-string  ;; 2.1
	      (wait-for-reply 
	       (ed-sexp-wait-1 :string string)))))
    (if (string= new-string "NOOP")
	(values nil)
      (values 
       (read-from-string 
	(kpml::protocol-edit new-string)))))) 

;;; 1.0.14 and 1.0.15 (1.1)
;;; 2.1
(defun EDIT-KPML-FORM-AND-WAIT-2 (string)
  (let* ((new-string
	  (defontify-emacs-string
	      (wait-for-reply
	       (ed-sexp-wait-1 :string string)))))
    (if (string= new-string "NOOP")
	(values nil)
      (multiple-value-bind 
	  (package-def newstart)
	  (read-from-string (kpml::protocol-edit new-string))
	(let* ((*package*
		(if (string= (string (first package-def)) "IN-PACKAGE")
		    (find-package (second package-def))
		  (find-package "KPML")))
	       (form (read-from-string (subseq new-string newstart))))
	  (return-from EDIT-KPML-FORM-AND-WAIT-2 (values form)))))))


;;; Interface display function.
;;; Note that the result is not evaluated at all, nor do
;;; we wait for any operation on it---just print and go...

(define-query ed-sexp-nowait (string) (simple-query)
	      (:oncep nil)
	      ("lep::show-string-nowait" string))

;;; ----------------------------------------------------------------------
;;; 2.1 conditionalized...
(defvar *emacs-side-interaction* "emacs/emacs-side-interaction.el")
;;; ----------------------------------------------------------------------

(defun KPML::SEND-STRING-TO-EMACS (string)
  (ed-sexp-nowait :string string)
  (values nil))

(defun KPML::EDITING-ON ()
  (let* ((kpml-emacs-commands-file
	  (merge-pathnames *emacs-side-interaction*
			   common-lisp-user::*root-of-kpml*))
	 (load-command (concatenate 'string
			 "(load \""
			 (namestring kpml-emacs-commands-file)
			 "\")")))
    ;; 4.0 if we are under Windows, then we loose because we need to
    ;;     double escape the backslashes to get them across to 
    ;;     Emacs intact.
    #-unix
    (setf load-command (protect-backslashes load-command))
    
    (format t "~%;;; Emacs loading: ~A" kpml-emacs-commands-file)
    (format t "~%;;; This file can be added to the Emacs startup loads!")
    (eval-in-emacs load-command)))



#-unix
(defun protect-backslashes (string)
  (coerce
   (loop for i from 0 to (1- (length string))
       when (char= (char string i) #\\)
       collect #\\ and collect #\\
       else
       collect (char string i))
   'string))
  
		  


