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