;;; swank-protocol.lisp
;;;
;;; Copyright (C) 2004 Peter Graves
;;; $Id: swank-protocol.lisp,v 1.4 2004/09/15 19:19:02 piso Exp $
;;;
;;; This program is free software; you can redistribute it and/or
;;; modify it under the terms of the GNU General Public License
;;; as published by the Free Software Foundation; either version 2
;;; of the License, or (at your option) any later version.
;;;
;;; This program is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with this program; if not, write to the Free Software
;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.

;;; Adapted from SLIME, the "Superior Lisp Interaction Mode for Emacs",
;;; originally written by Eric Marsden, Luke Gorrie and Helmut Eller.
;;; Further adapted by Brad Beveridge in 2006 to be integrated with Slim-Vim
;;; and be compatible with modern slime (v2.0)

(in-package :swank-protocol)

(export '(encode-message decode-message port-file))

(defvar *swank-io-package*
  (let ((package (make-package :swank-io-package :use '())))
    (import '(nil t quote) package)
    package))

; (defun prin1-to-string-for-emacs (object)
;   (with-standard-io-syntax
;     (let ((*print-case* :upcase)
;           (*print-readably* nil)
;           (*print-pretty* nil)
;           (*package* *swank-io-package*))
;       (prin1-to-string object))))

(defun encode-message (message stream)
  (let* ((string (glue:prin1-to-string-for-emacs message))
         (length (length string)))
    (format t "Sending -> ~6,'0x~A~%" length string)
    (let ((*print-pretty* nil))
      (format stream "~6,'0x" length))
    (write-string string stream)
    ;;(terpri stream)
    (finish-output stream)
    (format t "Finished sending~%")
  ))

(defun read-form (string)
  (with-standard-io-syntax
    (read-from-string string)))

(defun next-byte (stream)
  (char-code (read-char stream t)))

(defun shift-array-left (array how-many)
  (if (= (fill-pointer array) how-many)
    (setf (fill-pointer array) 0)
    (progn
      (replace array array :start1 0 :start2 how-many)
      (setf (fill-pointer array) 
	    (- (fill-pointer array) how-many)))))

(let (msg-length)

  (defconstant +msg-length-len+ 6)

  (defun decode-message-length (input)
    (when (and (null msg-length)
	       (>= (length input) +msg-length-len+))
      (setf msg-length (parse-integer (subseq input 0 +msg-length-len+) :radix 16))
      ; (format t "msg-length sequence is: ~S~%" (subseq input 0 +msg-length-len+))
      ; (format t "parsed msg-length is ~D~%" msg-length)
      (shift-array-left input +msg-length-len+)
      ))

  (defun decode-message (input)
    (decode-message-length input)
    (when (and msg-length 
	       (>= (length input) msg-length))
      (prog1 (read-form (subseq input 0 msg-length))
	(shift-array-left input msg-length)
	; (format t "input buffer is now: ~S~%" input)
	(setf msg-length nil))))
  )

(defun port-file ()
  (merge-pathnames ".j/swank" (user-homedir-pathname)))