Initial commit

2017-11-11 15:15:10 -02:00
commit 58c3bd6728
1202 changed files with 434097 additions and 0 deletions
--- a/elpa/slime-20171102.1213/contrib/slime-mrepl.el
+++ b/elpa/slime-20171102.1213/contrib/slime-mrepl.el
@@ -0,0 +1,150 @@
+;; 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)