;; SLIME

     ;;(add-to-list 'load-path "/home/luke/slime")
     (add-to-list 'load-path "/usr/local/share/emacs/site-lisp/slime/")
     (require 'slime)
     (slime-setup :autodoc t)
     (add-hook 'lisp-mode-hook
               (lambda () (slime-mode t) (slime-autodoc-mode t)))
     ;;(add-hook 'inferior-lisp-mode-hook (lambda () (inferior-slime-mode t)))
     ;; (modify-syntax-entry ?$ "'" lisp-mode-syntax-table)

     (define-key slime-mode-map (kbd "[") 'insert-parentheses)
     (define-key slime-mode-map (kbd "]") 'move-past-close-and-reindent)
     ;;(define-key slime-mode-map (kbd "(") (lambda () (interactive) (insert "[")))
     ;;(define-key slime-mode-map (kbd ")") (lambda () (interactive) (insert "]")))
     (define-key slime-mode-map (kbd "(") (function self-insert-command))
     (define-key slime-mode-map (kbd ")") (function self-insert-command))
     (define-key slime-mode-map (kbd "\e\[") (lambda () (interactive) (insert "(")))
     (define-key slime-mode-map (kbd "\e\]") (lambda () (interactive) (insert ")")))

          

     (defun slime-version ()
       (interactive)
       (eval-in-cl "(swank-loader::slime-version-string)"
                   (lambda (values)
                     (if (null (cdr values))
                         (message (format "%s" v))
                         (dolist (v values)
                           (message (format "%s\n" v)))))))
  


     (defvar *pm* '() "process-marker alist")

     (defun pjb-slime-net-filter (process string)
       "Accept output from the socket and input all complete messages."
       (with-current-buffer (process-buffer process)
         (save-excursion
           (let ((pma (assoc process *pm*)))
             (when pma (goto-char (marker-position (cdr pma)))))
           (insert string))
         (slime-process-available-input)))


     (defun pjb-slime-eval-with-transcript (form &optional fn wait)
       "Send FROM and PACKAGE to Lisp and pass the result to FN.
Display the result in the message area, if FN is nil."
       (let* ((proc (slime-connection))
              (spb (process-buffer proc))
              (spf (process-filter proc)))
         (let ((pma (assoc proc *pm*))
               (m (let ((m (make-marker)))
                    (set-marker m (point) (current-buffer))
                    m)))
           (if pma
               (setf (cdr pma) m)
               (push (cons proc m) *pm*)))
         (set-process-buffer proc (current-buffer))
         (set-process-filter proc 'pjb-slime-net-filter)
         (unwind-protect (with-lexical-bindings (fn)
                           (slime-eval-async  form
                                              (lambda (value)
                                                (cond (fn (funcall fn value))
                                                      (t (message ".EMACS: %s" value)))
                                                (slime-show-last-output))))
           (set-process-buffer proc spb)
           (set-process-filter proc spf)
           (setf *pm* (delete (assoc proc *pm*) *pm*)))))


     ;;   (defun pjb-slime-eval-last-expression ()
     ;;     "Evaluate the expression preceding point."
     ;;     (interactive)
     ;;     (let* ((str  (slime-last-expression))
     ;;            (sexp (read-from-string str)))
     ;;       (if (and (listp sexp)
     ;;                (symbolp (fisrt sexp))
     ;;                (< 3 (LENGTH (SYMBOL-NAME (first sexp))))
     ;;                (STRING-EQUAL "DEF"  (SYMBOL-NAME (first sexp)) :end2 3))
     ;;         (slime-eval-last-expression str)
     ;;         (slime-eval-print-last-expression str))))


     (defun pjb-slime-eval-last-expression ()
       "Evaluate the expression preceding point."
       (interactive)
       (if buffer-read-only
           (slime-eval-last-expression)
           (let ((str  (slime-last-expression)))
             ;; (message ".EMACS: A DEF? %S" (STRING-EQUAL "(DEF"  str :end2 4))
             (if (string-equal* "(DEF"  str :end2 4)
                 (slime-interactive-eval str)
                 (slime-eval-print-last-expression str)))))


     (defun slime-restart-lisp-image ()
       (interactive)
       (when (slime-connected-p)
         (dolist (buf (buffer-list))
           (when (or (string= (buffer-name buf) slime-event-buffer-name)
                     (string-match "^\\*inferior-lisp*" (buffer-name buf)))
             (kill-buffer buf))))
       (call-interactively 'slime)) ;;slime-restart-lisp-image


     (defun pjb-slime-erase-buffer ()
       "Reset the slime output buffer to initial state."
       (interactive)
       (with-current-buffer (slime-output-buffer)
         (let ((inhibit-read-only t))
           (erase-buffer)
           (slime-repl-update-banner)))) ;;pjb-slime-erase-buffer


     (defun slime-kill ()
       (interactive)
       (map nil (lambda (x) (when (buffer-named x) (kill-buffer x)))
            '("*slime-repl[1]*" "*slime-events*" "*inferior-lisp*")))


     (defun slime-relaunch ()
       (interactive)
       (slime-kill)
       (sit-for 1)
       (slime)) ;;slime-relaunch

     (defalias 'slime-reload 'slime-relaunch)


     (defun pjb-slime-reset-minor-mode ()
       (dolist (slime-mode-vars '( slime-repl-read-mode
                                  slime-temp-buffer-mode
                                  inferior-slime-mode slime-mode))
         (setf minor-mode-map-alist (delete-if (lambda (x) (eq (car x) slime-mode-vars))
                                               minor-mode-map-alist)))
       ) ;;pjb-slime-reset-minor-mode


     (defvar *pjb-slime-keys-dynamic* nil)
     (defun pjb-slime-substitute-command (key command &rest keys)
       (unless  *pjb-slime-keys-dynamic*
         (setf slime-keys (mapcar (function copy-seq) (copy-seq slime-keys))
               *pjb-slime-keys-dynamic* t))
       (let ((prefixedp (cadr (member :prefixed keys)))
             (skeys slime-keys))
         (while skeys
           (when (and (string= key (first (car skeys)))
                      (equiv prefixedp (cadr (member :prefixed (car skeys)))))
             (setf (second (car skeys)) command
                   skeys nil))
           (pop skeys)))
       (pjb-slime-reset-minor-mode)
       (load "slime" pjb:*load-noerror* pjb:*load-silent*))


     ;; (pjb-slime-substitute-command "\M-." 'slime-edit-definition-other-window)

     ;; (pjb-slime-substitute-command "\C-e" 'pjb-slime-eval-last-expression
     ;;                               :prefixed t)


     (progn
       (define-key sldb-mode-map  "\M-."     'slime-edit-definition-other-window)
       (define-key slime-mode-map          "\C-ch"    'slime-hyperspec-lookup)
       (define-key inferior-slime-mode-map "\C-ch"    'slime-hyperspec-lookup)
       (define-key slime-mode-map  "\C-c\C-e" 'pjb-slime-eval-last-expression)
       (define-key slime-mode-map  "\C-x\C-e" 'pjb-slime-eval-last-expression)
       (define-key slime-mode-map          "\C-c\C-t" 'pjb-slime-erase-buffer)
       (define-key slime-mode-map          " "        'slime-space) ;'cl-magic-space)
       (define-key inferior-slime-mode-map "\C-c\C-t" 'pjb-slime-erase-buffer)
       )

     (defun slime-symbol-name-at-point ()
       "Return the name of the symbol at point, otherwise nil."
       (save-restriction
         ;; Don't be tricked into grabbing the REPL prompt.
         (when (and (eq major-mode 'slime-repl-mode)
                    (>= (point) slime-repl-input-start-mark))
           (narrow-to-region slime-repl-input-start-mark (point-max)))
         (save-excursion
           (skip-syntax-forward "w_")
           (skip-syntax-backward "-")
           (let ((string (let ((bounds (bounds-of-thing-at-point 'symbol)))
                           (when bounds
                             (buffer-substring (car bounds)
                                               (progn
                                                 (goto-char (1- (cdr bounds)))
                                                 (if (looking-at "\\.\"")
                                                     (1- (cdr bounds))
                                                     (cdr bounds))))))))
             (and string
                  ;; In Emacs20 (thing-at-point 'symbol) returns "" instead
                  ;; of nil when called from an empty (or
                  ;; narrowed-to-empty) buffer.
                  (not (equal string ""))
                  (substring-no-properties   string)))))) ;;slime-symbol-name-at-point



     ;; (trace slime-init-keymaps  slime-init-keymaps  slime-define-key)
     ;; (trace pjb-slime-eval-last-expression)
     ;; (show (assoc "" slime-keys))

     (defun slime-hyperspec-lookup (symbol-name)
       "A wrapper for `hyperspec-lookup'"
       (interactive (list (let ((completion-ignore-case t)
                                (symbol-at-point (slime-symbol-name-at-point)))
                            (if (and symbol-at-point
                                     (intern-soft (downcase symbol-at-point)
                                                  common-lisp-hyperspec-symbols))
                                symbol-at-point
                                (completing-read
                                 "Look up symbol in Common Lisp HyperSpec: "
                                 common-lisp-hyperspec-symbols #'boundp
                                 t symbol-at-point
                                 'common-lisp-hyperspec-history)))))
       (hyperspec-lookup symbol-name)) ;;slime-hyperspec-lookup

     ;; (setf sldb-hook nil)
     (add-hook 'sldb-hook (lambda () (toggle-truncate-lines 1)))


     (defun slime-macroexpand-in-place (&optional string)
       (interactive)
       (unless string
         (setf string (slime-sexp-at-point-or-error)))
       (lexical-let ((package (slime-current-package)))
         (insert (slime-eval `(swank:swank-macroexpand-1 ,string)))))