mirrors/clog
1
Fork 0
mirror of https://github.com/rabbibotton/clog.git synced 2025-12-06 02:30:42 -08:00
Code Issues Projects Releases Wiki Activity

option to handle evals on main thread so break can work with sbcl

Browse source
This commit is contained in:
David Botton 2024-05-07 19:21:16 -04:00
parent 6f61020904
commit acf55705ab
4 changed files with 72 additions and 63 deletions
Download patch file Download diff file Expand all files Collapse all files

5
clog.asd vendored
View file

@ -16,7 +16,6 @@
#:bordeaux-threads #:trivial-open-browser #:parse-float #:quri #:bordeaux-threads #:trivial-open-browser #:parse-float #:quri
#:lack-middleware-static #:lack-request #:lack-util-writer-stream #:lack-middleware-static #:lack-request #:lack-util-writer-stream
#:trivial-gray-streams #:closer-mop #:mgl-pax #:cl-template #:atomics #:trivial-gray-streams #:closer-mop #:mgl-pax #:cl-template #:atomics
#:cl-indentify
#:sqlite #:cl-dbi #:cl-pass #-(or mswindows win32 cormanlisp) #:cl-isaac) #:sqlite #:cl-dbi #:cl-pass #-(or mswindows win32 cormanlisp) #:cl-isaac)
:components ((:module "static-files" :components ((:module "static-files"
:components ((:static-file "js/boot.js"))) :components ((:static-file "js/boot.js")))
@ -72,8 +71,8 @@
(:file "clog-docs"))) (:file "clog-docs")))
(asdf:defsystem #:clog/tools (asdf:defsystem #:clog/tools
:depends-on (#:clog #:clog-ace #:clog-terminal #:s-base64 #:swank :depends-on (#:clog #:clog-ace #:clog-terminal #:s-base64 #:swank #:cl-indentify
#:definitions #:parenscript) #:definitions #:parenscript #:trivial-main-thread)
:pathname "tools/" :pathname "tools/"
:components (;; clog-db-admin app :components (;; clog-db-admin app
(:file "clog-db-admin") (:file "clog-db-admin")

126
tools/clog-builder-eval.lisp
View file

@ -81,68 +81,74 @@ provide an interactive console.)"))
nil) nil)
;; Lisp code evaluation utilities ;; Lisp code evaluation utilities
(defun capture-eval (form &key (capture-console t) (defun capture-eval (form &key (capture-console t)
(capture-result t) (capture-result t)
(capture-result-form "=>~A~%") (capture-result-form "=>~A~%")
(eval-form "~A~%=>~A~%") (eval-form "~A~%=>~A~%")
(clog-obj nil) (clog-obj nil)
(private-console-win nil) (private-console-win nil)
(eval-in-package "clog-user")) (eval-in-package "clog-user"))
"Capture lisp evaluaton of FORM." "Capture lisp evaluaton of FORM."
(let (console (let ((cef
(result (make-array '(0) :element-type 'base-char (lambda ()
:fill-pointer 0 :adjustable t)) (let (console
eval-result) (result (make-array '(0) :element-type 'base-char
(with-output-to-string (stream result) :fill-pointer 0 :adjustable t))
(with-open-stream (out-stream (make-instance 'dialog-out-stream)) eval-result)
(with-open-stream (in-stream (make-instance 'dialog-in-stream :clog-obj clog-obj :source out-stream)) (with-output-to-string (stream result)
(labels ((reset-ace () (with-open-stream (out-stream (make-instance 'dialog-out-stream))
(when (typep console 'console-out-stream) (with-open-stream (in-stream (make-instance 'dialog-in-stream :clog-obj clog-obj :source out-stream))
(setf (ace console) nil))) (labels ((reset-ace ()
(my-debugger (condition encapsulation) (when (typep console 'console-out-stream)
(if clog-obj (setf (ace console) nil)))
(handler-case (my-debugger (condition encapsulation)
(let ((restart (one-of-dialog clog-obj condition (compute-restarts) (if clog-obj
:title "Available Restarts"))) (handler-case
(reset-ace) (let ((restart (one-of-dialog clog-obj condition (compute-restarts)
(when restart :title "Available Restarts")))
(let ((*debugger-hook* encapsulation)) (reset-ace)
(invoke-restart-interactively restart)))) (when restart
(end-of-file () ; no reset chosen (let ((*debugger-hook* encapsulation))
(reset-ace))) (invoke-restart-interactively restart))))
(format t "Error - ~A~%" condition)))) (end-of-file () ; no reset chosen
(unless (stringp form) (reset-ace)))
(let ((r (make-array '(0) :element-type 'base-char (format t "Error - ~A~%" condition))))
:fill-pointer 0 :adjustable t))) (unless (stringp form)
(with-output-to-string (s r) (let ((r (make-array '(0) :element-type 'base-char
(print form s)) :fill-pointer 0 :adjustable t)))
(setf form r))) (with-output-to-string (s r)
(setf console (if capture-console (print form s))
stream (setf form r)))
(make-instance 'console-out-stream :clog-obj clog-obj :win private-console-win))) (setf console (if capture-console
(let* ((*query-io* (make-two-way-stream in-stream out-stream)) stream
(*standard-output* console) (make-instance 'console-out-stream :clog-obj clog-obj :win private-console-win)))
(*standard-input* (make-instance 'console-in-stream :clog-obj clog-obj)) (let* ((*query-io* (make-two-way-stream in-stream out-stream))
(*terminal-io* (make-two-way-stream *standard-input* *standard-output*)) (*standard-output* console)
(*debug-io* *terminal-io*) (*standard-input* (make-instance 'console-in-stream :clog-obj clog-obj))
(*error-output* console) (*terminal-io* (make-two-way-stream *standard-input* *standard-output*))
(*trace-output* console) (*debug-io* *terminal-io*)
(*debugger-hook* (if clog-connection:*disable-clog-debugging* (*error-output* console)
*debugger-hook* (*trace-output* console)
#'my-debugger)) (*debugger-hook* (if clog-connection:*disable-clog-debugging*
(*default-title-class* *builder-title-class*) *debugger-hook*
(*default-border-class* *builder-border-class*) #'my-debugger))
(*package* (find-package (string-upcase eval-in-package)))) (*default-title-class* *builder-title-class*)
(setf eval-result (eval (read-from-string (format nil "(progn ~A)" form)))) (*default-border-class* *builder-border-class*)
(unless capture-result (*package* (find-package (string-upcase eval-in-package))))
(format console capture-result-form eval-result)) (setf eval-result (eval (read-from-string (format nil "(progn ~A)" form))))
(when (typep console 'console-out-stream) (unless capture-result
(close console)) (format console capture-result-form eval-result))
(close *query-io*) (when (typep console 'console-out-stream)
(values (close console))
(format nil eval-form result eval-result) (close *query-io*)
*package* (values
eval-result)))))))) (format nil eval-form result eval-result)
*package*
eval-result))))))))))
(if *clog-repl-eval-on-main-thread*
(trivial-main-thread:call-in-main-thread cef :blocking t)
(funcall cef))))
(defun do-eval (obj form-string cname &key (package "clog-user") (test t) custom-boot) (defun do-eval (obj form-string cname &key (package "clog-user") (test t) custom-boot)
"Render, evalute and run code for panel" "Render, evalute and run code for panel"

2
tools/clog-builder-settings.lisp
View file

@ -58,6 +58,8 @@
(defparameter *clog-repl-open-console-on-start* nil) (defparameter *clog-repl-open-console-on-start* nil)
(defparameter *clog-repl-send-result-to-console* nil) (defparameter *clog-repl-send-result-to-console* nil)
(defparameter *clog-repl-private-console* t) (defparameter *clog-repl-private-console* t)
;; eval on main thread so (break) works for sbcl.
(defparameter *clog-repl-eval-on-main-thread* nil)
;; Panel Builder ;; Panel Builder

2
tools/preferences.lisp.sample vendored
View file

@ -69,6 +69,8 @@
(setf *clog-repl-open-console-on-start* nil) (setf *clog-repl-open-console-on-start* nil)
(setf *clog-repl-send-result-to-console* nil) (setf *clog-repl-send-result-to-console* nil)
(setf *clog-repl-private-console* t) (setf *clog-repl-private-console* t)
;; eval on main thread so (break) works for sbcl.
(setf *clog-repl-eval-on-main-thread* nil)
;; CLOG Panel Builder ;; CLOG Panel Builder
(setf *builder-render-right-margin* 80) (setf *builder-render-right-margin* 80)