-
Notifications
You must be signed in to change notification settings - Fork 3
/
slime-toplevel.l
177 lines (159 loc) · 6.83 KB
/
slime-toplevel.l
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
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
;;;;;;;;;;;;;;;;;;;;;;
;; Toplevel Overwrites
;;;;;;;;;;;;;;;;;;;;;;
(in-package "LISP")
(eval-when (compile)
(unless (find-package "SLIME") (make-package "SLIME")))
(eval-when (load eval)
;; Recursive load tags
(defun load (fname &rest args)
(when slime::*load-hooks*
(dolist (fn slime::*load-hooks*)
(funcall fn fname)))
(apply slime::load-org-for-slime fname args))
;; Handle unix sub processes
(defun unix:system (&optional command)
(slime::socket-request slime::*slime-stream* "read-mode" t)
(funcall slime::*old-unix-system-fn* command))
;; Send :read command to emacs server
(defun select-stream (stream-list &optional (timeout 0.0))
(if (some #'(lambda (s) (derivedp s slime::slime-input-stream)) stream-list)
(slime::socket-request slime::*slime-stream* "read" nil))
(funcall slime::*old-select-stream* stream-list timeout))
;; Only send :read once to avoid overflowing the emacs server
(defmacro user::do-until-key-with-check (check &rest forms)
`(progn
(slime::socket-request slime::*slime-stream* "read" nil)
(prog1
(while (and (null (funcall slime::*old-select-stream* (list *standard-input*) 0.001))
(eval ,check))
,@forms)
(let ((strm (car (funcall slime::*old-select-stream* (list *standard-input*) 0.1))))
(if strm (read-line (send slime::*old-terminal-io* :instream) nil nil))))))
;; Remap old *standard-input*
;; don't compile to override the reploop reference when exec command is null
(setf (symbol-function 'piped-fork)
'(lambda-closure piped-fork 0 0 (&optional (exec) &rest args)
(flet ((reploop (&rest reploop-args)
(apply slime::*old-reploop-fn* reploop-args)))
(let ((*standard-input* (send slime::*old-terminal-io* :instream))
(*use-top-selector* nil))
(apply slime::*old-piped-fork-fn* exec args)))))
;; Recompile with new unix:system
(defun evaluate-stream (input)
(let* ((eof (cons nil nil))
(command (read input nil eof))
(arglist) (arg) result)
(cond ((eq command eof) )
((symbolp command)
;; (if *history* (add-history (input . buffer)))
(cond ((fboundp command)
(setq arglist nil)
(while (not (eq (setq arg (read input nil eof)) eof))
(push arg arglist))
(setq - (cons command (nreverse arglist)))
(setq result (eval -)))
((and (boundp command)
(eq (read input nil eof) eof))
(setq - command)
(setq result (eval command)))
((find-package (string command)) (in-package (string command)))
(*try-unix*
(setq - (list 'unix:system (input . buffer)))
(setq result (unix:system (input . buffer)) ) )
(t (warn "?~%")) ))
(t
;; (if *history* (add-history (input . buffer)))
(setq - command)
(setq result (eval command)) ))
result))
;; Recompile with new evaluate-stream
(defun rep1 (repstream eof local-bindings &optional (ttyp t))
(let ((input (read-list-from-line repstream eof)) result)
(if (eq input eof) (return-from rep1 eof))
(when (and input (or (not (streamp input))
(> (length (send input :buffer)) 0)))
(when *history*
(add-history
(cond ((consp input) (format nil "~s" input))
((streamp input) (send input :buffer))
(t (string input)))) )
;; if something is going to be put in the history buffer,
;; it certainly has some value to be processed by the hook.
(if *toplevel-hook* (funcall *toplevel-hook*))
)
(cond
((null input) nil)
((symbolp input)
;; (if *history* (add-history (string input)))
(setq - input
result
(cond
((> *replevel* 0)
(eval-dynamic input local-bindings))
((boundp input) (eval input))
(t '*unbound*)))
;; (if ttyp (print result repstream))
(print result repstream)
)
((or (null (streamp input)) (listp input))
;; (if *history* (add-history (format nil "~s" input)))
(setq - input)
(setq result (eval input))
;;(if ttyp (print result repstream)))
(print result repstream))
((streamp input)
(setq result (evaluate-stream input) )
;;(if ttyp (print result repstream ))
(print result repstream ))
(t (print "?" repstream)))
(setq +++ ++ ++ + + -)
(setq *** ** ** * * result)))
(defun toplevel-prompt (strm)
;; Do not print the history number and the '$' sign in the end
(if (> *replevel* 0)
(format strm "~A~D-" *reptype* *replevel*))
(if (not (eql *package* *user-package*))
(format strm "~A:" (package-name *package*)))
(princ *prompt-string* strm))
(defun repsel (repstream eof ttyp local-bindings)
;; Do not print the evaluation result to *standard-output*
;; Instead, redirect it to *slime-stream*
(let* ((out (send repstream :outstream))
(repstream (make-two-way-stream
(send repstream :instream)
(make-string-output-stream)))
(result (rep1 repstream eof local-bindings ttyp)))
(if (eql result eof) (throw :reploop-select nil))
(slime::slime-clear-stream repstream)
(slime::slime-finish-output out)
(slime::socket-request slime::*slime-stream* "result" result)))
(defun reploop (prompt &optional (repstream slime::*old-terminal-io*) (ttyp nil))
(let ((*prompt* prompt))
(slime::slime-clear-stream repstream)
(slime::slime-finish-output repstream)
(slime::socket-request slime::*slime-stream* "abort" nil)
(send *top-selector* :add-port slime::*slime-stream* #'slime::socket-eval slime::*slime-stream*)
(reploop-select repstream ttyp)))
)
;;;;;;;;;;;;;
;; Setup REPL
;;;;;;;;;;;;;
(eval-when (load eval)
;; Set signal-handler and *history* for non-tty streams
(unless (unix:isatty *standard-input*)
(unix:signal unix::sigint 'slime::slime-sigint-handler 2)
(when (fboundp 'unix:tcgets)
(setq *tc* (unix:tcgets *standard-input*))
(new-history *history-max*)))
;; Connect to socket
(flet ((make-slime-socket (num)
(let ((port (find (format nil "--port~A=" num) *eustop-argument*
:test #'(lambda (a b) (string= a b :end2 8)))))
(when port
(setq port (read-from-string (subseq port 8)))
(assert (numberp port))
(slime::slime-connect-socket port)))))
(defconstant slime::*slime-stream* (make-slime-socket 1))
(defconstant slime::*slime-internal-stream* (make-slime-socket 2)))
)