Thu Jan 7 22:03:05 CET 2010 Tobias Rautenkranz * modular smoke & cl-smoke prefix. Wed Jul 8 16:59:00 CEST 2009 Tobias Rautenkranz * Set package when starting event loop in background. Wed Jul 1 13:05:25 CEST 2009 Tobias Rautenkranz * Use new qt:with-app. Sun Jun 7 09:47:13 CEST 2009 Tobias Rautenkranz * #'END-EVENT-LOOP & cleanup Sat Jun 6 17:07:40 CEST 2009 Tobias Rautenkranz * test event loop in background Fri Jun 5 09:50:38 CEST 2009 Tobias Rautenkranz * Set *package* from #'QT-EVAL. diff -rN -u old-repl/cl-smoke.repl.asd new-repl/cl-smoke.repl.asd --- old-repl/cl-smoke.repl.asd 1970-01-01 01:00:00.000000000 +0100 +++ new-repl/cl-smoke.repl.asd 2014-11-17 12:27:48.000000000 +0100 @@ -0,0 +1,20 @@ +(asdf:defsystem :cl-smoke.repl + :name :cl-smoke.repl + :version (0 0 1) + :author "Tobias Rautenkranz" + :license "GPL with linking exception" + :description "REPL support for cl-smoke." + :depends-on (:cl-smoke.qt.gui) + :components + ((:module "src" + :components + ((:file "package") (:file "repl" :depends-on ("package")) + (:file "locate-widget" :depends-on ("package")) + (:file "get-widget" :depends-on ("package")))))) + +(defmethod operation-done-p ((o test-op) (c (eql (find-system :cl-smoke.repl)))) + nil) + +(defmethod perform ((o test-op) (c (eql (find-system :cl-smoke.repl)))) + (operate 'asdf:load-op :cl-smoke.repl-tests) + (operate 'asdf:test-op :cl-smoke.repl-tests)) diff -rN -u old-repl/repl.mbd new-repl/repl.mbd --- old-repl/repl.mbd 2014-11-17 12:27:48.000000000 +0100 +++ new-repl/repl.mbd 1970-01-01 01:00:00.000000000 +0100 @@ -1,17 +0,0 @@ -;;;; -*- Mode: lisp; indent-tabs-mode: nil -*- - -(in-package :sysdef-user) - -(define-system :cl-smoke.repl () - (:version 0 0 1) - (:documentation "REPL support for cl-smoke.") - (:author "Tobias Rautenkranz") - (:license "GPL with linking exception") - (:components - ("src" module - (:components - "package" - ("repl" (:needs "package")) - ("locate-widget" (:needs "package")) - ("get-widget" (:needs "package"))))) - (:needs :qt)) diff -rN -u old-repl/src/package.lisp new-repl/src/package.lisp --- old-repl/src/package.lisp 2014-11-17 12:27:48.000000000 +0100 +++ new-repl/src/package.lisp 2014-11-17 12:27:48.000000000 +0100 @@ -1,7 +1,13 @@ +(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 + #:end-event-loop + #+slime #:start-event-loop-in-repl #:get-widget #:locate-widget)) diff -rN -u old-repl/src/repl.lisp new-repl/src/repl.lisp --- old-repl/src/repl.lisp 2014-11-17 12:27:48.000000000 +0100 +++ new-repl/src/repl.lisp 2014-11-17 12:27:48.000000000 +0100 @@ -2,18 +2,18 @@ (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)))) + (setf (result *qt-eval*) (multiple-value-list (eval form)) + (new-package *qt-eval*) *package*)) '(t)) :reader eval-slot) (eval-signal :initform (qt:make-signal t) :reader eval-signal - :documentation "Send an form to evaluate.")) + :documentation "Send an form to evaluate.") + (result :accessor result) + (package :accessor new-package :initarg :package)) (:metaclass cxx:class)) (defmethod initialize-instance :after ((qt-eval qt-eval) &key &allow-other-keys) @@ -22,64 +22,73 @@ (defun qt-eval (form) "Returns the result of FORM evaluated in the event loop thread." (funcall (eval-signal *qt-eval*) form) - (values-list *result*)) + (setf *package* (new-package *qt-eval*)) + (values-list (result *qt-eval*))) -(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 +(let ((eval-region-orig)) + (defun end-event-loop () + #+slime + (progn + (assert eval-region-orig) + (setf (fdefinition 'swank::eval-region) + eval-region-orig) + (setf eval-region-orig nil)) + (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 + ;; Like eval-region of Slimes swank.lisp + #+slime + (progn + (assert (null eval-region-orig)) + (setf eval-region-orig + #'swank::eval-region) + (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*) + (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 + *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"))) + (setf *qt-eval* (make-instance 'qt-eval :package *package*)) + (qt:do-delayed-initialize + (bt:condition-notify ready)) + (qt:connect (qt:get-signal (qt:app) + "aboutToQuit()") + #'(lambda () + (setf *qt-eval* nil))) + (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. @@ -87,15 +96,13 @@ 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) + (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)) + #'(lambda () + (swank::process-requests t) ;; it's a wonder this even works! + (sb-impl::serve-event 0.1))) (cxx:start idle) (qt:exec) (format *debug-io* "New-repl end~%")))) diff -rN -u old-repl/test.lisp new-repl/test.lisp --- old-repl/test.lisp 1970-01-01 01:00:00.000000000 +0100 +++ new-repl/test.lisp 2014-11-17 12:27:48.000000000 +0100 @@ -0,0 +1,26 @@ +;;; sbcl < test.lisp +;;; +;;; somehow #'LOADing the test file hangs WITH-APP!? +;;; Thus the pipe +;;; + +(require :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) diff -rN -u old-repl/test.sh new-repl/test.sh --- old-repl/test.sh 1970-01-01 01:00:00.000000000 +0100 +++ new-repl/test.sh 2014-11-17 12:27:48.000000000 +0100 @@ -0,0 +1,3 @@ +#!/bin/sh +sbcl < test.lisp +exit $?