repos
/
repl
/ annotate_shade
summary
|
shortlog
|
log
|
tree
|
commit
|
commitdiff
|
headdiff
|
annotate
|
headblob
|
headfilediff
|
filehistory
normal
|
plain
|
shade
|
zebra
Use new qt:with-app.
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
(let ((eval-region-orig))
07:47:13 '
29
(defun end-event-loop ()
'
30
#+slime
'
31
(progn
'
32
(assert eval-region-orig)
'
33
(setf (fdefinition 'swank::eval-region)
'
34
eval-region-orig)
'
35
(setf eval-region-orig nil))
'
36
(cxx:quit (qt:app)))
'
37
(defun start-event-loop-in-background ()
'
38
"Starts the QApplication event loop in a new thread and
2009-06-04 tobias
39
sends the forms entered at the REPL to this thread to be evaluated."
2009-06-07 tobias
40
;; Like eval-region of Slimes swank.lisp
07:47:13 '
41
#+slime
'
42
(progn
'
43
(assert (null eval-region-orig))
'
44
(setf eval-region-orig
'
45
#'swank::eval-region)
'
46
(setf (fdefinition 'swank::eval-region)
'
47
#'(lambda (string)
'
48
(with-input-from-string (stream string)
'
49
(let (- values)
'
50
(loop
'
51
(let ((form (read stream nil stream)))
'
52
(when (eq form stream)
'
53
(fresh-line)
'
54
(finish-output)
'
55
(return (values values -)))
'
56
(setq - form)
'
57
(setq values (multiple-value-list (qt-eval form)))
'
58
(finish-output))))))))
'
59
(let ((standard-input *standard-input*)
'
60
(standard-output *standard-output*)
'
61
(debug-io *debug-io*)
'
62
(trace-output *trace-output*)
'
63
(error-output *error-output*)
'
64
(query-io *query-io*)
'
65
(terminal-io *terminal-io*)
'
66
(ready-lock (bt:make-lock))
'
67
(ready (bt:make-condition-variable)))
'
68
(bt:make-thread #'(lambda ()
'
69
#+slime
'
70
(setf *standard-input* standard-input
'
71
*standard-output* standard-output
'
72
*debug-io* debug-io
'
73
*trace-output* trace-output
'
74
*error-output* error-output
'
75
*query-io* query-io
'
76
*terminal-io* terminal-io)
2009-07-01 tobias
77
(qt:with-app ()
11:05:25 '
78
(qt:application.set-quit-on-last-window-closed nil)
2009-07-08 tobias
79
(setf *qt-eval* (make-instance 'qt-eval))
2009-06-07 tobias
80
(qt:do-delayed-initialize
2009-07-01 tobias
81
(bt:condition-notify ready))
2009-06-07 tobias
82
(qt:connect (qt:get-signal (qt:app)
07:47:13 '
83
"aboutToQuit()")
'
84
#'(lambda ()
'
85
(setf *qt-eval* nil)))
'
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 ()
11:05:25 '
104
(swank::process-requests t) ;; it's a wonder this even works!
'
105
(sb-impl::serve-event 0.1)))
2009-06-04 tobias
106
(cxx:start idle)
20:48:44 '
107
(qt:exec)
'
108
(format *debug-io* "New-repl end~%"))))