mirror of
https://github.com/rabbibotton/clog.git
synced 2025-12-06 02:30:42 -08:00
better redirection of console to builder
This commit is contained in:
David Botton
parent
9e6b8ce7e1
commit
11c19eedeb
4 changed files with 52 additions and 32 deletions
|
|
@ -214,24 +214,28 @@
|
|||
;; with-clog-debugger ;;
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(defmacro with-clog-debugger ((clog-obj &key title) &body body)
|
||||
"body uses a clog-gui based debugged instead of the console"
|
||||
(defmacro with-clog-debugger ((clog-obj &key title standard-output) &body body)
|
||||
"body uses a clog-gui based debugger instead of the console"
|
||||
`(with-open-stream (out-stream (make-instance 'dialog-out-stream))
|
||||
(with-open-stream (in-stream (make-instance 'dialog-in-stream :clog-obj ,clog-obj :source out-stream))
|
||||
(labels ((my-debugger (condition encapsulation)
|
||||
(ignore-errors
|
||||
(let ((restart (one-of-dialog ,clog-obj condition (compute-restarts)
|
||||
:title (format nil "Available Restarts~A"
|
||||
(if ,title
|
||||
(format nil " for ~A" ,title)
|
||||
"")))))
|
||||
(when restart
|
||||
(let ((*debugger-hook* encapsulation))
|
||||
(invoke-restart-interactively restart)))))))
|
||||
(let* ((*query-io* (make-two-way-stream in-stream out-stream))
|
||||
(*debugger-hook* (if clog-connection:*disable-clog-debugging*
|
||||
*debugger-hook*
|
||||
#'my-debugger)))
|
||||
(handler-case
|
||||
(let ((restart (one-of-dialog ,clog-obj condition (compute-restarts)
|
||||
:title (format nil "Available Restarts~A"
|
||||
(if ,title
|
||||
(format nil " for ~A" ,title)
|
||||
"")))))
|
||||
(when restart
|
||||
(let ((*debugger-hook* encapsulation))
|
||||
(invoke-restart-interactively restart))))
|
||||
(end-of-file () ; no reset chosen
|
||||
nil))))
|
||||
(let* ((*standard-output* (or ,standard-output
|
||||
*standard-output*))
|
||||
(*query-io* (make-two-way-stream in-stream out-stream))
|
||||
(*debugger-hook* (if clog-connection:*disable-clog-debugging*
|
||||
*debugger-hook*
|
||||
#'my-debugger)))
|
||||
,@body)))))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
|
@ -242,6 +246,7 @@
|
|||
(body-left-offset 0)
|
||||
(body-right-offset 0)
|
||||
(use-clog-debugger nil)
|
||||
(standard-output nil)
|
||||
(parent-desktop-obj nil)
|
||||
(w3-css-url "/css/w3.css")
|
||||
(jquery-ui-css "/css/jquery-ui.css")
|
||||
|
|
@ -272,9 +277,10 @@ NOTE: use-clog-debugger should not be set for security issues
|
|||
(when jquery-ui
|
||||
(load-script (html-document clog-body) jquery-ui))
|
||||
(when (and use-clog-debugger (not clog-connection:*disable-clog-debugging*))
|
||||
(setf (connection-data-item clog-body "clog-debug") (lambda (event data)
|
||||
(with-clog-debugger (clog-body)
|
||||
(funcall event data))))))
|
||||
(setf (connection-data-item clog-body "clog-debug")
|
||||
(lambda (event data)
|
||||
(with-clog-debugger (clog-body :standard-output standard-output)
|
||||
(funcall event data))))))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Implementation - Menus
|
||||
|
|
@ -1137,7 +1143,8 @@ window-to-top-by-param or window-by-param."))
|
|||
(when (last-z app)
|
||||
(setf (z-index obj) (incf (last-z app)))))
|
||||
(when (window-select app)
|
||||
(setf (selectedp (window-select-item obj)) t))
|
||||
(when (window-select-item obj)
|
||||
(setf (selectedp (window-select-item obj)) t)))
|
||||
(when pop
|
||||
(focus pop))
|
||||
(fire-on-window-change obj app)))
|
||||
|
|
@ -2282,7 +2289,7 @@ make-two-way-stream to provide a *query-io* using a clog-gui instead of console)
|
|||
(with-output-to-string (s trc)
|
||||
(uiop:print-condition-backtrace intro :stream s))
|
||||
(when trc
|
||||
(format t "~A" trc)))
|
||||
(format t "~%~A~%" trc)))
|
||||
(setf q (format nil "~A~&~A:" q prompt))
|
||||
(setq i (read-from-string (input-dialog obj q (lambda (result)
|
||||
(cond ((or (eq result nil)
|
||||
|
|
|
|||
|
|
@ -3,12 +3,14 @@
|
|||
(defun on-open-console (obj)
|
||||
(let ((app (connection-data-item obj "builder-app-data")))
|
||||
(if (console-win app)
|
||||
(window-focus (console-win app))
|
||||
(progn
|
||||
(setf (hiddenp (console-win app)) nil)
|
||||
(window-focus (console-win app)))
|
||||
(let* ((win (on-open-file obj :title "CLOG Builder Console"
|
||||
:editor-use-console-for-evals t)))
|
||||
(set-on-window-close win (lambda (obj)
|
||||
(declare (ignore obj))
|
||||
(setf (console-win app) nil)))
|
||||
(set-on-window-can-close win (lambda (obj)
|
||||
(setf (hiddenp obj) t)
|
||||
nil))
|
||||
(setf (console-win app) win)))))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
|
@ -103,7 +105,7 @@ provide an interactive console.)"))
|
|||
(when restart
|
||||
(let ((*debugger-hook* encapsulation))
|
||||
(invoke-restart-interactively restart))))
|
||||
(end-of-file () ; cancel was pressed
|
||||
(end-of-file () ; no reset chosen
|
||||
(reset-ace)))
|
||||
(format t "Error - ~A~%" condition))))
|
||||
(unless (stringp form)
|
||||
|
|
|
|||
|
|
@ -55,11 +55,15 @@
|
|||
(on-dir-win panel :dir (asdf:system-source-directory sys))))))
|
||||
|
||||
(defun projects-run (panel)
|
||||
(let ((val (text-value (entry-point panel))))
|
||||
(let ((app (connection-data-item panel "builder-app-data"))
|
||||
(val (text-value (entry-point panel))))
|
||||
(unless (equal val "")
|
||||
(setf clog:*clog-debug* (lambda (event data)
|
||||
(with-clog-debugger (panel :title val)
|
||||
(funcall event data))))
|
||||
(setf clog:*clog-debug*
|
||||
(lambda (event data)
|
||||
(with-clog-debugger (panel
|
||||
:title val
|
||||
:standard-output (stdout app))
|
||||
(funcall event data))))
|
||||
(capture-eval (format nil "(~A)" val) :clog-obj panel
|
||||
:capture-console nil
|
||||
:capture-result nil
|
||||
|
|
|
|||
|
|
@ -24,7 +24,11 @@ clog-builder window.")
|
|||
;; Per instance app data
|
||||
|
||||
(defclass builder-app-data ()
|
||||
((copy-buf
|
||||
((stdout
|
||||
:accessor stdout
|
||||
:initform nil
|
||||
:documentation "The standard-output for this instance")
|
||||
(copy-buf
|
||||
:accessor copy-buf
|
||||
:initform nil
|
||||
:documentation "Copy buffer")
|
||||
|
|
@ -316,9 +320,12 @@ clog-builder window.")
|
|||
(open-ext (form-data-item (form-get-data body) "open-ext")))
|
||||
(setf (connection-data-item body "builder-app-data") app)
|
||||
(setf (title (html-document body)) "CLOG Builder")
|
||||
(clog-gui-initialize body :use-clog-debugger t)
|
||||
(setf (stdout app) (if clog-connection:*disable-clog-debugging*
|
||||
*standard-output*
|
||||
(make-instance 'console-out-stream :clog-obj body)))
|
||||
(clog-gui-initialize body :use-clog-debugger t :standard-output (stdout app))
|
||||
(add-class body *builder-window-desktop-class*)
|
||||
(with-clog-debugger (body)
|
||||
(with-clog-debugger (body :standard-output (stdout app))
|
||||
(when *builder-window-show-static-root-class*
|
||||
(setf (z-index (create-panel body :positioning :fixed
|
||||
:bottom 0 :left 0
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue