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
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)
|