Klimi's new dotfiles with stow.
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
 
 
 
 
 
 

150 lines
5.1 KiB

;; An experimental implementation of multiple REPLs multiplexed over a
;; single Slime socket. M-x slime-new-mrepl creates a new REPL buffer.
;;
(require 'slime)
(require 'inferior-slime) ; inferior-slime-indent-lime
(require 'cl-lib)
(define-slime-contrib slime-mrepl
"Multiple REPLs."
(:authors "Helmut Eller <heller@common-lisp.net>")
(:license "GPL")
(:swank-dependencies swank-mrepl))
(require 'comint)
(defvar slime-mrepl-remote-channel nil)
(defvar slime-mrepl-expect-sexp nil)
(define-derived-mode slime-mrepl-mode comint-mode "mrepl"
;; idea lifted from ielm
(unless (get-buffer-process (current-buffer))
(let* ((process-connection-type nil)
(proc (start-process "mrepl (dummy)" (current-buffer) "hexl")))
(set-process-query-on-exit-flag proc nil)))
(set (make-local-variable 'comint-use-prompt-regexp) nil)
(set (make-local-variable 'comint-inhibit-carriage-motion) t)
(set (make-local-variable 'comint-input-sender) 'slime-mrepl-input-sender)
(set (make-local-variable 'comint-output-filter-functions) nil)
(set (make-local-variable 'slime-mrepl-expect-sexp) t)
;;(set (make-local-variable 'comint-get-old-input) 'ielm-get-old-input)
(set-syntax-table lisp-mode-syntax-table)
)
(slime-define-keys slime-mrepl-mode-map
((kbd "RET") 'slime-mrepl-return)
([return] 'slime-mrepl-return)
;;((kbd "TAB") 'slime-indent-and-complete-symbol)
((kbd "C-c C-b") 'slime-interrupt)
((kbd "C-c C-c") 'slime-interrupt))
(defun slime-mrepl-process% () (get-buffer-process (current-buffer))) ;stupid
(defun slime-mrepl-mark () (process-mark (slime-mrepl-process%)))
(defun slime-mrepl-insert (string)
(comint-output-filter (slime-mrepl-process%) string))
(slime-define-channel-type listener)
(slime-define-channel-method listener :prompt (package prompt)
(with-current-buffer (slime-channel-get self 'buffer)
(slime-mrepl-prompt package prompt)))
(defun slime-mrepl-prompt (package prompt)
(setf slime-buffer-package package)
(slime-mrepl-insert (format "%s%s> "
(cl-case (current-column)
(0 "")
(t "\n"))
prompt))
(slime-mrepl-recenter))
(defun slime-mrepl-recenter ()
(when (get-buffer-window)
(recenter -1)))
(slime-define-channel-method listener :write-result (result)
(with-current-buffer (slime-channel-get self 'buffer)
(goto-char (point-max))
(slime-mrepl-insert result)))
(slime-define-channel-method listener :evaluation-aborted ()
(with-current-buffer (slime-channel-get self 'buffer)
(goto-char (point-max))
(slime-mrepl-insert "; Evaluation aborted\n")))
(slime-define-channel-method listener :write-string (string)
(slime-mrepl-write-string self string))
(defun slime-mrepl-write-string (self string)
(with-current-buffer (slime-channel-get self 'buffer)
(goto-char (slime-mrepl-mark))
(slime-mrepl-insert string)))
(slime-define-channel-method listener :set-read-mode (mode)
(with-current-buffer (slime-channel-get self 'buffer)
(cl-ecase mode
(:read (setq slime-mrepl-expect-sexp nil)
(message "[Listener is waiting for input]"))
(:eval (setq slime-mrepl-expect-sexp t)))))
(defun slime-mrepl-return (&optional end-of-input)
(interactive "P")
(slime-check-connected)
(goto-char (point-max))
(cond ((and slime-mrepl-expect-sexp
(or (slime-input-complete-p (slime-mrepl-mark) (point))
end-of-input))
(comint-send-input))
((not slime-mrepl-expect-sexp)
(unless end-of-input
(insert "\n"))
(comint-send-input t))
(t
(insert "\n")
(inferior-slime-indent-line)
(message "[input not complete]")))
(slime-mrepl-recenter))
(defun slime-mrepl-input-sender (proc string)
(slime-mrepl-send-string (substring-no-properties string)))
(defun slime-mrepl-send-string (string &optional command-string)
(slime-mrepl-send `(:process ,string)))
(defun slime-mrepl-send (msg)
"Send MSG to the remote channel."
(slime-send-to-remote-channel slime-mrepl-remote-channel msg))
(defun slime-new-mrepl ()
"Create a new listener window."
(interactive)
(let ((channel (slime-make-channel slime-listener-channel-methods)))
(slime-eval-async
`(swank-mrepl:create-mrepl ,(slime-channel.id channel))
(slime-rcurry
(lambda (result channel)
(cl-destructuring-bind (remote thread-id package prompt) result
(pop-to-buffer (generate-new-buffer (slime-buffer-name :mrepl)))
(slime-mrepl-mode)
(setq slime-current-thread thread-id)
(setq slime-buffer-connection (slime-connection))
(set (make-local-variable 'slime-mrepl-remote-channel) remote)
(slime-channel-put channel 'buffer (current-buffer))
(slime-channel-send channel `(:prompt ,package ,prompt))))
channel))))
(defun slime-mrepl ()
(let ((conn (slime-connection)))
(cl-find-if (lambda (x)
(with-current-buffer x
(and (eq major-mode 'slime-mrepl-mode)
(eq (slime-current-connection) conn))))
(buffer-list))))
(def-slime-selector-method ?m
"First mrepl-buffer"
(or (slime-mrepl)
(error "No mrepl buffer (%s)" (slime-connection-name))))
(provide 'slime-mrepl)