src/repl.lisp
Thu Jun 4 22:48:44 CEST 2009 Tobias Rautenkranz <tobias@rautenkranz.ch>
* initial commit
--- old-repl/src/repl.lisp 1970-01-01 01:00:00.000000000 +0100
+++ new-repl/src/repl.lisp 2014-10-30 08:04:20.000000000 +0100
@@ -0,0 +1,101 @@
+(in-package :cl-smoke.repl)
+
+(defvar *qt-eval*)
+
+(defvar *result*)
+
+(defclass qt-eval (qt:object)
+ ((eval-slot :initform (qt:make-slot
+ #'(lambda (form)
+ (setf *result*
+ (multiple-value-list (eval form))))
+ '(t))
+ :reader eval-slot)
+ (eval-signal :initform (qt:make-signal t)
+ :reader eval-signal
+ :documentation "Send an form to evaluate."))
+ (:metaclass cxx:class))
+
+(defmethod initialize-instance :after ((qt-eval qt-eval) &key &allow-other-keys)
+ (qt:connect (eval-signal qt-eval) (eval-slot qt-eval) qt:+blocking-queued-connection+))
+
+(defun qt-eval (form)
+ "Returns the result of FORM evaluated in the event loop thread."
+ (funcall (eval-signal *qt-eval*) form)
+ (values-list *result*))
+
+(defun end-event-loop ()
+ (setf (fdefinition 'swank::eval-region)
+ #'(lambda (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)
+ (setq values (multiple-value-list (eval form)))
+ (finish-output)))))))
+ (cxx:quit (qt:app)))
+
+(defun start-event-loop-in-background ()
+ "Starts the QApplication event loop in a new thread and
+sends the forms entered at the REPL to this thread to be evaluated."
+ ;; Like eval-region of Slimes swank.lisp
+ (setf (fdefinition 'swank::eval-region)
+ #'(lambda (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)
+ (setq values (multiple-value-list (qt-eval form)))
+ (finish-output)))))))
+ (let ((standard-input *standard-input*)
+ (standard-output *standard-output*)
+ (debug-io *debug-io*)
+ (trace-output *trace-output*)
+ (error-output *error-output*)
+ (query-io *query-io*)
+ (terminal-io *terminal-io*))
+ (bt:make-thread #'(lambda ()
+ (setf *standard-input* standard-input
+ *standard-output* standard-output
+ *debug-io* debug-io
+ *trace-output* trace-output
+ *error-output* error-output
+ *query-io* query-io
+ *terminal-io* terminal-io)
+ (qt:with-app
+ (qt:application.set-quit-on-last-window-closed nil)
+ (setf *qt-eval* (make-instance 'qt-eval))
+ (format t "exec~%")
+ (qt:exec)
+ (format t "exec-done~%")))
+ :name "Qt Event Loop")))
+
+(defun start-event-loop-in-repl ()
+ "Start the QApplication event loop in the current REPL thread.
+When idle the event loop updates the REPL.
+
+While the idea is fine, it is a hack and the displaying of the argument list
+in SLIME is fluky."
+ (funcall swank::*send-repl-results-function* '(nil))
+ (qt:with-app
+ (qt:application.set-quit-on-last-window-closed nil)
+ (let ((idle (make-instance 'qt:timer)))
+ (qt:connect (qt:get-signal idle "timeout()")
+ #'(lambda ()
+ ; (swank::handle-requests swank::*emacs-connection* t)
+ (swank::process-requests t) ;; it's a wonder this even works!
+ (sb-impl::serve-event 0.1)))
+ ;(curry #'sb-impl::serve-event 0.1))
+ (cxx:start idle)
+ (qt:exec)
+ (format *debug-io* "New-repl end~%"))))