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.
1805 lines
68 KiB
1805 lines
68 KiB
;;; slime-repl.el ---
|
|
;;
|
|
;; Original Author: Helmut Eller
|
|
;; Contributors: too many to mention
|
|
;; License: GNU GPL (same license as Emacs)
|
|
;;
|
|
;;; Description:
|
|
;;
|
|
|
|
;;
|
|
;;; Installation:
|
|
;;
|
|
;; Call slime-setup and include 'slime-repl as argument:
|
|
;;
|
|
;; (slime-setup '(slime-repl [others conribs ...]))
|
|
;;
|
|
(require 'slime)
|
|
(require 'slime-parse)
|
|
(require 'cl-lib)
|
|
(eval-when-compile (require 'cl)) ; slime-def-connection-var, which
|
|
; expands to defsetf not in cl-lib
|
|
|
|
(define-slime-contrib slime-repl
|
|
"Read-Eval-Print Loop written in Emacs Lisp.
|
|
|
|
This contrib implements a Lisp Listener along with some niceties like
|
|
a persistent history and various \"shortcut\" commands. Nothing here
|
|
depends on comint.el; I/O is multiplexed over SLIME's socket.
|
|
|
|
This used to be the default REPL for SLIME, but it was hard to
|
|
maintain."
|
|
(:authors "too many to mention")
|
|
(:license "GPL")
|
|
(:on-load
|
|
(slime-repl-add-hooks)
|
|
(setq slime-find-buffer-package-function 'slime-repl-find-buffer-package))
|
|
(:on-unload (slime-repl-remove-hooks))
|
|
(:swank-dependencies swank-repl))
|
|
|
|
;;;;; slime-repl
|
|
|
|
(defgroup slime-repl nil
|
|
"The Read-Eval-Print Loop (*slime-repl* buffer)."
|
|
:prefix "slime-repl-"
|
|
:group 'slime)
|
|
|
|
(defcustom slime-repl-shortcut-dispatch-char ?\,
|
|
"Character used to distinguish repl commands from lisp forms."
|
|
:type '(character)
|
|
:group 'slime-repl)
|
|
|
|
(defcustom slime-repl-only-save-lisp-buffers t
|
|
"When T we only attempt to save lisp-mode file buffers. When
|
|
NIL slime will attempt to save all buffers (as per
|
|
save-some-buffers). This applies to all ASDF related repl
|
|
shortcuts."
|
|
:type '(boolean)
|
|
:group 'slime-repl)
|
|
|
|
(defcustom slime-repl-auto-right-margin nil
|
|
"When T we bind CL:*PRINT-RIGHT-MARGIN* to the width of the
|
|
current repl's (as per slime-output-buffer) window."
|
|
:type '(boolean)
|
|
:group 'slime-repl)
|
|
|
|
(defface slime-repl-prompt-face
|
|
'((t (:inherit font-lock-keyword-face)))
|
|
"Face for the prompt in the SLIME REPL."
|
|
:group 'slime-repl)
|
|
|
|
(defface slime-repl-output-face
|
|
'((t (:inherit font-lock-string-face)))
|
|
"Face for Lisp output in the SLIME REPL."
|
|
:group 'slime-repl)
|
|
|
|
(defface slime-repl-input-face
|
|
'((t (:bold t)))
|
|
"Face for previous input in the SLIME REPL."
|
|
:group 'slime-repl)
|
|
|
|
(defface slime-repl-result-face
|
|
'((t ()))
|
|
"Face for the result of an evaluation in the SLIME REPL."
|
|
:group 'slime-repl)
|
|
|
|
(defcustom slime-repl-history-file "~/.slime-history.eld"
|
|
"File to save the persistent REPL history to."
|
|
:type 'string
|
|
:group 'slime-repl)
|
|
|
|
(defcustom slime-repl-history-size 200
|
|
"*Maximum number of lines for persistent REPL history."
|
|
:type 'integer
|
|
:group 'slime-repl)
|
|
|
|
(defcustom slime-repl-history-file-coding-system
|
|
(cond ((slime-find-coding-system 'utf-8-unix) 'utf-8-unix)
|
|
(t slime-net-coding-system))
|
|
"*The coding system for the history file."
|
|
:type 'symbol
|
|
:group 'slime-repl)
|
|
|
|
|
|
;; dummy defvar for compiler
|
|
(defvar slime-repl-read-mode)
|
|
|
|
(defun slime-reading-p ()
|
|
"True if Lisp is currently reading input from the REPL."
|
|
(with-current-buffer (slime-output-buffer)
|
|
slime-repl-read-mode))
|
|
|
|
|
|
;;;; Stream output
|
|
|
|
(slime-def-connection-var slime-connection-output-buffer nil
|
|
"The buffer for the REPL. May be nil or a dead buffer.")
|
|
|
|
(make-variable-buffer-local
|
|
(defvar slime-output-start nil
|
|
"Marker for the start of the output for the evaluation."))
|
|
|
|
(make-variable-buffer-local
|
|
(defvar slime-output-end nil
|
|
"Marker for end of output. New output is inserted at this mark."))
|
|
|
|
;; dummy definitions for the compiler
|
|
(defvar slime-repl-package-stack)
|
|
(defvar slime-repl-directory-stack)
|
|
(defvar slime-repl-input-start-mark)
|
|
(defvar slime-repl-prompt-start-mark)
|
|
|
|
(defvar slime-repl-history-use-mark nil
|
|
"A non-nil value means that history will be replaced from the mark.
|
|
|
|
Instead of replacing form input-start, look up history and replace input
|
|
from the mark. Calling 'slime-repl-previous-input',
|
|
'slime-repl-previous-matching-input' or their -next counterparts with a prefix
|
|
argument sets this variable for the duration of one history lookup.")
|
|
|
|
(defun slime-repl-history-yank-start ()
|
|
"The position which 'slime-repl-previous-input' will replace from.
|
|
|
|
When 'slime-repl-history-use-mark' is non-nil, and (mark) is after the current
|
|
input start, return it. Otherwise, return 'slime-repl-input-start-mark'."
|
|
(if (and slime-repl-history-use-mark (mark))
|
|
(max (mark) slime-repl-input-start-mark)
|
|
slime-repl-input-start-mark))
|
|
|
|
(defun slime-output-buffer (&optional noprompt)
|
|
"Return the output buffer, create it if necessary."
|
|
(let ((buffer (slime-connection-output-buffer)))
|
|
(or (if (buffer-live-p buffer) buffer)
|
|
(setf (slime-connection-output-buffer)
|
|
(let ((connection (slime-connection)))
|
|
(with-current-buffer (slime-repl-buffer t connection)
|
|
(unless (eq major-mode 'slime-repl-mode)
|
|
(slime-repl-mode))
|
|
(setq slime-buffer-connection connection)
|
|
(setq slime-buffer-package (slime-lisp-package connection))
|
|
(slime-reset-repl-markers)
|
|
(unless noprompt
|
|
(slime-repl-insert-prompt))
|
|
(current-buffer)))))))
|
|
|
|
(defvar slime-repl-banner-function 'slime-repl-insert-banner)
|
|
|
|
(defun slime-repl-update-banner ()
|
|
(funcall slime-repl-banner-function)
|
|
(slime-move-point (point-max))
|
|
(slime-mark-output-start)
|
|
(slime-mark-input-start)
|
|
(slime-repl-insert-prompt))
|
|
|
|
(defun slime-repl-insert-banner ()
|
|
(when (zerop (buffer-size))
|
|
(let ((welcome (concat "; SLIME " slime-version)))
|
|
(insert welcome))))
|
|
|
|
(defun slime-init-output-buffer (connection)
|
|
(with-current-buffer (slime-output-buffer t)
|
|
(setq slime-buffer-connection connection
|
|
slime-repl-directory-stack '()
|
|
slime-repl-package-stack '())
|
|
(slime-repl-update-banner)))
|
|
|
|
(defun slime-display-output-buffer ()
|
|
"Display the output buffer and scroll to bottom."
|
|
(with-current-buffer (slime-output-buffer)
|
|
(goto-char (point-max))
|
|
(unless (get-buffer-window (current-buffer) t)
|
|
(display-buffer (current-buffer) t))
|
|
(slime-repl-show-maximum-output)))
|
|
|
|
(defun slime-output-filter (process string)
|
|
(with-current-buffer (process-buffer process)
|
|
(when (and (plusp (length string))
|
|
(eq (process-status slime-buffer-connection) 'open))
|
|
(slime-write-string string))))
|
|
|
|
(defvar slime-open-stream-hooks)
|
|
|
|
(defun slime-open-stream-to-lisp (port coding-system)
|
|
(let ((stream (open-network-stream "*lisp-output-stream*"
|
|
(slime-with-connection-buffer ()
|
|
(current-buffer))
|
|
(car (process-contact (slime-connection)))
|
|
port))
|
|
(emacs-coding-system (car (cl-find coding-system
|
|
slime-net-valid-coding-systems
|
|
:key #'cl-third))))
|
|
(slime-set-query-on-exit-flag stream)
|
|
(set-process-filter stream 'slime-output-filter)
|
|
(set-process-coding-system stream emacs-coding-system emacs-coding-system)
|
|
(let ((secret (slime-secret)))
|
|
(when secret
|
|
(slime-net-send secret stream)))
|
|
(run-hook-with-args 'slime-open-stream-hooks stream)
|
|
stream))
|
|
|
|
(defun slime-io-speed-test (&optional profile)
|
|
"A simple minded benchmark for stream performance.
|
|
If a prefix argument is given, instrument the slime package for
|
|
profiling before running the benchmark."
|
|
(interactive "P")
|
|
(eval-and-compile
|
|
(require 'elp))
|
|
(elp-reset-all)
|
|
(elp-restore-all)
|
|
(load "slime.el")
|
|
;;(byte-compile-file "slime-net.el" t)
|
|
;;(setq slime-log-events nil)
|
|
(setq slime-enable-evaluate-in-emacs t)
|
|
;;(setq slime-repl-enable-presentations nil)
|
|
(when profile
|
|
(elp-instrument-package "slime-"))
|
|
(kill-buffer (slime-output-buffer))
|
|
(switch-to-buffer (slime-output-buffer))
|
|
(delete-other-windows)
|
|
(sit-for 0)
|
|
(slime-repl-send-string "(swank:io-speed-test 4000 1)")
|
|
(let ((proc (slime-inferior-process)))
|
|
(when proc
|
|
(display-buffer (process-buffer proc) t)
|
|
(goto-char (point-max)))))
|
|
|
|
(defvar slime-write-string-function 'slime-repl-write-string)
|
|
|
|
(defun slime-write-string (string &optional target)
|
|
"Insert STRING in the REPL buffer or some other TARGET.
|
|
If TARGET is nil, insert STRING as regular process
|
|
output. If TARGET is :repl-result, insert STRING as the result of the
|
|
evaluation. Other values of TARGET map to an Emacs marker via the
|
|
hashtable `slime-output-target-to-marker'; output is inserted at this marker."
|
|
(funcall slime-write-string-function string target))
|
|
|
|
(defun slime-repl-write-string (string &optional target)
|
|
(case target
|
|
((nil) (slime-repl-emit string))
|
|
(:repl-result (slime-repl-emit-result string t))
|
|
(t (slime-repl-emit-to-target string target))))
|
|
|
|
(defvar slime-repl-popup-on-output nil
|
|
"Display the output buffer when some output is written.
|
|
This is set to nil after displaying the buffer.")
|
|
|
|
(defmacro slime-save-marker (marker &rest body)
|
|
(declare (debug (sexp &rest form)))
|
|
(let ((pos (cl-gensym "pos")))
|
|
`(let ((,pos (marker-position ,marker)))
|
|
(prog1 (progn . ,body)
|
|
(set-marker ,marker ,pos)))))
|
|
|
|
(put 'slime-save-marker 'lisp-indent-function 1)
|
|
|
|
(defun slime-repl-emit (string)
|
|
;; insert the string STRING in the output buffer
|
|
(with-current-buffer (slime-output-buffer)
|
|
(save-excursion
|
|
(goto-char slime-output-end)
|
|
(slime-save-marker slime-output-start
|
|
(slime-propertize-region '(face slime-repl-output-face
|
|
slime-repl-output t
|
|
rear-nonsticky (face))
|
|
(let ((inhibit-read-only t))
|
|
(insert-before-markers string)
|
|
(when (and (= (point) slime-repl-prompt-start-mark)
|
|
(not (bolp)))
|
|
(insert-before-markers "\n")
|
|
(set-marker slime-output-end (1- (point))))))))
|
|
(when slime-repl-popup-on-output
|
|
(setq slime-repl-popup-on-output nil)
|
|
(display-buffer (current-buffer)))
|
|
(slime-repl-show-maximum-output)))
|
|
|
|
(defun slime-repl-emit-result (string &optional bol)
|
|
;; insert STRING and mark it as evaluation result
|
|
(with-current-buffer (slime-output-buffer)
|
|
(save-excursion
|
|
(goto-char slime-repl-input-start-mark)
|
|
(slime-save-marker slime-output-start
|
|
(goto-char slime-repl-input-start-mark)
|
|
(when (and bol (not (bolp))) (insert-before-markers-and-inherit "\n"))
|
|
(slime-save-marker slime-output-end
|
|
(slime-propertize-region `(face slime-repl-result-face
|
|
rear-nonsticky (face))
|
|
(insert-before-markers string)))
|
|
(set-marker slime-output-end (point))))
|
|
(slime-repl-show-maximum-output)))
|
|
|
|
(defvar slime-last-output-target-id 0
|
|
"The last integer we used as a TARGET id.")
|
|
|
|
(defun slime-repl-emit-to-target (string target)
|
|
"Insert STRING at target TARGET.
|
|
See `slime-output-target-to-marker'."
|
|
(let* ((marker (slime-repl-output-target-marker target))
|
|
(buffer (and marker (marker-buffer marker))))
|
|
(when buffer
|
|
(with-current-buffer buffer
|
|
(save-excursion
|
|
;; Insert STRING at MARKER, then move MARKER behind
|
|
;; the insertion.
|
|
(goto-char marker)
|
|
(insert-before-markers string)
|
|
(set-marker marker (point)))))))
|
|
|
|
(defun slime-repl-output-target-marker (target)
|
|
(case target
|
|
((nil)
|
|
(with-current-buffer (slime-output-buffer)
|
|
slime-output-end))
|
|
(:repl-result
|
|
(with-current-buffer (slime-output-buffer)
|
|
slime-repl-input-start-mark))
|
|
(t
|
|
(slime-output-target-marker target))))
|
|
|
|
|
|
(defun slime-switch-to-output-buffer ()
|
|
"Select the output buffer, when possible in an existing window.
|
|
|
|
Hint: You can use `display-buffer-reuse-frames' and
|
|
`special-display-buffer-names' to customize the frame in which
|
|
the buffer should appear."
|
|
(interactive)
|
|
(pop-to-buffer (slime-output-buffer))
|
|
(goto-char (point-max)))
|
|
|
|
|
|
;;;; REPL
|
|
;;
|
|
;; The REPL uses some markers to separate input from output. The
|
|
;; usual configuration is as follows:
|
|
;;
|
|
;; ... output ... ... result ... prompt> ... input ...
|
|
;; ^ ^ ^ ^ ^
|
|
;; output-start output-end prompt-start input-start point-max
|
|
;;
|
|
;; input-start is a right inserting marker, because
|
|
;; we want it to stay behind when the user inserts text.
|
|
;;
|
|
;; We maintain the following invariant:
|
|
;;
|
|
;; output-start <= output-end <= input-start.
|
|
;;
|
|
;; This invariant is important, because we must be prepared for
|
|
;; asynchronous output and asynchronous reads. ("Asynchronous" means,
|
|
;; triggered by Lisp and not by Emacs.)
|
|
;;
|
|
;; All output is inserted at the output-end marker. Some care must be
|
|
;; taken when output-end and input-start are at the same position: if
|
|
;; we insert at that point, we must move the right markers. We should
|
|
;; also not leave (window-)point in the middle of the new output. The
|
|
;; idiom we use is a combination to slime-save-marker,
|
|
;; insert-before-markers, and manually updating window-point
|
|
;; afterwards.
|
|
;;
|
|
;; A "synchronous" evaluation request proceeds as follows: the user
|
|
;; inserts some text between input-start and point-max and then hits
|
|
;; return. We send that region to Lisp, move the output and input
|
|
;; makers to the line after the input and wait. When we receive the
|
|
;; result, we insert it together with a prompt between the output-end
|
|
;; and input-start mark. See `slime-repl-insert-prompt'.
|
|
;;
|
|
;; It is possible that some output for such an evaluation request
|
|
;; arrives after the result. This output is inserted before the
|
|
;; result (and before the prompt).
|
|
;;
|
|
;; If we are in "reading" state, e.g., during a call to Y-OR-N-P,
|
|
;; there is no prompt between output-end and input-start.
|
|
;;
|
|
|
|
;; FIXME: slime-lisp-package should be local in a REPL buffer
|
|
(slime-def-connection-var slime-lisp-package
|
|
"COMMON-LISP-USER"
|
|
"The current package name of the Superior lisp.
|
|
This is automatically synchronized from Lisp.")
|
|
|
|
(slime-def-connection-var slime-lisp-package-prompt-string
|
|
"CL-USER"
|
|
"The current package name of the Superior lisp.
|
|
This is automatically synchronized from Lisp.")
|
|
|
|
(slime-make-variables-buffer-local
|
|
(defvar slime-repl-package-stack nil
|
|
"The stack of packages visited in this repl.")
|
|
|
|
(defvar slime-repl-directory-stack nil
|
|
"The stack of default directories associated with this repl.")
|
|
|
|
(defvar slime-repl-prompt-start-mark)
|
|
(defvar slime-repl-input-start-mark)
|
|
(defvar slime-repl-old-input-counter 0
|
|
"Counter used to generate unique `slime-repl-old-input' properties.
|
|
This property value must be unique to avoid having adjacent inputs be
|
|
joined together."))
|
|
|
|
(defun slime-reset-repl-markers ()
|
|
(dolist (markname '(slime-output-start
|
|
slime-output-end
|
|
slime-repl-prompt-start-mark
|
|
slime-repl-input-start-mark))
|
|
(set markname (make-marker))
|
|
(set-marker (symbol-value markname) (point))))
|
|
|
|
;;;;; REPL mode setup
|
|
|
|
(defvar slime-repl-mode-map
|
|
(let ((map (make-sparse-keymap)))
|
|
(set-keymap-parent map lisp-mode-map)
|
|
map))
|
|
|
|
(slime-define-keys slime-prefix-map
|
|
("\C-z" 'slime-switch-to-output-buffer)
|
|
("\M-p" 'slime-repl-set-package))
|
|
|
|
(slime-define-keys slime-mode-map
|
|
("\C-c~" 'slime-sync-package-and-default-directory)
|
|
("\C-c\C-y" 'slime-call-defun)
|
|
("\C-c\C-j" 'slime-eval-last-expression-in-repl))
|
|
|
|
(slime-define-keys slime-connection-list-mode-map
|
|
((kbd "RET") 'slime-goto-connection)
|
|
([return] 'slime-goto-connection))
|
|
|
|
(slime-define-keys slime-repl-mode-map
|
|
("\C-m" 'slime-repl-return)
|
|
([return] 'slime-repl-return)
|
|
("\C-j" 'slime-repl-newline-and-indent)
|
|
("\C-\M-m" 'slime-repl-closing-return)
|
|
([(control return)] 'slime-repl-closing-return)
|
|
("\M-p" 'slime-repl-previous-input)
|
|
((kbd "C-<up>") 'slime-repl-backward-input)
|
|
("\M-n" 'slime-repl-next-input)
|
|
((kbd "C-<down>") 'slime-repl-forward-input)
|
|
("\M-r" 'slime-repl-previous-matching-input)
|
|
("\M-s" 'slime-repl-next-matching-input)
|
|
("\C-c\C-c" 'slime-interrupt)
|
|
(" " 'slime-space)
|
|
((string slime-repl-shortcut-dispatch-char) 'slime-handle-repl-shortcut)
|
|
("\C-c\C-o" 'slime-repl-clear-output)
|
|
("\C-c\M-o" 'slime-repl-clear-buffer)
|
|
("\C-c\C-u" 'slime-repl-kill-input)
|
|
("\C-c\C-n" 'slime-repl-next-prompt)
|
|
("\C-c\C-p" 'slime-repl-previous-prompt)
|
|
("\C-c\C-z" 'slime-nop)
|
|
("\C-cI" 'slime-repl-inspect)
|
|
("\C-x\C-e" 'slime-eval-last-expression))
|
|
|
|
(slime-define-keys slime-inspector-mode-map
|
|
((kbd "M-RET") 'slime-inspector-copy-down-to-repl))
|
|
|
|
(slime-define-keys sldb-mode-map
|
|
("\C-y" 'sldb-insert-frame-call-to-repl)
|
|
((kbd "M-RET") 'sldb-copy-down-to-repl))
|
|
|
|
(def-slime-selector-method ?r
|
|
"SLIME Read-Eval-Print-Loop."
|
|
(slime-output-buffer))
|
|
|
|
(define-minor-mode slime-repl-map-mode
|
|
"Minor mode which makes slime-repl-mode-map available.
|
|
\\{slime-repl-mode-map}"
|
|
nil
|
|
nil
|
|
slime-repl-mode-map)
|
|
|
|
(defun slime-repl-mode ()
|
|
"Major mode for interacting with a superior Lisp.
|
|
\\{slime-repl-mode-map}"
|
|
(interactive)
|
|
(kill-all-local-variables)
|
|
(setq major-mode 'slime-repl-mode)
|
|
(slime-editing-mode 1)
|
|
(slime-repl-map-mode 1)
|
|
(lisp-mode-variables t)
|
|
(set (make-local-variable 'lisp-indent-function)
|
|
'common-lisp-indent-function)
|
|
(slime-setup-completion)
|
|
(set (make-local-variable 'tab-always-indent) 'complete)
|
|
(setq font-lock-defaults nil)
|
|
(setq mode-name "REPL")
|
|
(setq slime-current-thread :repl-thread)
|
|
(set (make-local-variable 'scroll-conservatively) 20)
|
|
(set (make-local-variable 'scroll-margin) 0)
|
|
(when slime-repl-history-file
|
|
(slime-repl-safe-load-history)
|
|
(add-hook 'kill-buffer-hook
|
|
'slime-repl-safe-save-merged-history
|
|
'append t))
|
|
(add-hook 'kill-emacs-hook 'slime-repl-save-all-histories)
|
|
;; At the REPL, we define beginning-of-defun and end-of-defun to be
|
|
;; the start of the previous prompt or next prompt respectively.
|
|
;; Notice the interplay with SLIME-REPL-BEGINNING-OF-DEFUN.
|
|
(set (make-local-variable 'beginning-of-defun-function)
|
|
'slime-repl-mode-beginning-of-defun)
|
|
(set (make-local-variable 'end-of-defun-function)
|
|
'slime-repl-mode-end-of-defun)
|
|
(run-mode-hooks 'slime-repl-mode-hook))
|
|
|
|
(defun slime-repl-buffer (&optional create connection)
|
|
"Get the REPL buffer for the current connection; optionally create."
|
|
(funcall (if create #'get-buffer-create #'get-buffer)
|
|
(format "*slime-repl %s*" (slime-connection-name connection))))
|
|
|
|
(defun slime-repl ()
|
|
(interactive)
|
|
(slime-switch-to-output-buffer)
|
|
(current-buffer))
|
|
|
|
(defun slime-repl-mode-beginning-of-defun (&optional arg)
|
|
(if (and arg (< arg 0))
|
|
(slime-repl-mode-end-of-defun (- arg))
|
|
(dotimes (i (or arg 1))
|
|
(slime-repl-previous-prompt))))
|
|
|
|
(defun slime-repl-mode-end-of-defun (&optional arg)
|
|
(if (and arg (< arg 0))
|
|
(slime-repl-mode-beginning-of-defun (- arg))
|
|
(dotimes (i (or arg 1))
|
|
(slime-repl-next-prompt))))
|
|
|
|
(defun slime-repl-send-string (string &optional command-string)
|
|
(cond (slime-repl-read-mode
|
|
(slime-repl-return-string string))
|
|
(t (slime-repl-eval-string string))))
|
|
|
|
(defun slime-repl-eval-string (string)
|
|
(slime-rex ()
|
|
((if slime-repl-auto-right-margin
|
|
`(swank-repl:listener-eval
|
|
,string
|
|
:window-width
|
|
,(with-current-buffer (slime-output-buffer)
|
|
(window-width)))
|
|
`(swank-repl:listener-eval ,string))
|
|
(slime-lisp-package))
|
|
((:ok result)
|
|
(slime-repl-insert-result result))
|
|
((:abort condition)
|
|
(slime-repl-show-abort condition))))
|
|
|
|
(defun slime-repl-insert-result (result)
|
|
(with-current-buffer (slime-output-buffer)
|
|
(save-excursion
|
|
(when result
|
|
(slime-dcase result
|
|
((:values &rest strings)
|
|
(cond ((null strings)
|
|
(slime-repl-emit-result "; No value\n" t))
|
|
(t
|
|
(dolist (s strings)
|
|
(slime-repl-emit-result s t)))))))
|
|
(slime-repl-insert-prompt))
|
|
(slime-repl-show-maximum-output)))
|
|
|
|
(defun slime-repl-show-abort (condition)
|
|
(with-current-buffer (slime-output-buffer)
|
|
(save-excursion
|
|
(slime-save-marker slime-output-start
|
|
(slime-save-marker slime-output-end
|
|
(goto-char slime-output-end)
|
|
(insert-before-markers (format "; Evaluation aborted on %s.\n"
|
|
condition))
|
|
(slime-repl-insert-prompt))))
|
|
(slime-repl-show-maximum-output)))
|
|
|
|
(defvar slime-repl-suppress-prompt nil
|
|
"Supresses Slime REPL prompt when bound to T.")
|
|
|
|
(defun slime-repl-insert-prompt ()
|
|
"Insert the prompt (before markers!).
|
|
Set point after the prompt.
|
|
Return the position of the prompt beginning.
|
|
|
|
If `slime-repl-suppress-prompt' is true, does nothing and returns nil."
|
|
(goto-char slime-repl-input-start-mark)
|
|
(unless slime-repl-suppress-prompt
|
|
(slime-save-marker slime-output-start
|
|
(slime-save-marker slime-output-end
|
|
(unless (bolp) (insert-before-markers "\n"))
|
|
(let ((prompt-start (point))
|
|
(prompt (format "%s> " (slime-lisp-package-prompt-string))))
|
|
(slime-propertize-region
|
|
'(face slime-repl-prompt-face
|
|
read-only t slime-repl-prompt t
|
|
rear-nonsticky t front-sticky (read-only)
|
|
inhibit-line-move-field-capture t
|
|
field output)
|
|
(insert-before-markers prompt))
|
|
(set-marker slime-repl-prompt-start-mark prompt-start)
|
|
(setq buffer-undo-list nil)
|
|
prompt-start)))))
|
|
|
|
(defun slime-repl-show-maximum-output ()
|
|
"Put the end of the buffer at the bottom of the window."
|
|
(when (eobp)
|
|
(let ((win (if (eq (window-buffer) (current-buffer))
|
|
(selected-window)
|
|
(get-buffer-window (current-buffer) t))))
|
|
(when win
|
|
(with-selected-window win
|
|
(set-window-point win (point-max))
|
|
(recenter -1))))))
|
|
|
|
(defvar slime-repl-current-input-hooks)
|
|
|
|
(defun slime-repl-current-input (&optional until-point-p)
|
|
"Return the current input as string.
|
|
The input is the region from after the last prompt to the end of
|
|
buffer."
|
|
(or (run-hook-with-args-until-success 'slime-repl-current-input-hooks
|
|
until-point-p)
|
|
(buffer-substring-no-properties (slime-repl-history-yank-start)
|
|
(if until-point-p
|
|
(point)
|
|
(point-max)))))
|
|
|
|
(defun slime-property-position (text-property &optional object)
|
|
"Return the first position of TEXT-PROPERTY, or nil."
|
|
(if (get-text-property 0 text-property object)
|
|
0
|
|
(next-single-property-change 0 text-property object)))
|
|
|
|
(defun slime-mark-input-start ()
|
|
(set-marker slime-repl-input-start-mark (point) (current-buffer)))
|
|
|
|
(defun slime-mark-output-start ()
|
|
(set-marker slime-output-start (point))
|
|
(set-marker slime-output-end (point)))
|
|
|
|
(defun slime-mark-output-end ()
|
|
;; Don't put slime-repl-output-face again; it would remove the
|
|
;; special presentation face, for instance in the SBCL inspector.
|
|
(add-text-properties slime-output-start slime-output-end
|
|
'(;;face slime-repl-output-face
|
|
rear-nonsticky (face))))
|
|
|
|
(defun slime-preserve-zmacs-region ()
|
|
"In XEmacs, ensure that the zmacs-region stays active after this command."
|
|
(when (boundp 'zmacs-region-stays)
|
|
(set 'zmacs-region-stays t)))
|
|
|
|
(defun slime-repl-in-input-area-p ()
|
|
(<= slime-repl-input-start-mark (point)))
|
|
|
|
(defun slime-repl-at-prompt-start-p ()
|
|
;; This will not work on non-current prompts.
|
|
(= (point) slime-repl-input-start-mark))
|
|
|
|
(defun slime-repl-beginning-of-defun ()
|
|
"Move to beginning of defun."
|
|
(interactive)
|
|
;; We call BEGINNING-OF-DEFUN if we're at the start of a prompt
|
|
;; already, to trigger SLIME-REPL-MODE-BEGINNING-OF-DEFUN by means
|
|
;; of the locally bound BEGINNING-OF-DEFUN-FUNCTION, in order to
|
|
;; jump to the start of the previous prompt.
|
|
(if (and (not (slime-repl-at-prompt-start-p))
|
|
(slime-repl-in-input-area-p))
|
|
(goto-char slime-repl-input-start-mark)
|
|
(beginning-of-defun))
|
|
t)
|
|
|
|
;; FIXME: this looks very strange
|
|
(defun slime-repl-end-of-defun ()
|
|
"Move to next of defun."
|
|
(interactive)
|
|
;; C.f. SLIME-REPL-BEGINNING-OF-DEFUN.
|
|
(if (and (not (= (point) (point-max)))
|
|
(slime-repl-in-input-area-p))
|
|
(goto-char (point-max))
|
|
(end-of-defun))
|
|
t)
|
|
|
|
(defun slime-repl-previous-prompt ()
|
|
"Move backward to the previous prompt."
|
|
(interactive)
|
|
(slime-repl-find-prompt t))
|
|
|
|
(defun slime-repl-next-prompt ()
|
|
"Move forward to the next prompt."
|
|
(interactive)
|
|
(slime-repl-find-prompt))
|
|
|
|
(defun slime-repl-find-prompt (&optional backward)
|
|
(let ((origin (point))
|
|
(prop 'slime-repl-prompt))
|
|
(while (progn
|
|
(slime-search-property-change prop backward)
|
|
(not (or (slime-end-of-proprange-p prop) (bobp) (eobp)))))
|
|
(unless (slime-end-of-proprange-p prop)
|
|
(goto-char origin))))
|
|
|
|
(defun slime-search-property-change (prop &optional backward)
|
|
(cond (backward
|
|
(goto-char (or (previous-single-char-property-change (point) prop)
|
|
(point-min))))
|
|
(t
|
|
(goto-char (or (next-single-char-property-change (point) prop)
|
|
(point-max))))))
|
|
|
|
(defun slime-end-of-proprange-p (property)
|
|
(and (get-char-property (max 1 (1- (point))) property)
|
|
(not (get-char-property (point) property))))
|
|
|
|
(defvar slime-repl-return-hooks)
|
|
|
|
(defun slime-repl-return (&optional end-of-input)
|
|
"Evaluate the current input string, or insert a newline.
|
|
Send the current input only if a whole expression has been entered,
|
|
i.e. the parenthesis are matched.
|
|
|
|
With prefix argument send the input even if the parenthesis are not
|
|
balanced."
|
|
(interactive "P")
|
|
(slime-check-connected)
|
|
(cond (end-of-input
|
|
(slime-repl-send-input))
|
|
(slime-repl-read-mode ; bad style?
|
|
(slime-repl-send-input t))
|
|
((and (get-text-property (point) 'slime-repl-old-input)
|
|
(< (point) slime-repl-input-start-mark))
|
|
(slime-repl-grab-old-input end-of-input)
|
|
(slime-repl-recenter-if-needed))
|
|
((run-hook-with-args-until-success 'slime-repl-return-hooks end-of-input))
|
|
((slime-input-complete-p slime-repl-input-start-mark (point-max))
|
|
(slime-repl-send-input t))
|
|
(t
|
|
(slime-repl-newline-and-indent)
|
|
(message "[input not complete]"))))
|
|
|
|
(defun slime-repl-recenter-if-needed ()
|
|
"Make sure that (point) is visible."
|
|
(unless (pos-visible-in-window-p (point-max))
|
|
(save-excursion
|
|
(goto-char (point-max))
|
|
(recenter -1))))
|
|
|
|
(defun slime-repl-send-input (&optional newline)
|
|
"Goto to the end of the input and send the current input.
|
|
If NEWLINE is true then add a newline at the end of the input."
|
|
(unless (slime-repl-in-input-area-p)
|
|
(error "No input at point."))
|
|
(goto-char (point-max))
|
|
(let ((end (point))) ; end of input, without the newline
|
|
(slime-repl-add-to-input-history
|
|
(buffer-substring slime-repl-input-start-mark end))
|
|
(when newline
|
|
(insert "\n")
|
|
(slime-repl-show-maximum-output))
|
|
(let ((inhibit-modification-hooks t))
|
|
(add-text-properties slime-repl-input-start-mark
|
|
(point)
|
|
`(slime-repl-old-input
|
|
,(incf slime-repl-old-input-counter))))
|
|
(let ((overlay (make-overlay slime-repl-input-start-mark end)))
|
|
;; These properties are on an overlay so that they won't be taken
|
|
;; by kill/yank.
|
|
(overlay-put overlay 'face 'slime-repl-input-face)))
|
|
(let ((input (slime-repl-current-input)))
|
|
(goto-char (point-max))
|
|
(slime-mark-input-start)
|
|
(slime-mark-output-start)
|
|
(slime-repl-send-string input)))
|
|
|
|
(defun slime-repl-grab-old-input (replace)
|
|
"Resend the old REPL input at point.
|
|
If replace is non-nil the current input is replaced with the old
|
|
input; otherwise the new input is appended. The old input has the
|
|
text property `slime-repl-old-input'."
|
|
(multiple-value-bind (beg end) (slime-property-bounds 'slime-repl-old-input)
|
|
(let ((old-input (buffer-substring beg end)) ;;preserve
|
|
;;properties, they will be removed later
|
|
(offset (- (point) beg)))
|
|
;; Append the old input or replace the current input
|
|
(cond (replace (goto-char slime-repl-input-start-mark))
|
|
(t (goto-char (point-max))
|
|
(unless (eq (char-before) ?\ )
|
|
(insert " "))))
|
|
(delete-region (point) (point-max))
|
|
(save-excursion
|
|
(insert old-input)
|
|
(when (equal (char-before) ?\n)
|
|
(delete-char -1)))
|
|
(forward-char offset))))
|
|
|
|
(defun slime-repl-closing-return ()
|
|
"Evaluate the current input string after closing all open lists."
|
|
(interactive)
|
|
(goto-char (point-max))
|
|
(save-restriction
|
|
(narrow-to-region slime-repl-input-start-mark (point))
|
|
(while (ignore-errors (save-excursion (backward-up-list 1)) t)
|
|
(insert ")")))
|
|
(slime-repl-return))
|
|
|
|
(defun slime-repl-newline-and-indent ()
|
|
"Insert a newline, then indent the next line.
|
|
Restrict the buffer from the prompt for indentation, to avoid being
|
|
confused by strange characters (like unmatched quotes) appearing
|
|
earlier in the buffer."
|
|
(interactive)
|
|
(save-restriction
|
|
(narrow-to-region slime-repl-prompt-start-mark (point-max))
|
|
(insert "\n")
|
|
(lisp-indent-line)))
|
|
|
|
(defun slime-repl-delete-current-input ()
|
|
"Delete all text from the prompt."
|
|
(interactive)
|
|
(delete-region (slime-repl-history-yank-start) (point-max)))
|
|
|
|
(defun slime-eval-last-expression-in-repl (prefix)
|
|
"Evaluates last expression in the Slime REPL.
|
|
|
|
Switches REPL to current package of the source buffer for the duration. If
|
|
used with a prefix argument (C-u), doesn't switch back afterwards."
|
|
(interactive "P")
|
|
(let ((expr (slime-last-expression))
|
|
(buffer-name (buffer-name (current-buffer)))
|
|
(new-package (slime-current-package))
|
|
(old-package (slime-lisp-package))
|
|
(slime-repl-suppress-prompt t)
|
|
(yank-back nil))
|
|
(with-current-buffer (slime-output-buffer)
|
|
(unless (eq (current-buffer) (window-buffer))
|
|
(pop-to-buffer (current-buffer) t))
|
|
(goto-char (point-max))
|
|
;; Kill pending input in the REPL
|
|
(when (< (marker-position slime-repl-input-start-mark) (point))
|
|
(kill-region slime-repl-input-start-mark (point))
|
|
(setq yank-back t))
|
|
(unwind-protect
|
|
(progn
|
|
(insert-before-markers (format "\n;;; from %s\n" buffer-name))
|
|
(when new-package
|
|
(slime-repl-set-package new-package))
|
|
(let ((slime-repl-suppress-prompt nil))
|
|
(slime-repl-insert-prompt))
|
|
(insert expr)
|
|
(slime-repl-return))
|
|
(unless (or prefix (equal (slime-lisp-package) old-package))
|
|
;; Switch back.
|
|
(slime-repl-set-package old-package)
|
|
(let ((slime-repl-suppress-prompt nil))
|
|
(slime-repl-insert-prompt))))
|
|
;; Put pending input back.
|
|
(when yank-back
|
|
(yank)))))
|
|
|
|
(defun slime-repl-kill-input ()
|
|
"Kill all text from the prompt to point."
|
|
(interactive)
|
|
(cond ((< (marker-position slime-repl-input-start-mark) (point))
|
|
(kill-region slime-repl-input-start-mark (point)))
|
|
((= (point) (marker-position slime-repl-input-start-mark))
|
|
(slime-repl-delete-current-input))))
|
|
|
|
(defun slime-repl-replace-input (string)
|
|
(slime-repl-delete-current-input)
|
|
(insert-and-inherit string))
|
|
|
|
(defun slime-repl-input-line-beginning-position ()
|
|
(save-excursion
|
|
(goto-char slime-repl-input-start-mark)
|
|
(let ((inhibit-field-text-motion t))
|
|
(line-beginning-position))))
|
|
|
|
(defun slime-clear-repl-variables ()
|
|
(interactive)
|
|
(slime-eval-async `(swank-repl:clear-repl-variables)))
|
|
|
|
(defvar slime-repl-clear-buffer-hook)
|
|
|
|
(add-hook 'slime-repl-clear-buffer-hook 'slime-clear-repl-variables)
|
|
|
|
(defun slime-repl-clear-buffer ()
|
|
"Delete the output generated by the Lisp process."
|
|
(interactive)
|
|
(let ((inhibit-read-only t))
|
|
(delete-region (point-min) slime-repl-prompt-start-mark)
|
|
(delete-region slime-output-start slime-output-end)
|
|
(when (< (point) slime-repl-input-start-mark)
|
|
(goto-char slime-repl-input-start-mark))
|
|
(recenter t))
|
|
(run-hooks 'slime-repl-clear-buffer-hook))
|
|
|
|
(defun slime-repl-clear-output ()
|
|
"Delete the output inserted since the last input."
|
|
(interactive)
|
|
(let ((start (save-excursion
|
|
(when (>= (point) slime-repl-input-start-mark)
|
|
(goto-char slime-repl-input-start-mark))
|
|
(slime-repl-previous-prompt)
|
|
(ignore-errors (forward-sexp))
|
|
(forward-line)
|
|
(point)))
|
|
(end (1- (slime-repl-input-line-beginning-position))))
|
|
(when (< start end)
|
|
(let ((inhibit-read-only t))
|
|
(delete-region start end)
|
|
(save-excursion
|
|
(goto-char start)
|
|
(insert ";;; output flushed"))))))
|
|
|
|
(defun slime-repl-set-package (package)
|
|
"Set the package of the REPL buffer to PACKAGE."
|
|
(interactive (list (let* ((p (slime-current-package))
|
|
(p (and p (slime-pretty-package-name p)))
|
|
(p (and (not (equal p (slime-lisp-package))) p)))
|
|
(slime-read-package-name "Package: " p))))
|
|
(with-current-buffer (slime-output-buffer)
|
|
(let ((previouse-point (- (point) slime-repl-input-start-mark))
|
|
(previous-prompt (slime-lisp-package-prompt-string)))
|
|
(destructuring-bind (name prompt-string)
|
|
(slime-repl-shortcut-eval `(swank:set-package ,package))
|
|
(setf (slime-lisp-package) name)
|
|
(setf slime-buffer-package name)
|
|
(unless (equal previous-prompt prompt-string)
|
|
(setf (slime-lisp-package-prompt-string) prompt-string)
|
|
(slime-repl-insert-prompt))
|
|
(when (plusp previouse-point)
|
|
(goto-char (+ previouse-point slime-repl-input-start-mark)))))))
|
|
|
|
|
|
;;;;; History
|
|
|
|
(defcustom slime-repl-wrap-history nil
|
|
"*T to wrap history around when the end is reached."
|
|
:type 'boolean
|
|
:group 'slime-repl)
|
|
|
|
(make-variable-buffer-local
|
|
(defvar slime-repl-input-history '()
|
|
"History list of strings read from the REPL buffer."))
|
|
|
|
(defun slime-repl-add-to-input-history (string)
|
|
"Add STRING to the input history.
|
|
Empty strings and duplicates are ignored."
|
|
(setq string (slime-trim-whitespace string))
|
|
(unless (equal string "")
|
|
(setq slime-repl-input-history
|
|
(remove string slime-repl-input-history))
|
|
(unless (equal string (car slime-repl-input-history))
|
|
(push string slime-repl-input-history))))
|
|
|
|
;; These two vars contain the state of the last history search. We
|
|
;; only use them if `last-command' was 'slime-repl-history-replace,
|
|
;; otherwise we reinitialize them.
|
|
|
|
(defvar slime-repl-input-history-position -1
|
|
"Newer items have smaller indices.")
|
|
|
|
(defvar slime-repl-history-pattern nil
|
|
"The regexp most recently used for finding input history.")
|
|
|
|
(defun slime-repl-history-replace (direction &optional regexp)
|
|
"Replace the current input with the next line in DIRECTION.
|
|
DIRECTION is 'forward' or 'backward' (in the history list).
|
|
If REGEXP is non-nil, only lines matching REGEXP are considered."
|
|
(setq slime-repl-history-pattern regexp)
|
|
(let* ((min-pos -1)
|
|
(max-pos (length slime-repl-input-history))
|
|
(pos0 (cond ((slime-repl-history-search-in-progress-p)
|
|
slime-repl-input-history-position)
|
|
(t min-pos)))
|
|
(pos (slime-repl-position-in-history pos0 direction (or regexp "")
|
|
(slime-repl-current-input)))
|
|
(msg nil))
|
|
(cond ((and (< min-pos pos) (< pos max-pos))
|
|
(slime-repl-replace-input (nth pos slime-repl-input-history))
|
|
(setq msg (format "History item: %d" pos)))
|
|
((not slime-repl-wrap-history)
|
|
(setq msg (cond ((= pos min-pos) "End of history")
|
|
((= pos max-pos) "Beginning of history"))))
|
|
(slime-repl-wrap-history
|
|
(setq pos (if (= pos min-pos) max-pos min-pos))
|
|
(setq msg "Wrapped history")))
|
|
(when (or (<= pos min-pos) (<= max-pos pos))
|
|
(when regexp
|
|
(setq msg (concat msg "; no matching item"))))
|
|
;;(message "%s [%d %d %s]" msg start-pos pos regexp)
|
|
(message "%s%s" msg (cond ((not regexp) "")
|
|
(t (format "; current regexp: %s" regexp))))
|
|
(setq slime-repl-input-history-position pos)
|
|
(setq this-command 'slime-repl-history-replace)))
|
|
|
|
(defun slime-repl-history-search-in-progress-p ()
|
|
(eq last-command 'slime-repl-history-replace))
|
|
|
|
(defun slime-repl-terminate-history-search ()
|
|
(setq last-command this-command))
|
|
|
|
(defun slime-repl-position-in-history (start-pos direction regexp
|
|
&optional exclude-string)
|
|
"Return the position of the history item matching REGEXP.
|
|
Return -1 resp. the length of the history if no item matches.
|
|
If EXCLUDE-STRING is specified then it's excluded from the search."
|
|
;; Loop through the history list looking for a matching line
|
|
(let* ((step (ecase direction
|
|
(forward -1)
|
|
(backward 1)))
|
|
(history slime-repl-input-history)
|
|
(len (length history)))
|
|
(loop for pos = (+ start-pos step) then (+ pos step)
|
|
if (< pos 0) return -1
|
|
if (<= len pos) return len
|
|
for history-item = (nth pos history)
|
|
if (and (string-match regexp history-item)
|
|
(not (equal history-item exclude-string)))
|
|
return pos)))
|
|
|
|
(defun slime-repl-previous-input ()
|
|
"Cycle backwards through input history.
|
|
If the `last-command' was a history navigation command use the
|
|
same search pattern for this command.
|
|
Otherwise use the current input as search pattern.
|
|
|
|
With a prefix-arg, do replacement from the mark."
|
|
(interactive)
|
|
(let ((slime-repl-history-use-mark (or slime-repl-history-use-mark
|
|
current-prefix-arg)))
|
|
(slime-repl-history-replace 'backward (slime-repl-history-pattern t))))
|
|
|
|
(defun slime-repl-next-input ()
|
|
"Cycle forwards through input history.
|
|
See `slime-repl-previous-input'.
|
|
|
|
With a prefix-arg, do replacement from the mark."
|
|
(interactive)
|
|
(let ((slime-repl-history-use-mark (or slime-repl-history-use-mark
|
|
current-prefix-arg)))
|
|
(slime-repl-history-replace 'forward (slime-repl-history-pattern t))))
|
|
|
|
(defun slime-repl-forward-input ()
|
|
"Cycle forwards through input history."
|
|
(interactive)
|
|
(slime-repl-history-replace 'forward (slime-repl-history-pattern)))
|
|
|
|
(defun slime-repl-backward-input ()
|
|
"Cycle backwards through input history."
|
|
(interactive)
|
|
(slime-repl-history-replace 'backward (slime-repl-history-pattern)))
|
|
|
|
(defun slime-repl-previous-matching-input (regexp)
|
|
"Insert the previous matching input.
|
|
|
|
With a prefix-arg, do the insertion at the mark."
|
|
(interactive (list (slime-read-from-minibuffer
|
|
"Previous element matching (regexp): ")))
|
|
(slime-repl-terminate-history-search)
|
|
(let ((slime-repl-history-use-mark (or slime-repl-history-use-mark
|
|
current-prefix-arg)))
|
|
(slime-repl-history-replace 'backward regexp)))
|
|
|
|
(defun slime-repl-next-matching-input (regexp)
|
|
"Insert the next matching input.
|
|
|
|
With a prefix-arg, do the insertion at the mark."
|
|
(interactive (list (slime-read-from-minibuffer
|
|
"Next element matching (regexp): ")))
|
|
(slime-repl-terminate-history-search)
|
|
(let ((slime-repl-history-use-mark (or slime-repl-history-use-mark
|
|
current-prefix-arg)))
|
|
(slime-repl-history-replace 'forward regexp)))
|
|
|
|
(defun slime-repl-history-pattern (&optional use-current-input)
|
|
"Return the regexp for the navigation commands."
|
|
(cond ((slime-repl-history-search-in-progress-p)
|
|
slime-repl-history-pattern)
|
|
(use-current-input
|
|
(goto-char (max (slime-repl-history-yank-start) (point)))
|
|
(let ((str (slime-repl-current-input t)))
|
|
(cond ((string-match "^[ \t\n]*$" str) nil)
|
|
(t (concat "^" (regexp-quote str))))))
|
|
(t nil)))
|
|
|
|
(defun slime-repl-delete-from-input-history (string)
|
|
"Delete STRING from the repl input history.
|
|
|
|
When string is not provided then clear the current repl input and
|
|
use it as an input. This is useful to get rid of unwanted repl
|
|
history entries while navigating the repl history."
|
|
(interactive (list (slime-repl-current-input)))
|
|
(let ((merged-history
|
|
(slime-repl-merge-histories (slime-repl-read-history nil t)
|
|
slime-repl-input-history)))
|
|
(setq slime-repl-input-history
|
|
(cl-delete string merged-history :test #'string=))
|
|
(slime-repl-save-history))
|
|
(slime-repl-delete-current-input))
|
|
|
|
;;;;; Persistent History
|
|
|
|
(defun slime-repl-merge-histories (old-hist new-hist)
|
|
"Merge entries from OLD-HIST and NEW-HIST."
|
|
;; Newer items in each list are at the beginning.
|
|
(let* ((ht (make-hash-table :test #'equal))
|
|
(test (lambda (entry)
|
|
(or (gethash entry ht)
|
|
(progn (setf (gethash entry ht) t)
|
|
nil)))))
|
|
(append (cl-remove-if test new-hist)
|
|
(cl-remove-if test old-hist))))
|
|
|
|
(defun slime-repl-load-history (&optional filename)
|
|
"Set the current SLIME REPL history.
|
|
It can be read either from FILENAME or `slime-repl-history-file' or
|
|
from a user defined filename."
|
|
(interactive (list (slime-repl-read-history-filename)))
|
|
(let ((file (or filename slime-repl-history-file)))
|
|
(setq slime-repl-input-history (slime-repl-read-history file t))))
|
|
|
|
(defun slime-repl-read-history (&optional filename noerrer)
|
|
"Read and return the history from FILENAME.
|
|
The default value for FILENAME is `slime-repl-history-file'.
|
|
If NOERROR is true return and the file doesn't exits return nil."
|
|
(let ((file (or filename slime-repl-history-file)))
|
|
(cond ((not (file-readable-p file)) '())
|
|
(t (with-temp-buffer
|
|
(insert-file-contents file)
|
|
(read (current-buffer)))))))
|
|
|
|
(defun slime-repl-read-history-filename ()
|
|
(read-file-name "Use SLIME REPL history from file: "
|
|
slime-repl-history-file))
|
|
|
|
(defun slime-repl-save-merged-history (&optional filename)
|
|
"Read the history file, merge the current REPL history and save it.
|
|
This tries to be smart in merging the history from the file and the
|
|
current history in that it tries to detect the unique entries using
|
|
`slime-repl-merge-histories'."
|
|
(interactive (list (slime-repl-read-history-filename)))
|
|
(let ((file (or filename slime-repl-history-file)))
|
|
(with-temp-message "saving history..."
|
|
(let ((hist (slime-repl-merge-histories (slime-repl-read-history file t)
|
|
slime-repl-input-history)))
|
|
(slime-repl-save-history file hist)))))
|
|
|
|
(defun slime-repl-save-history (&optional filename history)
|
|
"Simply save the current SLIME REPL history to a file.
|
|
When SLIME is setup to always load the old history and one uses only
|
|
one instance of slime all the time, there is no need to merge the
|
|
files and this function is sufficient.
|
|
|
|
When the list is longer than `slime-repl-history-size' it will be
|
|
truncated. That part is untested, though!"
|
|
(interactive (list (slime-repl-read-history-filename)))
|
|
(let ((file (or filename slime-repl-history-file))
|
|
(hist (or history slime-repl-input-history)))
|
|
(unless (file-writable-p file)
|
|
(error (format "History file not writable: %s" file)))
|
|
(let ((hist (cl-subseq hist 0 (min (length hist) slime-repl-history-size))))
|
|
;;(message "saving %s to %s\n" hist file)
|
|
(with-temp-file file
|
|
(let ((cs slime-repl-history-file-coding-system)
|
|
(print-length nil) (print-level nil))
|
|
(setq buffer-file-coding-system cs)
|
|
(insert (format ";; -*- coding: %s -*-\n" cs))
|
|
(insert ";; History for SLIME REPL. Automatically written.\n"
|
|
";; Edit only if you know what you're doing\n")
|
|
(prin1 (mapcar #'substring-no-properties hist) (current-buffer)))))))
|
|
|
|
(defun slime-repl-save-all-histories ()
|
|
"Save the history in each repl buffer."
|
|
(dolist (b (buffer-list))
|
|
(with-current-buffer b
|
|
(when (eq major-mode 'slime-repl-mode)
|
|
(slime-repl-safe-save-merged-history)))))
|
|
|
|
(defun slime-repl-safe-save-merged-history ()
|
|
(slime-repl-call-with-handler
|
|
#'slime-repl-save-merged-history
|
|
"%S while saving the history. Continue? "))
|
|
|
|
(defun slime-repl-safe-load-history ()
|
|
(slime-repl-call-with-handler
|
|
#'slime-repl-load-history
|
|
"%S while loading the history. Continue? "))
|
|
|
|
(defun slime-repl-call-with-handler (fun query)
|
|
"Call FUN in the context of an error handler.
|
|
The handler will use qeuery to ask the use if the error should be ingored."
|
|
(condition-case err
|
|
(funcall fun)
|
|
(error
|
|
(if (y-or-n-p (format query (error-message-string err)))
|
|
nil
|
|
(signal (car err) (cdr err))))))
|
|
|
|
|
|
;;;;; REPL Read Mode
|
|
|
|
(defvar slime-repl-read-mode-map
|
|
(let ((map (make-sparse-keymap)))
|
|
(define-key map "\C-m" 'slime-repl-return)
|
|
(define-key map [return] 'slime-repl-return)
|
|
(define-key map (kbd "TAB") 'self-insert-command)
|
|
(define-key map "\C-c\C-b" 'slime-repl-read-break)
|
|
(define-key map "\C-c\C-c" 'slime-repl-read-break)
|
|
(define-key map [remap slime-indent-and-complete-symbol] 'ignore)
|
|
(define-key map [remap slime-handle-repl-shortcut] 'self-insert-command)
|
|
map))
|
|
|
|
(define-minor-mode slime-repl-read-mode
|
|
"Mode to read input from Emacs
|
|
\\{slime-repl-read-mode-map}"
|
|
nil
|
|
"[read]")
|
|
|
|
(make-variable-buffer-local
|
|
(defvar slime-read-string-threads nil))
|
|
|
|
(make-variable-buffer-local
|
|
(defvar slime-read-string-tags nil))
|
|
|
|
(defun slime-repl-read-string (thread tag)
|
|
(slime-switch-to-output-buffer)
|
|
(push thread slime-read-string-threads)
|
|
(push tag slime-read-string-tags)
|
|
(goto-char (point-max))
|
|
(slime-mark-output-end)
|
|
(slime-mark-input-start)
|
|
(slime-repl-read-mode 1))
|
|
|
|
(defun slime-repl-return-string (string)
|
|
(slime-dispatch-event `(:emacs-return-string
|
|
,(pop slime-read-string-threads)
|
|
,(pop slime-read-string-tags)
|
|
,string))
|
|
(slime-repl-read-mode -1))
|
|
|
|
(defun slime-repl-read-break ()
|
|
(interactive)
|
|
(slime-dispatch-event `(:emacs-interrupt ,(car slime-read-string-threads))))
|
|
|
|
(defun slime-repl-abort-read (thread tag)
|
|
(with-current-buffer (slime-output-buffer)
|
|
(pop slime-read-string-threads)
|
|
(pop slime-read-string-tags)
|
|
(slime-repl-read-mode -1)
|
|
(message "Read aborted")))
|
|
|
|
|
|
;;;;; REPL handlers
|
|
|
|
(cl-defstruct (slime-repl-shortcut (:conc-name slime-repl-shortcut.))
|
|
symbol names handler one-liner)
|
|
|
|
(defvar slime-repl-shortcut-table nil
|
|
"A list of slime-repl-shortcuts")
|
|
|
|
(defvar slime-repl-shortcut-history '()
|
|
"History list of shortcut command names.")
|
|
|
|
(defvar slime-within-repl-shortcut-handler-p nil
|
|
"Bound to T if we're in a REPL shortcut handler invoked from the REPL.")
|
|
|
|
(defun slime-handle-repl-shortcut ()
|
|
(interactive)
|
|
(if (> (point) slime-repl-input-start-mark)
|
|
(insert (string slime-repl-shortcut-dispatch-char))
|
|
(let ((shortcut (slime-lookup-shortcut
|
|
(completing-read "Command: "
|
|
(slime-bogus-completion-alist
|
|
(slime-list-all-repl-shortcuts))
|
|
nil t nil
|
|
'slime-repl-shortcut-history))))
|
|
(with-struct (slime-repl-shortcut. handler) shortcut
|
|
(let ((slime-within-repl-shortcut-handler-p t))
|
|
(call-interactively handler))))))
|
|
|
|
(defun slime-list-all-repl-shortcuts ()
|
|
(loop for shortcut in slime-repl-shortcut-table
|
|
append (slime-repl-shortcut.names shortcut)))
|
|
|
|
(defun slime-lookup-shortcut (name)
|
|
(cl-find-if (lambda (s) (member name (slime-repl-shortcut.names s)))
|
|
slime-repl-shortcut-table))
|
|
|
|
(defmacro defslime-repl-shortcut (elisp-name names &rest options)
|
|
"Define a new repl shortcut. ELISP-NAME is a symbol specifying
|
|
the name of the interactive function to create, or NIL if no
|
|
function should be created.
|
|
|
|
NAMES is a list of \(full-name . aliases\).
|
|
|
|
OPTIONS is an plist specifying the handler doing the actual work
|
|
of the shortcut \(`:handler'\), and a help text \(`:one-liner'\)."
|
|
`(progn
|
|
,(when elisp-name
|
|
`(defun ,elisp-name ()
|
|
(interactive)
|
|
(call-interactively ,(second (assoc :handler options)))))
|
|
(let ((new-shortcut (make-slime-repl-shortcut
|
|
:symbol ',elisp-name
|
|
:names (list ,@names)
|
|
,@(apply #'append options))))
|
|
(setq slime-repl-shortcut-table
|
|
(cl-remove-if (lambda (s)
|
|
(member ',(car names) (slime-repl-shortcut.names s)))
|
|
slime-repl-shortcut-table))
|
|
(push new-shortcut slime-repl-shortcut-table)
|
|
',elisp-name)))
|
|
|
|
(defun slime-repl-shortcut-eval (sexp &optional package)
|
|
"This function should be used by REPL shortcut handlers instead
|
|
of `slime-eval' to evaluate their final expansion. (This
|
|
expansion will be added to the REPL's history.)"
|
|
(when slime-within-repl-shortcut-handler-p ; were we invoked via ,foo?
|
|
(slime-repl-add-to-input-history (prin1-to-string sexp)))
|
|
(slime-eval sexp package))
|
|
|
|
(defun slime-repl-shortcut-eval-async (sexp &optional cont package)
|
|
"This function should be used by REPL shortcut handlers instead
|
|
of `slime-eval-async' to evaluate their final expansion. (This
|
|
expansion will be added to the REPL's history.)"
|
|
(when slime-within-repl-shortcut-handler-p ; were we invoked via ,foo?
|
|
(slime-repl-add-to-input-history (prin1-to-string sexp)))
|
|
(slime-eval-async sexp cont package))
|
|
|
|
(defun slime-list-repl-short-cuts ()
|
|
(interactive)
|
|
(slime-with-popup-buffer ((slime-buffer-name :repl-help))
|
|
(let ((table (cl-sort (cl-copy-list slime-repl-shortcut-table) #'string<
|
|
:key (lambda (x)
|
|
(car (slime-repl-shortcut.names x))))))
|
|
(save-excursion
|
|
(dolist (shortcut table)
|
|
(let ((names (slime-repl-shortcut.names shortcut)))
|
|
(insert (pop names)) ;; first print the "full" name
|
|
(when names
|
|
;; we also have aliases
|
|
(insert " (aka ")
|
|
(while (cdr names)
|
|
(insert (pop names) ", "))
|
|
(insert (car names) ")"))
|
|
(when (slime-repl-shortcut.one-liner shortcut)
|
|
(insert "\n " (slime-repl-shortcut.one-liner shortcut)))
|
|
(insert "\n")))))))
|
|
|
|
(defun slime-save-some-lisp-buffers ()
|
|
(if slime-repl-only-save-lisp-buffers
|
|
(save-some-buffers nil (lambda ()
|
|
(and (memq major-mode slime-lisp-modes)
|
|
(not (null buffer-file-name)))))
|
|
(save-some-buffers)))
|
|
|
|
(defun slime-kill-all-buffers ()
|
|
"Kill all the SLIME-related buffers."
|
|
(dolist (buf (buffer-list))
|
|
(when (or (string= (buffer-name buf) slime-event-buffer-name)
|
|
(string-match "^\\*inferior-lisp*" (buffer-name buf))
|
|
(string-match "^\\*slime-repl .*\\*$" (buffer-name buf))
|
|
(string-match "^\\*sldb .*\\*$" (buffer-name buf))
|
|
(string-match "^\\*SLIME.*\\*$" (buffer-name buf)))
|
|
(kill-buffer buf))))
|
|
|
|
(defslime-repl-shortcut slime-repl-shortcut-help ("help")
|
|
(:handler 'slime-list-repl-short-cuts)
|
|
(:one-liner "Display the help."))
|
|
|
|
(defslime-repl-shortcut nil ("change-directory" "!d" "cd")
|
|
(:handler 'slime-set-default-directory)
|
|
(:one-liner "Change the current directory."))
|
|
|
|
(defslime-repl-shortcut nil ("pwd")
|
|
(:handler (lambda ()
|
|
(interactive)
|
|
(let ((dir (slime-eval `(swank:default-directory))))
|
|
(message "Directory %s" dir))))
|
|
(:one-liner "Show the current directory."))
|
|
|
|
(defslime-repl-shortcut slime-repl-push-directory
|
|
("push-directory" "+d" "pushd")
|
|
(:handler (lambda (directory)
|
|
(interactive
|
|
(list (read-directory-name
|
|
"Push directory: "
|
|
(slime-eval '(swank:default-directory))
|
|
nil nil "")))
|
|
(push (slime-eval '(swank:default-directory))
|
|
slime-repl-directory-stack)
|
|
(slime-set-default-directory directory)))
|
|
(:one-liner "Save the current directory and set it to a new one."))
|
|
|
|
(defslime-repl-shortcut slime-repl-pop-directory
|
|
("pop-directory" "-d" "popd")
|
|
(:handler (lambda ()
|
|
(interactive)
|
|
(if (null slime-repl-directory-stack)
|
|
(message "Directory stack is empty.")
|
|
(slime-set-default-directory
|
|
(pop slime-repl-directory-stack)))))
|
|
(:one-liner "Restore the last saved directory."))
|
|
|
|
(defslime-repl-shortcut nil ("change-package" "!p" "in-package" "in")
|
|
(:handler 'slime-repl-set-package)
|
|
(:one-liner "Change the current package."))
|
|
|
|
(defslime-repl-shortcut slime-repl-push-package ("push-package" "+p")
|
|
(:handler (lambda (package)
|
|
(interactive (list (slime-read-package-name "Package: ")))
|
|
(push (slime-lisp-package) slime-repl-package-stack)
|
|
(slime-repl-set-package package)))
|
|
(:one-liner "Save the current package and set it to a new one."))
|
|
|
|
(defslime-repl-shortcut slime-repl-pop-package ("pop-package" "-p")
|
|
(:handler (lambda ()
|
|
(interactive)
|
|
(if (null slime-repl-package-stack)
|
|
(message "Package stack is empty.")
|
|
(slime-repl-set-package
|
|
(pop slime-repl-package-stack)))))
|
|
(:one-liner "Restore the last saved package."))
|
|
|
|
(defslime-repl-shortcut slime-repl-resend ("resend-form")
|
|
(:handler (lambda ()
|
|
(interactive)
|
|
(insert (car slime-repl-input-history))
|
|
(insert "\n")
|
|
(slime-repl-send-input)))
|
|
(:one-liner "Resend the last form."))
|
|
|
|
(defslime-repl-shortcut slime-repl-disconnect ("disconnect")
|
|
(:handler 'slime-disconnect)
|
|
(:one-liner "Disconnect the current connection."))
|
|
|
|
(defslime-repl-shortcut slime-repl-disconnect-all ("disconnect-all")
|
|
(:handler 'slime-disconnect-all)
|
|
(:one-liner "Disconnect all connections."))
|
|
|
|
(defslime-repl-shortcut slime-repl-sayoonara ("sayoonara")
|
|
(:handler (lambda ()
|
|
(interactive)
|
|
(when (slime-connected-p)
|
|
(slime-quit-lisp))
|
|
(slime-kill-all-buffers)))
|
|
(:one-liner "Quit all Lisps and close all SLIME buffers."))
|
|
|
|
(defslime-repl-shortcut slime-repl-quit ("quit")
|
|
(:handler (lambda ()
|
|
(interactive)
|
|
;; `slime-quit-lisp' determines the connection to quit
|
|
;; on behalf of the REPL's `slime-buffer-connection'.
|
|
(let ((repl-buffer (slime-output-buffer)))
|
|
(slime-quit-lisp)
|
|
(kill-buffer repl-buffer))))
|
|
(:one-liner "Quit the current Lisp."))
|
|
|
|
(defslime-repl-shortcut slime-repl-defparameter ("defparameter" "!")
|
|
(:handler (lambda (name value)
|
|
(interactive (list (slime-read-symbol-name "Name (symbol): " t)
|
|
(slime-read-from-minibuffer "Value: " "*")))
|
|
(insert "(cl:defparameter " name " " value
|
|
" \"REPL generated global variable.\")")
|
|
(slime-repl-send-input t)))
|
|
(:one-liner "Define a new global, special, variable."))
|
|
|
|
(defslime-repl-shortcut slime-repl-compile-and-load ("compile-and-load" "cl")
|
|
(:handler (lambda (filename)
|
|
(interactive (list (expand-file-name
|
|
(read-file-name "File: " nil nil nil nil))))
|
|
(slime-save-some-lisp-buffers)
|
|
(slime-repl-shortcut-eval-async
|
|
`(swank:compile-file-if-needed
|
|
,(slime-to-lisp-filename filename) t)
|
|
#'slime-compilation-finished)))
|
|
(:one-liner "Compile (if neccessary) and load a lisp file."))
|
|
|
|
(defslime-repl-shortcut nil ("restart-inferior-lisp")
|
|
(:handler 'slime-restart-inferior-lisp)
|
|
(:one-liner "Restart *inferior-lisp* and reconnect SLIME."))
|
|
|
|
(defun slime-redirect-inferior-output (&optional noerror)
|
|
"Redirect output of the inferior-process to the REPL buffer."
|
|
(interactive)
|
|
(let ((proc (slime-inferior-process)))
|
|
(cond (proc
|
|
(let ((filter (slime-rcurry #'slime-inferior-output-filter
|
|
(slime-current-connection))))
|
|
(set-process-filter proc filter)))
|
|
(noerror)
|
|
(t (error "No inferior lisp process")))))
|
|
|
|
(defun slime-inferior-output-filter (proc string conn)
|
|
(cond ((eq (process-status conn) 'closed)
|
|
(message "Connection closed. Removing inferior output filter.")
|
|
(message "Lost output: %S" string)
|
|
(set-process-filter proc nil))
|
|
(t
|
|
(slime-output-filter conn string))))
|
|
|
|
(defun slime-redirect-trace-output ()
|
|
"Redirect the trace output to a separate Emacs buffer."
|
|
(interactive)
|
|
(let ((buffer (get-buffer-create (slime-buffer-name :trace))))
|
|
(with-current-buffer buffer
|
|
(let ((marker (copy-marker (buffer-size)))
|
|
(target (incf slime-last-output-target-id)))
|
|
(puthash target marker slime-output-target-to-marker)
|
|
(slime-eval `(swank-repl:redirect-trace-output ,target))))
|
|
;; Note: We would like the entries in
|
|
;; slime-output-target-to-marker to disappear when the buffers are
|
|
;; killed. We cannot just make the hash-table ":weakness 'value"
|
|
;; -- there is no reference from the buffers to the markers in the
|
|
;; buffer, so entries would disappear even though the buffers are
|
|
;; alive. Best solution might be to make buffer-local variables
|
|
;; that keep the markers. --mkoeppe
|
|
(pop-to-buffer buffer)))
|
|
|
|
(defun slime-call-defun ()
|
|
"Insert a call to the toplevel form defined around point into the REPL."
|
|
(interactive)
|
|
(cl-labels ((insert-call
|
|
(name &key (function t)
|
|
defclass)
|
|
(let* ((setf (and function
|
|
(consp name)
|
|
(= (length name) 2)
|
|
(eql (car name) 'setf)))
|
|
(symbol (if setf
|
|
(cadr name)
|
|
name))
|
|
(qualified-symbol-name
|
|
(slime-qualify-cl-symbol-name symbol))
|
|
(symbol-name (slime-cl-symbol-name qualified-symbol-name))
|
|
(symbol-package (slime-cl-symbol-package
|
|
qualified-symbol-name))
|
|
(call (if (cl-equalp (slime-lisp-package) symbol-package)
|
|
symbol-name
|
|
qualified-symbol-name)))
|
|
(slime-switch-to-output-buffer)
|
|
(goto-char slime-repl-input-start-mark)
|
|
(insert (if function
|
|
"("
|
|
" "))
|
|
(when setf
|
|
(insert "setf ("))
|
|
(if defclass
|
|
(insert "make-instance '"))
|
|
(insert call)
|
|
(cond (setf
|
|
(insert " ")
|
|
(save-excursion (insert ") )")))
|
|
(function
|
|
(insert " ")
|
|
(save-excursion (insert ")"))))
|
|
(unless function
|
|
(goto-char slime-repl-input-start-mark)))))
|
|
(let ((toplevel (slime-parse-toplevel-form)))
|
|
(if (symbolp toplevel)
|
|
(error "Not in a function definition")
|
|
(slime-dcase toplevel
|
|
(((:defun :defgeneric :defmacro :define-compiler-macro) symbol)
|
|
(insert-call symbol))
|
|
((:defmethod symbol &rest args)
|
|
(declare (ignore args))
|
|
(insert-call symbol))
|
|
(((:defparameter :defvar :defconstant) symbol)
|
|
(insert-call symbol :function nil))
|
|
(((:defclass) symbol)
|
|
(insert-call symbol :defclass t))
|
|
(t
|
|
(error "Not in a function definition")))))))
|
|
|
|
(defun slime-repl-copy-down-to-repl (slimefun &rest args)
|
|
(slime-eval-async `(swank-repl:listener-save-value ',slimefun ,@args)
|
|
#'(lambda (_ignored)
|
|
(with-current-buffer (slime-repl)
|
|
(slime-eval-async '(swank-repl:listener-get-value)
|
|
#'(lambda (_ignored)
|
|
(slime-repl-insert-prompt)))))))
|
|
|
|
(defun slime-inspector-copy-down-to-repl (number)
|
|
"Evaluate the inspector slot at point via the REPL (to set `*')."
|
|
(interactive (list (or (get-text-property (point) 'slime-part-number)
|
|
(error "No part at point"))))
|
|
(slime-repl-copy-down-to-repl 'swank:inspector-nth-part number))
|
|
|
|
(defun sldb-copy-down-to-repl (frame-id var-id)
|
|
"Evaluate the frame var at point via the REPL (to set `*')."
|
|
(interactive (list (sldb-frame-number-at-point) (sldb-var-number-at-point)))
|
|
(slime-repl-copy-down-to-repl 'swank/backend:frame-var-value frame-id var-id))
|
|
|
|
(defun sldb-insert-frame-call-to-repl ()
|
|
"Insert a call to a frame at point."
|
|
(interactive)
|
|
(let ((call (slime-eval `(swank/backend::frame-call
|
|
,(sldb-frame-number-at-point)))))
|
|
(slime-switch-to-output-buffer)
|
|
(if (>= (point) slime-repl-prompt-start-mark)
|
|
(insert call)
|
|
(save-excursion
|
|
(goto-char (point-max))
|
|
(insert call))))
|
|
(slime-repl))
|
|
|
|
(defun slime-set-default-directory (directory)
|
|
"Make DIRECTORY become Lisp's current directory."
|
|
(interactive (list (read-directory-name "Directory: " nil nil t)))
|
|
(let ((dir (expand-file-name directory)))
|
|
(message "default-directory: %s"
|
|
(slime-from-lisp-filename
|
|
(slime-repl-shortcut-eval `(swank:set-default-directory
|
|
,(slime-to-lisp-filename dir)))))
|
|
(with-current-buffer (slime-output-buffer)
|
|
(setq default-directory dir))))
|
|
|
|
(defun slime-sync-package-and-default-directory ()
|
|
"Set Lisp's package and directory to the values in current buffer."
|
|
(interactive)
|
|
(let* ((package (slime-current-package))
|
|
(exists-p (or (null package)
|
|
(slime-eval `(cl:packagep
|
|
(swank::guess-package ,package)))))
|
|
(directory default-directory))
|
|
(when (and package exists-p)
|
|
(slime-repl-set-package package))
|
|
(slime-set-default-directory directory)
|
|
;; Sync *inferior-lisp* dir
|
|
(let* ((proc (slime-process))
|
|
(buffer (and proc (process-buffer proc))))
|
|
(when (buffer-live-p buffer)
|
|
(with-current-buffer buffer
|
|
(setq default-directory directory))))
|
|
(message "package: %s%s directory: %s"
|
|
(with-current-buffer (slime-output-buffer)
|
|
(slime-lisp-package))
|
|
(if exists-p "" (format " (package %s doesn't exist)" package))
|
|
directory)))
|
|
|
|
(defun slime-goto-connection ()
|
|
"Switch to the REPL buffer for the connection at point."
|
|
(interactive)
|
|
(let ((slime-dispatching-connection (slime-connection-at-point)))
|
|
(switch-to-buffer (slime-output-buffer))))
|
|
|
|
(defun slime-repl-inside-string-or-comment-p ()
|
|
(save-restriction
|
|
(when (and (boundp 'slime-repl-input-start-mark)
|
|
slime-repl-input-start-mark
|
|
(>= (point) slime-repl-input-start-mark))
|
|
(narrow-to-region slime-repl-input-start-mark (point)))
|
|
(slime-inside-string-or-comment-p)))
|
|
|
|
(defvar slime-repl-easy-menu
|
|
(let ((C '(slime-connected-p)))
|
|
`("REPL"
|
|
[ "Send Input" slime-repl-return ,C ]
|
|
[ "Close and Send Input " slime-repl-closing-return ,C ]
|
|
[ "Interrupt Lisp process" slime-interrupt ,C ]
|
|
"--"
|
|
[ "Previous Input" slime-repl-previous-input t ]
|
|
[ "Next Input" slime-repl-next-input t ]
|
|
[ "Goto Previous Prompt " slime-repl-previous-prompt t ]
|
|
[ "Goto Next Prompt " slime-repl-next-prompt t ]
|
|
[ "Clear Last Output" slime-repl-clear-output t ]
|
|
[ "Clear Buffer " slime-repl-clear-buffer t ]
|
|
[ "Kill Current Input" slime-repl-kill-input t ])))
|
|
|
|
(defun slime-repl-add-easy-menu ()
|
|
(easy-menu-define menubar-slime-repl slime-repl-mode-map
|
|
"REPL" slime-repl-easy-menu)
|
|
(easy-menu-define menubar-slime slime-repl-mode-map
|
|
"SLIME" slime-easy-menu)
|
|
(easy-menu-add slime-repl-easy-menu 'slime-repl-mode-map))
|
|
|
|
(add-hook 'slime-repl-mode-hook 'slime-repl-add-easy-menu)
|
|
|
|
(defun slime-hide-inferior-lisp-buffer ()
|
|
"Display the REPL buffer instead of the *inferior-lisp* buffer."
|
|
(let* ((buffer (if (slime-process)
|
|
(process-buffer (slime-process))))
|
|
(window (if buffer (get-buffer-window buffer t)))
|
|
(repl-buffer (slime-output-buffer t))
|
|
(repl-window (get-buffer-window repl-buffer)))
|
|
(when buffer
|
|
(bury-buffer buffer))
|
|
(cond (repl-window
|
|
(when window
|
|
(delete-window window)))
|
|
(window
|
|
(set-window-buffer window repl-buffer))
|
|
(t
|
|
(pop-to-buffer repl-buffer)
|
|
(goto-char (point-max))))))
|
|
|
|
(defun slime-repl-choose-coding-system ()
|
|
(let ((candidates (slime-connection-coding-systems)))
|
|
(or (cl-find (symbol-name (car default-process-coding-system))
|
|
candidates
|
|
:test (lambda (s1 s2)
|
|
(if (fboundp 'coding-system-equal)
|
|
(coding-system-equal (intern s1) (intern s2)))))
|
|
(car candidates)
|
|
(error "Can't find suitable coding-system"))))
|
|
|
|
(defun slime-repl-connected-hook-function ()
|
|
(destructuring-bind (package prompt)
|
|
(let ((slime-current-thread t)
|
|
(cs (slime-repl-choose-coding-system)))
|
|
(slime-eval `(swank-repl:create-repl nil :coding-system ,cs)))
|
|
(setf (slime-lisp-package) package)
|
|
(setf (slime-lisp-package-prompt-string) prompt))
|
|
(slime-hide-inferior-lisp-buffer)
|
|
(slime-init-output-buffer (slime-connection)))
|
|
|
|
(defun slime-repl-event-hook-function (event)
|
|
(slime-dcase event
|
|
((:write-string output &optional target)
|
|
(slime-write-string output target)
|
|
t)
|
|
((:read-string thread tag)
|
|
(assert thread)
|
|
(slime-repl-read-string thread tag)
|
|
t)
|
|
((:read-aborted thread tag)
|
|
(slime-repl-abort-read thread tag)
|
|
t)
|
|
((:open-dedicated-output-stream port coding-system)
|
|
(slime-open-stream-to-lisp port coding-system)
|
|
t)
|
|
((:new-package package prompt-string)
|
|
(setf (slime-lisp-package) package)
|
|
(setf (slime-lisp-package-prompt-string) prompt-string)
|
|
(let ((buffer (slime-connection-output-buffer)))
|
|
(when (buffer-live-p buffer)
|
|
(with-current-buffer buffer
|
|
(setq slime-buffer-package package))))
|
|
t)
|
|
(t nil)))
|
|
|
|
(defun slime-change-repl-to-default-connection ()
|
|
"Change current REPL to the REPL of the default connection.
|
|
If the current buffer is not a REPL, don't do anything."
|
|
(when (equal major-mode 'slime-repl-mode)
|
|
(let ((slime-buffer-connection slime-default-connection))
|
|
(pop-to-buffer-same-window (slime-connection-output-buffer)))))
|
|
|
|
(defun slime-repl-find-buffer-package ()
|
|
(or (slime-search-buffer-package)
|
|
(slime-lisp-package)))
|
|
|
|
(defun slime-repl-add-hooks ()
|
|
(add-hook 'slime-event-hooks 'slime-repl-event-hook-function)
|
|
(add-hook 'slime-connected-hook 'slime-repl-connected-hook-function)
|
|
(add-hook 'slime-cycle-connections-hook
|
|
'slime-change-repl-to-default-connection))
|
|
|
|
(defun slime-repl-remove-hooks ()
|
|
(remove-hook 'slime-event-hooks 'slime-repl-event-hook-function)
|
|
(remove-hook 'slime-connected-hook 'slime-repl-connected-hook-function)
|
|
(remove-hook 'slime-cycle-connections-hook
|
|
'slime-change-repl-to-default-connection))
|
|
|
|
(defun slime-repl-sexp-at-point ()
|
|
"Returns the current sexp at point (or NIL if none is found)
|
|
while ignoring the repl prompt text."
|
|
(if (<= slime-repl-input-start-mark (point))
|
|
(save-restriction
|
|
(narrow-to-region slime-repl-input-start-mark (point-max))
|
|
(slime-sexp-at-point))
|
|
(slime-sexp-at-point)))
|
|
|
|
(defun slime-repl-inspect (string)
|
|
(interactive
|
|
(list (slime-read-from-minibuffer "Inspect value (evaluated): "
|
|
(slime-repl-sexp-at-point))))
|
|
(slime-inspect string))
|
|
|
|
(require 'bytecomp)
|
|
|
|
;; (mapc (lambda (sym)
|
|
;; (cond ((fboundp sym)
|
|
;; (unless (byte-code-function-p (symbol-function sym))
|
|
;; (byte-compile sym)))
|
|
;; (t (error "%S is not fbound" sym))))
|
|
;; '(slime-repl-event-hook-function
|
|
;; slime-write-string
|
|
;; slime-repl-write-string
|
|
;; slime-repl-emit
|
|
;; slime-repl-show-maximum-output))
|
|
|
|
(provide 'slime-repl)
|