; TODO - need a better solution than rebinding *standard-output* for EVERY function
(in-package :vim-slime)

#|
(profiler:show)
(profiler:clear)
(profiler:reset)
|#

; Create an object so we can stream to a vim buffer
(defvar *vim-output-buffer*
  (make-instance 'buffer-util:vim-buffer-output-stream :buffer "--debug-sv--"))
(defvar *vim-repl-buffer*
  (make-instance 'buffer-util:vim-buffer-output-stream :buffer "--slim-vim-repl--"))
(defvar *vim-error-buffer*
  (make-instance 'buffer-util:vim-buffer-output-stream :buffer "--slim-vim-errors--"))
;(setf *standard-output* *vim-output-buffer*)

(defvar *profiling* nil)
(defun enable-profiling ()
 (profiler:profile-package "VIM-SLIME")
 (profiler:profile-package "VIM")
 (profiler:profile-package "BUFFER-UTIL")
 (profiler:profile-package "SLIME"))

; Connect to the Swank backend
(defun slime-connect ()
  (let ((*standard-output* *vim-output-buffer*))
    (slime:set-io-callback
      #'(lambda (string)
	  (when string
	    (write-string string *vim-repl-buffer*)
	    ;(write-char #\Newline *vim-repl-buffer*)
	    ; (buffer-util:scroll-window-of *vim-repl-buffer*)
	    )))
    ;(slime:set-io-callback #'(lambda (string) nil))
    (slime:read-port-and-connect 1)
    (slime-init-connection-state)
    (when *profiling* (enable-profiling))))

(defun slime-init-connection-state ()
  (slime:get-connection-info #'slime-set-connection-info))

; TODO, package these global vars, remove the SLIME- prefix
(defvar *slime-pid* nil)
(defvar *slime-communications-style* nil)
(defvar *slime-lisp-features* nil)
(defvar *slime-lisp-package* nil)
(defvar *slime-lisp-package-prompt-string* nil)
(defvar *slime-lisp-implementation-type* nil)
(defvar *slime-lisp-implementation-version* nil)
(defvar *slime-lisp-implementation-name* nil)
(defvar *slime-machine-instance* nil)

(defun slime-set-connection-info (info)
  (format *vim-output-buffer* "slime-set-connection-info got ~A~%" info)
  (destructuring-bind (&key pid style lisp-implementation machine
                            features package) info
    (setf *slime-pid* pid
          *slime-communications-style* style
          *slime-lisp-features* features)
    (destructuring-bind (&key name prompt) package
      (setf *slime-lisp-package* name
            *slime-lisp-package-prompt-string* prompt))
    (destructuring-bind (&key type name version) lisp-implementation
      (setf *slime-lisp-implementation-type* type
            *slime-lisp-implementation-version* version
            *slime-lisp-implementation-name* name))
    (destructuring-bind (&key instance type version) machine
      (setf *slime-machine-instance* instance)))
  (setup-repl))

; TODO - is this a vim provided function now?
#|
(defmacro with-preserve-cursor (&body body)
 "Evaluate body and return that value.  The Vim cursor may move within the current buffer
  and this macro will save the cursor position"
 (let ((save-cursor (gensym))
       (ret         (gensym)))
  `(let ((,save-cursor (vim:window-cursor))
         (,ret (progn ,@body)))
      (set-cursor (car ,save-cursor) (cdr ,save-cursor))
      ,ret)))

(defun set-cursor (line col)
 "Lisp wrapper to move the cursor"
  (vim:execute (format nil "call cursor (~a, ~a)" line col)))
|#
(defun slime-macroexpand-general (expander-func)
  (when (slime:connected-p)
    (let ((*standard-output* *vim-output-buffer*))
      (let ((form (buffer-util:get-cur-expr nil)))
       (funcall expander-func form
        (lambda (result) (format *vim-repl-buffer* "~A~%" result))
        (slime-find-buffer-package))))))

(defun slime-macroexpand-1 ()
 (slime-macroexpand-general #'slime:macroexpand-1))

(defun slime-macroexpand-all ()
 (slime-macroexpand-general #'slime:macroexpand-all))

(defun slime-eval-defun ()
  (when (slime:connected-p)
    (let ((*standard-output* *vim-output-buffer*))
      (let ((form (buffer-util:get-cur-expr t)))
	(format *vim-repl-buffer* "~A~%" form)
	(if (and (>= (length form) 8) (string= "(defvar " (subseq form 0 8)))
	  (slime:re-evaluate-defvar form)
	  (slime:interactive-eval form
	    (lambda (result) 
	      (vim:msg (format nil "Result ~a" result))
	      (format *vim-repl-buffer* "~A~%" result)
	      (setup-repl))
	    (slime-find-buffer-package)))))))

(defun slime-eval-last-expression ()
  (when (slime:connected-p)
    (let ((*standard-output* *vim-output-buffer*))
      (let ((form (buffer-util:get-cur-expr)))
	(slime:interactive-eval form
	  (lambda (result) (vim:msg (format nil "Result ~a" result)))
	  (slime-find-buffer-package))))))

#|
(defun swank-listen ()
  (let ((*standard-output* *vim-output-buffer*))
    (slime:process-available-input)))

(slime:interactive-eval "(load \"/Users/brad/development/lisp/ecl-slime/test.lisp\")" nil nil)
(slime:interactive-eval "(setf swank::*redirect-io* t)" nil nil)
(slime:interactive-eval "swank::*redirect-io*"
 (lambda (result) (format t "Res ~A ~a ~a~%" result (type-of result) (type-of (read-from-string (string-trim " =>" result)))))
 nil)
(slime:interactive-eval "swank::*redirect-io*"
 (lambda (result) (format t "Res ~A ~a ~a~%" result (type-of result) (type-of (read-from-string (string-trim " =>" result)))))
 nil)

(concatenate 'string (vim:getcwd) "/" (vim:buffer-name))
|#
; TODO, lots.  Check if the buffer is actually a file, check modified status, possibly save buffer
(defun slime-compile-file (&optional load)
  (when (slime:connected-p)
    (let ((*standard-output* *vim-output-buffer*))
      (let ((lisp-filename (buffer-util:full-pathname (vim:buffer-name))))
	(case (probe-file lisp-filename)
	  (nil (vim:msg (format nil "File ~A doesn't exist")))
	  (t   (vim:msg (format nil "Compiling ~A" lisp-filename))
	       (slime:slime-compile-file lisp-filename
                  #'(lambda (results)
                      (format t "Finished Compiling ~A in ~A sec~%" lisp-filename (cadr results))
                      (vim:msg (format nil "Finished Compiling ~A in ~A sec, processing notes...." lisp-filename (cadr results)))
                      (slime:compiler-notes #'handle-compiler-notes))
                load)
               ))))))

; TODO - not very robust, only works with single line (in-package and must
;        be at the start of the line
(defun slime-find-buffer-package ()
 "Figure out which Lisp package the current buffer is in"
 (let ((line-num (vim:search "^(in-package" :flags '(:backward :no-wrap :do-not-move))))
  (format t "in-pack found on line ~A ~a~%" line-num (car (vim:window-cursor)))
  (if (and line-num (/= line-num (car (vim:window-cursor))))
   (let* ((line (first (vim:buffer-lines :start line-num :end (1+ line-num))))
          (pos (position #\Space line)))
    (string-trim " ():" (subseq line pos)))
   "COMMON-LISP-USER")))

; accepts a string that is a partial form
; needs to search back from the cursor for the last enclosing form
; TODO - is bound to Space in slime
(defun slime-echo-arglist (partial-form package)
 (let ((state nil)
       (cur-sym)
       (result ()))
  (labels ((inc-str () (setf partial-form (subseq partial-form 1)))
           (parens () (cond
                       ((char= (char partial-form 0) #\()
                          (setf state #'symb
                           cur-sym (make-string 0)))
                       ((char= (char partial-form 0) #\)) (pop result))))
           (symb () (cond
                     ((char= (char partial-form 0) #\Space) (setf state #'parens) (push cur-sym result))
                     ((char= (char partial-form 0) #\)) (setf state #'parens))
                     (t (setf cur-sym (concatenate 'string cur-sym (string (char partial-form 0))))))))
   (setf state #'parens)
   (loop while (> (length partial-form) 0)
    do
       ;(format t "About to call ~A:~A,~A~%" state cur-sym partial-form)
       (funcall state)
       (inc-str))
   (format t "echoing for form ~A~%" result)
   (when result
    (slime:get-arglist result package #'(lambda (value) (if value (vim:msg value) (vim:msg "Unknown function"))))))))

(defun slime-echo-current-arglist (&key (repl nil))
  (when (slime:connected-p)
    (let ((*standard-output* *vim-output-buffer*))
      (let* ((line (vim:get-line))
	     (partial (subseq line 0 (1+ (cdr (vim:window-cursor))))))
	(format t "Partial form is ~A~%" partial)
	(when partial
	  (slime-echo-arglist partial (if repl *slime-lisp-package* (slime-find-buffer-package))))))))

; TODO - really we want to inspect either the whole word under the cursor, or the selection
; right now we do not handle selections
(defun slime-inspect ()
  (when (slime:connected-p)
    (let ((*standard-output* *vim-output-buffer*))
      (let ((form (buffer-util::get-word-under-cursor)))
	(slime:slime-inspect form #'interface::slime-open-inspector
			      (slime-find-buffer-package))))))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Compiler note handling
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun file-byte-pos-to-linenum (filename byte-num)
 (with-open-file (file filename :direction :input)
  (let ((line-count 1)
        (last-line 0))
   (loop :for byte-count :upto byte-num
    :when (char= (read-char file) #\Newline) do (incf line-count))
   line-count)))

(defun get-file-and-pos (location)
 (glue:destructure-case location
    ((:error _) (format t "Got :error when I expected :location~%") nil)
    ((:location file pos _hints)
     (cond ((eq (car file) :source-form) (format t "Got :source-form"))
           (t (glue:destructure-case pos
               ((:position pos &optional alignp)
                (let ((filename (cadr file)))
                 (list filename pos))) ; this is our expected output
               (t (format t "Expected :position, didn't get it~%"))))))))

(defun compiler-note-to-error-string (note)
  (destructuring-bind (&key message severity location references short-message) note
   (let ((filepos (get-file-and-pos location)))
    (when filepos
     (let ((filename (car filepos))
           (pos (cadr filepos)))
      (format nil "~A>~A>~A ~A" filename
                                (file-byte-pos-to-linenum filename pos)
                                severity
                                (substitute #\Space #\Newline short-message)))))))

(defun get-plist (list key)
 (loop for k on list by #'cddr
  :when (eq key (car k))
    :do (return (cadr k))))

(defun note< (n1 n2)
 (let ((severity-assoc '((:error . 1) (:warning . 2) (:style-warning . 3) (:note . 4))))
  (cond ((not (eq (get-plist n1 :severity) (get-plist n2 :severity)))
         (< (cdr (assoc (get-plist n1 :severity) severity-assoc))
            (cdr (assoc (get-plist n2 :severity) severity-assoc))))
        (t
         (let* ((l1 (get-plist n1 :location))
                (l2 (get-plist n2 :location))
                (filepos1 (get-file-and-pos l1))
                (filepos2 (get-file-and-pos l2)))
          (if (string= (car filepos1) (car filepos2))
              (< (cadr filepos1) (cadr filepos2))
              (string< (car filepos1) (car filepos2))))))))

(defun handle-compiler-notes (notes)
 (sort notes #'note<)
 ;(format t "handle-compiler-notes notes are: ~A~%" notes)
 (interface::erase-buffer :buffer (vim:find-buffer "--slim-vim-errors--"))
 (let ((first-note t))
  (dolist (note notes)
   (let ((error-string (compiler-note-to-error-string note)))
    (when error-string
     (write-line error-string *vim-error-buffer*)
     )
  )))
 (vim:cmd (format nil "exe \"cb~a\"" (1+ (vim:bufnr "--slim-vim-errors--"))))
 (vim:msg (format nil "Finished generating notes (you can have your keyboard back!)")))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; The REPL handling functions
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun setup-repl ()
  (let ((*standard-output* *vim-repl-buffer*))
    (format t "~A> " *slime-lisp-package-prompt-string*)
    (vim:with-window-of (buffer-util:buffer-of *vim-repl-buffer*)
      (vim:normal "G$"))))

(defun repl-handle-enter-key ()
 (let ((*standard-output* *vim-repl-buffer*))
  (let ((form (buffer-util:get-cur-expr t)))
   (when form
    (slime:listener-eval form #'repl-insert-result *slime-lisp-package*)))
  ))

(defun repl-insert-result (result)
 (let ((*standard-output* *vim-repl-buffer*))
  (glue:destructure-case result
   ((:present stuff)
    (format *vim-repl-buffer* "~%")
    (loop for (s . id) in stuff do
     (format *vim-repl-buffer* "~A~%" s))
    (format *vim-repl-buffer* "~A> " *slime-lisp-package-prompt-string*)
    (vim:with-window (vim:bufwinnr (buffer-util:buffer-of *vim-repl-buffer*))
      (vim:normal "G$"))
   ))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; The interface functions that slime.lisp expects
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(in-package #:interface)
(defvar *sldb-level* nil)
(defvar *sldb-frame-locals-map* (make-hash-table))
(defvar *sldb-thread* nil)
(defvar *sldb-level* nil)
(defvar *sldb-condition* nil)
(defvar *sldb-restarts* nil)
(defvar *sldb-frames* nil)
(defvar *sldb-conts* nil)

(defvar *slim-vim-buffer* (make-instance 'buffer-util:vim-buffer-output-stream :buffer "--slim-vim-debug--"))
(defvar *slim-vim-inspect-buffer* (make-instance 'buffer-util:vim-buffer-output-stream :buffer "--slim-vim-inspect--"))

(defun erase-buffer (&key (buffer (vim:find-buffer "--slim-vim-debug--")))
 (buffer-util:scroll-window-of (vim:buffer-name :buffer buffer) t)
 (vim:replace-lines nil :buffer buffer))

(defimplementation handle-indentation-update (alist))

(defimplementation slime-send-sigint (pid)
 (vim:kill pid :SIGINT))

(defimplementation slime-send-sigterm (pid)
 (vim:kill pid :SIGTERM))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; The inspector functions
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; TODO - the inspector needs its own buffer
(defun slime-open-inspector (inspected-parts)
 (format slime-vim::*vim-output-buffer* "Inspector started~%")
 (let ((*standard-output* *slim-vim-inspect-buffer*))
  (destructuring-bind (&key title type content) inspected-parts
   (buffer-util:split-open-buffer "--slim-vim-inspect--")
   (erase-buffer :buffer (vim:find-buffer "--slim-vim-inspect--"))
   (format t "------ SLIME INSPECTOR -----------------------~%")
   (format t "Title : ~A~%" title)
   (format t " [type :~A]~%" type)
   (format t "----------------------------------------------~%")
   (mapc #'slime-inspector-insert-ispec content)
   ;(buffer-util:scroll-window-of *slim-vim-buffer*)
    )))

(defun slime-inspector-insert-ispec (ispec)
 (let ((*standard-output* *slim-vim-inspect-buffer*))
  (if (stringp ispec)
      (format t "~a" ispec)
      (destructuring-bind (case string id) ispec
       (format t "~a" string )))))

(defun slime-inspector-pop ()
  (when (slime:connected-p)
    (slime:eval-async `(swank:inspector-pop)
			     (lambda (result)
			       (if result (slime-open-inspector result)
				 (vim:msg "No previous object"))))))

(defun slime-inspector-quit ()
  (when (slime:connected-p)
    (slime:eval-async `(swank:quit-inspector))
    (buffer-util::hide-buffer "--slim-vim-inspect--")))

(defun get-inspector-context (&optional line-num)
 (let* ((num (or line-num (car (vim:window-cursor))))
        (line (string-trim " " (vim:get-line num (vim:find-buffer "--slim-vim-inspect--")))))
  (format t "Inspector got line ~A~%" line)
  (parse-integer line :junk-allowed t)))

(defun inspector-handle-enter-key ()
  (when (slime:connected-p)
    (let ((*standard-output* *slim-vim-buffer*)
	  (context (get-inspector-context)))
      (format t "Got inspector context ~A~%" context)
      (slime:eval-async `(swank:inspect-nth-part ,context)
			       #'slime-open-inspector))))

(defun sldb-handle-enter-key ()
  (when (slime:connected-p)
    (let ((*standard-output* *slim-vim-buffer*)
	  (context (get-debugger-context)))
      (when context
	(case (car context)
	  (restart (slime::sldb-invoke-restart (cadr context)))
	  (stack   (slime::sldb-frame-locals (cadr context)
		     #'(lambda (value) (format t "frame locals ~a~%" value)
			 (let ((locals (gethash (cadr context) *sldb-frame-locals-map*)))
			   (if locals
			     (remhash (cadr context) *sldb-frame-locals-map*)
			     (setf (gethash (cadr context) *sldb-frame-locals-map*) value))
			   (draw-sldb-window))))))
	(format t "Got context ~A~%" context)))))
#|
14
(tester)
(defvar *a* 4)
(format nil "~A~%" *a*)
(format t "hello~%")
(+ a 1)
(+ 1 2 (* 2 3))
(setf *a* '(a (1 2 3) b))
(slime::sldb-invoke-restart 2)
  (let ((a 0))
   (buffer-util:get-cur-expr t))
(gethash 3 *sldb-frame-locals-map*)
|#

; TODO redraw on locals
; TODO - sldb-activate and sldb-setup aren't quite like slime & there are strange interactions
;        when I mimic the slime code

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; The debugger functions
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defimplementation sldb-activate (thread level)
 (let ((*standard-output* *slim-vim-buffer*))
  ; (format t "sldb-activate thread ~A level ~A *sldb-level* ~a~%" thread level *sldb-level*)
  (unless (equal *sldb-level* level)
   (setf *sldb-level* level)
   (slime:eval-async `(swank:debugger-info-for-emacs 0 10)
                            #'(lambda (result)
                                (apply #'sldb-setup thread level result))))))

(defimplementation sldb-setup (thread level condition restarts frames conts)
 "Setup a new SLDB buffer.
 CONDITION is a string describing the condition to debug.
 RESTARTS is a list of strings (NAME DESCRIPTION) for each available restart.
 FRAMES is a list (NUMBER DESCRIPTION) describing the initial
 portion of the backtrace. Frames are numbered from 0.
 CONTS is a list of pending Emacs continuations."
 (setf *sldb-thread* thread
  *sldb-level* level
  *sldb-condition* condition
  *sldb-restarts* restarts
  *sldb-frames* frames
  *sldb-conts* conts)
 (draw-sldb-window))

(defun draw-sldb-window ()
  (let ((*standard-output* *slim-vim-buffer*))
    (buffer-util:split-open-buffer "--slim-vim-debug--")
    ;(erase-buffer)
    ;(format t "level is ~a ~a~%" level *sldb-level*)
    ;(setf *sldb-level* level)
    (format t "------ SLDB SETUP ----------------------------~%")
    (format t "Thread ~A Level ~A~%" *sldb-thread* *sldb-level*)
    (format t "----------------------------------------------~%")
    (format t "Condition ~%~A~%" *sldb-condition*)
    (format t "----------------------------------------------~%")
    (format t "RESTARTS~%")
    (let ((i 0))
      (dolist (restart *sldb-restarts*)
	(format t "  [~a] ~a~%" i restart)
	(incf i)))
    (format t "----------------------------------------------~%")
    (format t "Backtrace size ~A first 5~%" (length *sldb-frames*))
    (dotimes (x 5)
      (format t "  ~A~%" (nth x *sldb-frames*))
      (let ((locals (gethash x *sldb-frame-locals-map*)))
	(when locals
	  (loop for var in locals do
		(destructuring-bind (&key name id value) var
		  (unless (= id 0) (format t "    (ID ~A)" id))
		  (format t "    ~A = ~A~%" name value)))
	  (format t "  ---------------------------------------~%")
	  )))
    (format t "----------------------------------------------~%")
    (format t "Continuations for Emacs ~A~%" *sldb-conts*)
    (buffer-util:scroll-window-of *slim-vim-buffer*)
    ))

; TODO - jump up a level rather than totally exit
(defimplementation sldb-exit (thread level &optional stepping)
  (let ((*standard-output* *slim-vim-buffer*))
    (erase-buffer)
    (buffer-util::hide-buffer "--slim-vim-debug--")
    (format t "sldb-exit thread ~A level ~A~%" thread level)
    (setf *sldb-level* nil
	  *sldb-active* nil)
    ))

(defun get-debugger-context (&optional line-num)
 (let* ((num (or line-num (car (vim:window-cursor))))
        (line (string-trim " " (vim:get-line num (vim:find-buffer "--slim-vim-debug--")))))
  (case (char line 0)
   (#\[ (let* ((right (position #\] line))
               (restart (string-trim " []" (subseq line 0 right)))
               (restart-num (parse-integer restart)))
          (list 'restart restart-num)))
   (#\( (let* ((right (position #\( line :start 1))
               (restart (string-trim " ()" (subseq line 0 right)))
               (restart-num (parse-integer restart)))
          (list 'stack restart-num)))
   (otherwise nil))))

(defun sldb-handle-enter-key ()
 (let ((*standard-output* *slim-vim-buffer*)
       (context (get-debugger-context)))
   (when context
    (case (car context)
     (restart (slime::sldb-invoke-restart (cadr context)))
     (stack   (slime::sldb-frame-locals (cadr context)
                #'(lambda (value) (format t "frame locals ~a~%" value)
                    (let ((locals (gethash (cadr context) *sldb-frame-locals-map*)))
                     (if locals
                      (remhash (cadr context) *sldb-frame-locals-map*)
                      (setf (gethash (cadr context) *sldb-frame-locals-map*) value))
                    (draw-sldb-window))))))
    (format t "Got context ~A~%" context))))

(defimplementation new-listener-package (package prompt-string)
      (setf vim-slime::*slime-lisp-package* package
            vim-slime::*slime-lisp-package-prompt-string* prompt-string))