(in-package "ACL")
;;; File: winemacs-eval-server.lisp
;;; John:Stirling:12Oct97
;;;
;;; This takes the eval-server definition written by William G. Dubuque
;;; as part of the EDITI package for interfacing ACL with Emacs on
;;; PCs and changes it so that it never attempts a general Lisp
;;; eval if KPML is in standalone mode. This makes it safe for
;;; editing linguistic resources when KPML is being used as a
;;; standalone application. This file should therefore be loaded
;;; after the EDITI eval-acl.lsp file; alternatively, the function
;;; (kpml-application-editing-on) can be called.
;;;
;;; The s-expr passed from Emacs is sent directly to either kpml-load
;;; (if coming from a temporary file) or kpml-eval (if sent directly
;;; via DDE).

(defun kpml::KPML-APPLICATION-EDITING-ON ()
  (when (fboundp 'eval-server)
    (setf (symbol-function 'eval-server)
      (symbol-function 'kpml-eval-server))))

(defun KPML-EVAL-SERVER ()
  ;;; ORIGINAL COMMENTS FROM eval-acl.lsp
  ;; Process commands only if we are not currently doing so 
  ;; (i.e. level < 0) or else we entered the debugger while evaluating
  ;; a previous command (i.e. either debugger-level > eval-level or
  ;; else we are within the ask-error-action dialog). Todo: we don't
  ;; always want to allow command processing when in the debugger,
  ;; especially if there are a lot of commands queued. Need a priority
  ;; scheme.
  (when (or (< *eval-server-level* 0)
	    t ;; todo (> (debugger-level) *eval-server-level*)
	    *in-ask-error*)
   (loop (when *files-to-eval*
	   (loop (unless *files-to-eval* (return))
		 ;; If (consp file), file = (s-exp package queue-index)
		 (let* ((file (pop *files-to-eval*))
			(s-exp (and (consp file) (first file)))
			(package (and s-exp (second file)))
			(*eval-server-level* (debugger-level))
			;; todo: we really want to pretend that the source file
			;; is the file associated with the buffer.
			(top::*warn-on-redefinition* nil)
			(index (if s-exp (third file) (eval-file-index file)))
			(aborted t)
			string)
		   (when (or s-exp (probe-file file))
		     (unwind-protect

;;; John: Whatever is returned by kpml-eval or kpml-load is used as a possible
;;; response that is sent back to emacs for display...
			 (setq string
			  (with-output-stream-forwarding index
			    (if s-exp
				(let ((*package* *package*)
				      ;; We used to bind this to nil here (cf.
				      ;; [1] below) but now enable recursive
				      ;; DDE sends because NT cannot rely on
				      ;; temp-files due to contention problems.
				      ;; TODO: need a synch. remote eval.
				      (*editi-dde-port* *editi-dde-port*))

				  ;;; John: always in KPML package.
				  (in-package "KPML")
				  ;; Todo: eval vs. compile distinction.
				  ;;; John: following is when DDE is being
				  ;;;       used to execute function calls
				  ;;;       directly initiated from Emacs.
				  (kpml::kpml-eval 
				   (kpml::protocol-edit 
				    (read-from-string s-exp))))

			      ;;; John: following is used when forms to
			      ;;;       evaluate are being sent via temp
			      ;;;       files.
			      (kpml::kpml-load 
			       file :verbose nil :protocol T))

			    (setq aborted nil)))
		       ;; [1] Use DDE for reply iff it was used in original
		       ;; msg and DDE port is not already in use and not
		       ;; aborted (ACL DDE callback will not ack on an aborted
		       ;; Execute, so we can't use DDE for reply in this case). 
		       (let ((*editi-dde-port*
			       (and s-exp (not aborted) *editi-dde-port*)))
			 ;; Note that this call is not allowed to concat string
			 ;; via format since this string is arbitrary and may
			 ;; contain chars misconstrued as format directives,
			 ;; e.g. ~'s, cf. comment in do-send-string-to-emacs.
			 (when string (send-string-to-emacs-via-dde string)))

		       (when (and (not s-exp)
				  (probe-file file)
				  (not *eval-server-trace*))
			 (delete-file file)))))
		 (process-pending-events)))
	 ;; If there are command files waiting to be evaluated,
	 ;; queue them onto the list *files-to-eval*, else exit.
	 (unless (probe-file eval-server-todo-path)
	   (return))
	 ;; bug: this clause needs to be atomic since we are using
	 ;; the existence of the todo path as a semaphore, i.e.
	 ;; we really want to test-if-exists-and-delete the file.
	 (let ((files (directory eval-server-wild-path)))
	   (if files
	       (setq *files-to-eval* (queue-eval-files files))
	     (progn (delete-file eval-server-todo-path)
		    (return)))))))



(eval-when (:execute :load-toplevel)
  (kpml::kpml-application-editing-on))


;;; ----------------------------------------------------------------------
;;; The following function is called instead of all the startup stuff
;;; that is generally passed on first use of the WinEmacs-ACL connection.
;;; This is the value of the WinEmacs variable editi-acl-init-code.
;;; (This is generally set up in eval-ed.el; but we squash its value
;;; in winemacs-side-interaction.el).

#+ignore
(let ((*standard-output* 
       (if (boundp 'acl::*lisp-standard-output*)
	   acl::*lisp-standard-output*
	 *standard-output*)))
  ;; Can't bootstrap loading of eval-acl this way because
  ;; the ACL DDE server is not turned on by default so that
  ;; we will not be able to DDE connect until eval-acl is loaded.
  ;;(unless (fboundp 'acl::eval-server)
  ;;  (load "c:\\emacs\\editi\\eval-acl.lsp" :verbose nil))
  (unless (and (find-package 'dde)
	       (fboundp (intern "OPEN-PORT" 'dde)))
	  (let ((lisp::*load-pathname* "c:\\emacs\\editi\\dde\\"))
	    (load "c:\\emacs\\editi\\dde\\loader.lsp" :verbose nil)))
  (funcall (intern "EDITI-PATCH-DDE" 'dde))
  
  (setq acl::*editi-dde-port* nil)
  (acl::editi-open-server)
  )

;;; This all boils down to a call to the dde:editi-patch-dde function
;;; to make stuff up to date, followed by starting up the server.
;;; We just include a check that things have been loaded correctly
;;; and do the same here...

(defun KPML::START-EMACS-SERVER ()
  (let ((*standard-output* 
	 (if (boundp 'acl::*lisp-standard-output*)
	     acl::*lisp-standard-output*
	   *standard-output*)))
    (unless (and (find-package 'dde)
		 (fboundp (intern "OPEN-PORT" 'dde)))
	    (format *trace-output* 
		    ";;; WARNING. 
;;; ACL DOES NOT HAVE APPOPRIATE DDE CODE LOADED.
;;; THIS MAY BE AN OLD VERSION OF ACL? CHECK VERSIONS
;;; AND LOAD APPROPRIATE DDE FILES.")
	    (return-from KPML::START-EMACS-SERVER nil))

    (funcall (intern "EDITI-PATCH-DDE" 'dde))
    (setq acl::*editi-dde-port* nil)
    (acl::editi-open-server)
    ))


	   



