;;; Copyright (c) 1991-2017 John Carroll, Ann Copestake, Robert Malouf, Stephan Oepen
;;; see LICENSE for conditions


(in-package :lkb)

;;; Record source locations for things, and provide an interface to
;;; display sources in emacs. In allegro, use built-in source recording
;;; and lep facility. Otherwise, code it from scratch and assume we have
;;; SWANK available (although possibly not currently running).

(defun record-source (type stream position)
   (declare (ignore position))
   #+:allegro
   (setf (excl:source-file type :lkb) (excl::filename stream))
   #-:allegro
   (when (typep stream 'file-stream)
     (setf (get type 'type-source-file) (pathname stream))))

(defun source-available-p (thing)
  #+:allegro
  (and (lep:lep-is-running)
       (ignore-errors (excl:source-file thing :lkb)))
  #-:allegro
  (and (or swank::*emacs-connection* (swank::default-connection))
       (get thing 'type-source-file)))


(defun edit-source (thing)
  (let ((source
          #+:allegro (ignore-errors (excl:source-file thing :lkb))
          #-:allegro (get thing 'type-source-file)))
    (when source
      (edit-source-in-file thing source))))

(defun edit-source-in-file (thing file)
  #+:allegro
  (when (lep:lep-is-running)
    (lep::eval-in-emacs (format nil "(find-tdl-definition \"~a\" \"~a\")"
				thing 
				#+:mswindows
				(convert-backslashes-in-filename
				 (format nil "~A" file))
				#-:mswindows file)))
  #-:allegro
  (flet
    ((do-edit ()
      ;; eval-in-emacs requires (setq slime-enable-evaluate-in-emacs t) on the emacs side
      (swank:eval-in-emacs
        `(find-tdl-definition ,(string thing) ,(namestring file))
        t)))
    (cond
      (swank::*emacs-connection* (do-edit))
      ((swank::default-connection)
        (swank::with-connection ((swank::default-connection))
          (do-edit))))))


(defun convert-backslashes-in-filename (str)
  ;;; apparently needed for Windows because the emacs interface
  ;;; can't cope with the backslashes in the filename - doesn't
  ;;; recognise them as escaped.  However, emacs accepts the
  ;;; *nix forward slash syntax, so ...
  ;;; e.g.
  ;;; "D:\\lingo\\lkb\\src\\data\\esslli2k\\grammars\\grammar1\\types.tdl"
  ;;; to
  ;;; "D:/lingo/lkb/src/data/esslli2k/grammars/grammar1/types.tdl"
  (let ((char-list (coerce str 'list))
	(res nil))
    (loop (unless char-list (return))
      (let ((first (car char-list)))
	(setf char-list (cdr char-list))
	(if (eql first #\\)
	    (progn
	      (when (eql (car char-list) #\\)
		(setf char-list (cdr char-list)))
	      (push #\/ res))
	  (push first res))))
    (coerce (nreverse res) 'string)))
    

(defun edit-temp-file (file)
  (unless (stringp file) (setq file (namestring file)))
  #+:allegro
  (when (lep:lep-is-running)
    (lep::eval-in-emacs (format nil "(rogue-find-file \"~a\")"
				#+:mswindows
				(convert-backslashes-in-filename file)
				#-:mswindows file)))
  #-:allegro
  (flet
    ((do-edit ()
      (swank:eval-in-emacs `(rogue-find-file ,file) t)))
    (cond
      (swank::*emacs-connection* (do-edit))
      ((swank::default-connection)
        (swank::with-connection ((swank::default-connection))
          (do-edit))))))


;;; Redefine a single type

(defun redefine-type (definition)
  (setq *syntax-error* nil)
  (with-input-from-string (istream definition)
    (read-tdl-type-stream istream t))
  (unless *syntax-error*
    (if *amend-error*
      (setq *amend-error* nil)
      (when (patch-type-table)
	(canonicalise-feature-order)
	(set-up-type-interactions)
	(format t "~%Done")
	t))))


;;; Functions to manipulate emacs menu bar

(defun add-lkb-menu (menu)
  #+:allegro
  (lep::eval-in-emacs-query :string (format nil "(fi::install-menubar '~A)"
					    menu))
  #-:allegro
  (declare (ignore menu))
  #-:allegro
  (error "~S not implemented" 'add-lkb-menu))


#|
;;; Use an emacs buffer as top-level window

(defun make-lkb-stream ()
  (let ((s nil))
    (flet ((foo (stream)
	     (declare (ignore stream))
	     (or s (setq s (make-lkb-listener-stream)))))
      (let ((s (make-instance 'excl::lazy-encapsulating-stream
		 :init-in #'foo
		 :init-out #'foo)))
	(setf (excl::interactive-stream-p s) t)
	s))))

(defun make-lkb-listener-stream ()
  (let ((s (lep:make-editor-listener-stream :splitp t :name "lkb")))
    (setf (excl::interactive-stream-p s) t)
    s))
|#


;;; Generation and MRS/RMRS from emacs

(defun generate-rmrs-from-emacs (str)
  (with-package (:mrs)
    (let ((rmrs (mrs::read-single-rmrs-from-string str)))
      (when (and rmrs (mrs::rmrs-p rmrs))
	(mrs::generate-from-rmrs rmrs)))))