darcs - repl

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

3 (defvar *qt-eval*)

5 (defclass qt-eval (qt:object)

6 ((eval-slot :initform (qt:make-slot

7 #'(lambda (form)

8 (setf (result *qt-eval*) (multiple-value-list (eval form))

9 (new-package *qt-eval*) *package*))

10 '(t))

11 :reader eval-slot)

12 (eval-signal :initform (qt:make-signal t)

13 :reader eval-signal

14 :documentation "Send an form to evaluate.")

15 (result :accessor result)

16 (package :accessor new-package :initarg :package))

17 (:metaclass cxx:class))

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+))

22 (defun qt-eval (form)

23 "Returns the result of FORM evaluated in the event loop thread."

24 (funcall (eval-signal *qt-eval*) form)

25 (setf *package* (new-package *qt-eval*))

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

28 (let ((eval-region-orig))

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

39 sends the forms entered at the REPL to this thread to be evaluated."

40 ;; Like eval-region of Slimes swank.lisp

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)

77 (qt:with-app ()

78 (qt:application.set-quit-on-last-window-closed nil)

79 (setf *qt-eval* (make-instance 'qt-eval :package *package*))

80 (qt:do-delayed-initialize

81 (bt:condition-notify ready))

82 (qt:connect (qt:get-signal (qt:app)

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

91 #+slime

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

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

94 When idle the event loop updates the REPL.

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

99 (qt:with-app ()

100 (qt:application.set-quit-on-last-window-closed nil)

101 (let ((idle (make-instance 'qt:timer)))

102 (qt:connect (qt:get-signal idle "timeout()")

103 #'(lambda ()

104 (swank::process-requests t) ;; it's a wonder this even works!

105 (sb-impl::serve-event 0.1)))

106 (cxx:start idle)

107 (qt:exec)

108 (format *debug-io* "New-repl end~%"))))