blob: f289c90f6276495e07207426532d2f884deb673c (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
|
;;; swank-listener-hooks.lisp --- listener with special hooks
;;
;; Author: Alan Ruttenberg <alanr-l@mumble.net>
;; Provides *slime-repl-eval-hooks* special variable which
;; can be used for easy interception of SLIME REPL form evaluation
;; for purposes such as integration with application event loop.
(in-package :swank)
(eval-when (:compile-toplevel :load-toplevel :execute)
(swank-require :swank-repl))
(defvar *slime-repl-advance-history* nil
"In the dynamic scope of a single form typed at the repl, is set to nil to
prevent the repl from advancing the history - * ** *** etc.")
(defvar *slime-repl-suppress-output* nil
"In the dynamic scope of a single form typed at the repl, is set to nil to
prevent the repl from printing the result of the evalation.")
(defvar *slime-repl-eval-hook-pass* (gensym "PASS")
"Token to indicate that a repl hook declines to evaluate the form")
(defvar *slime-repl-eval-hooks* nil
"A list of functions. When the repl is about to eval a form, first try running each of
these hooks. The first hook which returns a value which is not *slime-repl-eval-hook-pass*
is considered a replacement for calling eval. If there are no hooks, or all
pass, then eval is used.")
(export '*slime-repl-eval-hooks*)
(defslimefun repl-eval-hook-pass ()
"call when repl hook declines to evaluate the form"
(throw *slime-repl-eval-hook-pass* *slime-repl-eval-hook-pass*))
(defslimefun repl-suppress-output ()
"In the dynamic scope of a single form typed at the repl, call to
prevent the repl from printing the result of the evalation."
(setq *slime-repl-suppress-output* t))
(defslimefun repl-suppress-advance-history ()
"In the dynamic scope of a single form typed at the repl, call to
prevent the repl from advancing the history - * ** *** etc."
(setq *slime-repl-advance-history* nil))
(defun %eval-region (string)
(with-input-from-string (stream string)
(let (- values)
(loop
(let ((form (read stream nil stream)))
(when (eq form stream)
(fresh-line)
(finish-output)
(return (values values -)))
(setq - form)
(if *slime-repl-eval-hooks*
(setq values (run-repl-eval-hooks form))
(setq values (multiple-value-list (eval form))))
(finish-output))))))
(defun run-repl-eval-hooks (form)
(loop for hook in *slime-repl-eval-hooks*
for res = (catch *slime-repl-eval-hook-pass*
(multiple-value-list (funcall hook form)))
until (not (eq res *slime-repl-eval-hook-pass*))
finally (return
(if (eq res *slime-repl-eval-hook-pass*)
(multiple-value-list (eval form))
res))))
(defun %listener-eval (string)
(clear-user-input)
(with-buffer-syntax ()
(swank-repl::track-package
(lambda ()
(let ((*slime-repl-suppress-output* :unset)
(*slime-repl-advance-history* :unset))
(multiple-value-bind (values last-form) (%eval-region string)
(unless (or (and (eq values nil) (eq last-form nil))
(eq *slime-repl-advance-history* nil))
(setq *** ** ** * * (car values)
/// // // / / values))
(setq +++ ++ ++ + + last-form)
(unless (eq *slime-repl-suppress-output* t)
(funcall swank-repl::*send-repl-results-function* values)))))))
nil)
(setq swank-repl::*listener-eval-function* '%listener-eval)
(provide :swank-listener-hooks)
|
