Sat Jun 6 17:07:40 CEST 2009 Tobias Rautenkranz <tobias@rautenkranz.ch>

* test event loop in background

--- old-repl/src/package.lisp 2014-10-30 07:04:36.000000000 +0100

+++ new-repl/src/package.lisp 2014-10-30 07:04:36.000000000 +0100

@@ -1,7 +1,12 @@

+(eval-when (:load-toplevel :compile-toplevel)

+ (unless (member :slime *features*)

+ (when (find-package :swank)

+ (push :slime *features*))))

+

(defpackage :cl-smoke.repl

(:use :cl :cxx-support)

(:export #:start-event-loop-in-background

- #:start-event-loop-in-repl

+ #+slime #:start-event-loop-in-repl

#:get-widget

#:locate-widget))

--- old-repl/src/repl.lisp 2014-10-30 07:04:36.000000000 +0100

+++ new-repl/src/repl.lisp 2014-10-30 07:04:36.000000000 +0100

@@ -26,6 +26,7 @@

(values-list (result *qt-eval*)))

(defun end-event-loop ()

+ #+slime

(setf (fdefinition 'swank::eval-region)

#'(lambda (string)

(with-input-from-string (stream string)

@@ -45,6 +46,7 @@

"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

+ #+slime

(setf (fdefinition 'swank::eval-region)

#'(lambda (string)

(with-input-from-string (stream string)

@@ -64,8 +66,11 @@

(trace-output *trace-output*)

(error-output *error-output*)

(query-io *query-io*)

- (terminal-io *terminal-io*))

+ (terminal-io *terminal-io*)

+ (ready-lock (bt:make-lock))

+ (ready (bt:make-condition-variable)))

(bt:make-thread #'(lambda ()

+ #+slime

(setf *standard-input* standard-input

*standard-output* standard-output

*debug-io* debug-io

@@ -76,11 +81,14 @@

(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")))

+ (qt:do-delayed-initialize

+ (bt:condition-notify ready))

+ (qt:exec)))

+ :name "Qt Event Loop")

+ (bt:with-lock-held (ready-lock)

+ (bt:condition-wait ready ready-lock))))

+#+slime

(defun start-event-loop-in-repl ()

"Start the QApplication event loop in the current REPL thread.

When idle the event loop updates the REPL.

--- old-repl/test.lisp 1970-01-01 01:00:00.000000000 +0100

+++ new-repl/test.lisp 2014-10-30 07:04:36.000000000 +0100

@@ -0,0 +1,38 @@

+;;; sbcl < test.lisp

+;;;

+;;; somehow #'LOADing the test file hangs WITH-APP!?

+;;; Thus the pipe

+;;;

+

+(in-package :sysdef-user)

+

+(defun load-sysdef (pathname system)

+ (load pathname)

+ (setf (mb.sysdef::pathname-of (find-system system)) pathname))

+

+(defun load-sysdef-file (system-name)

+ "Loads a mbd file in the current directory."

+ (load-sysdef (first (directory "*.mbd"))

+ system-name))

+

+(load-sysdef-file :cl-smoke.repl)

+(mb:load :cl-smoke.repl)

+

+(in-package :cl-smoke.repl)

+

+(defun test-event-loop-in-background ()

+ (start-event-loop-in-background)

+ (qt-eval '(defvar *w* (make-instance 'qt:push-button)))

+ (qt-eval '(cxx:show *w*))

+ (qt-eval '(setf (cxx:text *w*) "Hello World!"))

+ (qt-eval '(assert (string= "Hello World!" (cxx:text *w*))))

+ (qt-eval '(cxx:adjust-size *w*))

+ (qt-eval '(in-package :smoke))

+ (qt-eval '(assert (eql (find-package :smoke) *package*)))

+ (qt-eval '(end-event-loop)))

+

+(test-event-loop-in-background)

+

+(print "success")

+

+(sb-ext:quit)

--- old-repl/test.sh 1970-01-01 01:00:00.000000000 +0100

+++ new-repl/test.sh 2014-10-30 07:04:36.000000000 +0100

@@ -0,0 +1,3 @@

+#!/bin/sh

+sbcl < test.lisp

+exit $?