repos
/
repl
/ annotate_shade
summary
|
shortlog
|
log
|
tree
|
commit
|
commitdiff
|
headdiff
|
annotate
|
headblob
|
headfilediff
|
filehistory
normal
|
plain
|
shade
|
zebra
initial commit
Annotate for file src/repl.lisp
2009-06-04 tobias
1
(in-package :cl-smoke.repl)
20:48:44 '
2
'
3
(defvar *qt-eval*)
'
4
'
5
(defvar *result*)
'
6
'
7
(defclass qt-eval (qt:object)
'
8
((eval-slot :initform (qt:make-slot
'
9
#'(lambda (form)
'
10
(setf *result*
'
11
(multiple-value-list (eval form))))
'
12
'(t))
'
13
:reader eval-slot)
'
14
(eval-signal :initform (qt:make-signal t)
'
15
:reader eval-signal
'
16
:documentation "Send an form to evaluate."))
'
17
(:metaclass cxx:class))
'
18
'
19
(defmethod initialize-instance :after ((qt-eval qt-eval) &key &allow-other-keys)
'
20
(qt:connect (eval-signal qt-eval) (eval-slot qt-eval) qt:+blocking-queued-connection+))
'
21
'
22
(defun qt-eval (form)
'
23
"Returns the result of FORM evaluated in the event loop thread."
'
24
(funcall (eval-signal *qt-eval*) form)
'
25
(values-list *result*))
'
26
'
27
(defun end-event-loop ()
'
28
(setf (fdefinition 'swank::eval-region)
'
29
#'(lambda (string)
'
30
(with-input-from-string (stream string)
'
31
(let (- values)
'
32
(loop
'
33
(let ((form (read stream nil stream)))
'
34
(when (eq form stream)
'
35
(fresh-line)
'
36
(finish-output)
'
37
(return (values values -)))
'
38
(setq - form)
'
39
(setq values (multiple-value-list (eval form)))
'
40
(finish-output)))))))
'
41
(cxx:quit (qt:app)))
'
42
'
43
(defun start-event-loop-in-background ()
'
44
"Starts the QApplication event loop in a new thread and
'
45
sends the forms entered at the REPL to this thread to be evaluated."
'
46
;; Like eval-region of Slimes swank.lisp
'
47
(setf (fdefinition 'swank::eval-region)
'
48
#'(lambda (string)
'
49
(with-input-from-string (stream string)
'
50
(let (- values)
'
51
(loop
'
52
(let ((form (read stream nil stream)))
'
53
(when (eq form stream)
'
54
(fresh-line)
'
55
(finish-output)
'
56
(return (values values -)))
'
57
(setq - form)
'
58
(setq values (multiple-value-list (qt-eval form)))
'
59
(finish-output)))))))
'
60
(let ((standard-input *standard-input*)
'
61
(standard-output *standard-output*)
'
62
(debug-io *debug-io*)
'
63
(trace-output *trace-output*)
'
64
(error-output *error-output*)
'
65
(query-io *query-io*)
'
66
(terminal-io *terminal-io*))
'
67
(bt:make-thread #'(lambda ()
'
68
(setf *standard-input* standard-input
'
69
*standard-output* standard-output
'
70
*debug-io* debug-io
'
71
*trace-output* trace-output
'
72
*error-output* error-output
'
73
*query-io* query-io
'
74
*terminal-io* terminal-io)
'
75
(qt:with-app
'
76
(qt:application.set-quit-on-last-window-closed nil)
'
77
(setf *qt-eval* (make-instance 'qt-eval))
'
78
(format t "exec~%")
'
79
(qt:exec)
'
80
(format t "exec-done~%")))
'
81
:name "Qt Event Loop")))
'
82
'
83
(defun start-event-loop-in-repl ()
'
84
"Start the QApplication event loop in the current REPL thread.
'
85
When idle the event loop updates the REPL.
'
86
'
87
While the idea is fine, it is a hack and the displaying of the argument list
'
88
in SLIME is fluky."
'
89
(funcall swank::*send-repl-results-function* '(nil))
'
90
(qt:with-app
'
91
(qt:application.set-quit-on-last-window-closed nil)
'
92
(let ((idle (make-instance 'qt:timer)))
'
93
(qt:connect (qt:get-signal idle "timeout()")
'
94
#'(lambda ()
'
95
; (swank::handle-requests swank::*emacs-connection* t)
'
96
(swank::process-requests t) ;; it's a wonder this even works!
'
97
(sb-impl::serve-event 0.1)))
'
98
;(curry #'sb-impl::serve-event 0.1))
'
99
(cxx:start idle)
'
100
(qt:exec)
'
101
(format *debug-io* "New-repl end~%"))))