From b2c8323c9bf895f617551e6f5aab02377c0fe146 Mon Sep 17 00:00:00 2001 From: "pls.153" Date: Mon, 20 Oct 2025 10:04:24 +0200 Subject: [PATCH] revision --- examples/debug-ui/lisp/d-debug-ui.lisp | 59 ------------------------ examples/debug-ui/lisp/d-dialogs.lisp | 59 ------------------------ examples/debug-ui/lisp/d-input-hook.lisp | 53 --------------------- examples/debug-ui/readme.md | 2 +- 4 files changed, 1 insertion(+), 172 deletions(-) delete mode 100644 examples/debug-ui/lisp/d-debug-ui.lisp delete mode 100644 examples/debug-ui/lisp/d-dialogs.lisp delete mode 100644 examples/debug-ui/lisp/d-input-hook.lisp diff --git a/examples/debug-ui/lisp/d-debug-ui.lisp b/examples/debug-ui/lisp/d-debug-ui.lisp deleted file mode 100644 index 84791b2..0000000 --- a/examples/debug-ui/lisp/d-debug-ui.lisp +++ /dev/null @@ -1,59 +0,0 @@ -(defpackage :debug-ui - (:use :cl :qml) - (:export - #:*debug-dialog*)) - -(in-package :debug-ui) - -(defvar *error-output-buffer* (make-string-output-stream)) -(defvar *terminal-out-buffer* (make-string-output-stream)) -(defvar *gui-debug-io* nil) -(defvar *gui-debug-dialog* nil) - -(defun ini () - (setf *gui-debug-dialog* 'dialogs:debug-dialog) - (ini-streams) - (setf *debug-io* *gui-debug-io*)) - -(defun ini-streams () - (setf *error-output* (make-broadcast-stream *error-output* - *error-output-buffer*)) - (setf *terminal-io* (make-two-way-stream (two-way-stream-input-stream *terminal-io*) - (make-broadcast-stream (two-way-stream-output-stream *terminal-io*) - *terminal-out-buffer*)) - *gui-debug-io* (make-two-way-stream (input-hook:add 'handle-debug-io) - (two-way-stream-output-stream *terminal-io*)))) - -(defun clear-buffers () - (dolist (s (list *error-output-buffer* - *terminal-out-buffer*)) - (get-output-stream-string s))) - -(defun find-quit-restart () - ;; find best restart for ':q' (default) to exit the debugger - (let ((restarts (compute-restarts))) - (if (= 1 (length restarts)) - ":r1" - (let ((restart-names (mapcar (lambda (r) - (symbol-name (restart-name r))) - restarts))) - ;; precedence role - (dolist (name '("RESTART-TOPLEVEL" - "ABORT" - "RESTART-QT-EVENTS")) - (x:when-it (position name restart-names :test 'string=) - (return-from find-quit-restart (format nil ":r~D" x:it))))))) - ":q") - -(defun handle-debug-io () - (let ((cmd (funcall *gui-debug-dialog* - (list (cons (get-output-stream-string *error-output-buffer*) - "#d00000") - (cons (get-output-stream-string *terminal-out-buffer*) - "black"))))) - (when (string-equal ":q" cmd) - (setf cmd (find-quit-restart))) - (format nil "~A~%" (if (x:empty-string cmd) ":q" cmd)))) - -(ini) - diff --git a/examples/debug-ui/lisp/d-dialogs.lisp b/examples/debug-ui/lisp/d-dialogs.lisp deleted file mode 100644 index 4bd9c6d..0000000 --- a/examples/debug-ui/lisp/d-dialogs.lisp +++ /dev/null @@ -1,59 +0,0 @@ -(defpackage :dialogs - (:use :cl :qml) - (:export - #:debug-dialog - #:exited - #:push-dialog - #:pop-dialog)) - -(in-package :dialogs) - -(defun push-dialog (name) - "Pushes dialog NAME onto the StackView." - (qjs |pushDialog| ui:*main* (string-downcase name))) - -(defun pop-dialog () - "Pops the currently shown dialog, returning T if there was a dialog to pop." - (prog1 - (> (q< |depth| ui:*main*) 1) - (qjs |popDialog| ui:*main*))) - -(defun wait-while-transition () - ;; needed for evtl. recursive calls - (x:while (q< |busy| ui:*main*) - (qsleep 0.1))) - -(defun append-debug-output (text color bold) - (qjs |appendOutput| ui:*d-debug-model* - (list :text text - :color color - :bold bold))) - -(defun debug-dialog (messages) - (qrun* - (q! |clear| ui:*d-debug-model*) - (q> |text| ui:*d-debug-input* ":q") - (dolist (text/color messages) - (let* ((text (string-trim '(#\Newline) (car text/color))) - (color (cdr text/color)) - (bold (not (string= "black" color)))) ; boolean - (append-debug-output text color bold))) - (wait-while-transition) - (push-dialog :debug) - (q! |forceActiveFocus| ui:*d-debug-input*) - (qsingle-shot 500 (lambda () (q! |positionViewAtEnd| ui:*d-debug-text*))) - (wait-for-closed) - (q< |text| ui:*d-debug-input*))) - -(let (waiting) - (defun wait-for-closed () - (setf waiting t) - ;; busy waiting is safer than suspending a thread, especially on mobile - (x:while waiting - (qsleep 0.1)) - (pop-dialog)) - (defun exited () ; called from QML - (unless waiting - (pop-dialog)) - (setf waiting nil))) - diff --git a/examples/debug-ui/lisp/d-input-hook.lisp b/examples/debug-ui/lisp/d-input-hook.lisp deleted file mode 100644 index 040317e..0000000 --- a/examples/debug-ui/lisp/d-input-hook.lisp +++ /dev/null @@ -1,53 +0,0 @@ -;;; idea & most code from "ecl-readline.lisp" - -(defpackage input-hook - (:use :cl) - (:export - #:add)) - -(provide :input-hook) - -(in-package :input-hook) - -(defvar *functions* nil) - -(defun add (function) - (let ((stream (make-instance 'input-hook-stream))) - (push (cons stream function) *functions*) - stream)) - -(defclass input-hook-stream (gray:fundamental-character-input-stream) - ((buffer :initform (make-string 0)) - (index :initform 0))) - -(defmethod gray:stream-read-char ((stream input-hook-stream)) - (if (ensure-stream-data stream) - (with-slots (buffer index) stream - (let ((ch (char buffer index))) - (incf index) - ch)) - :eof)) - -(defmethod gray:stream-unread-char ((stream input-hook-stream) character) - (with-slots (index) stream - (when (> index 0) - (decf index)))) - -(defmethod gray:stream-listen ((stream input-hook-stream)) - nil) - -(defmethod gray:stream-clear-input ((stream input-hook-stream)) - nil) - -(defmethod gray:stream-peek-char ((stream input-hook-stream)) - (if (ensure-stream-data stream) - (with-slots (buffer index) stream - (char buffer index)) - :eof)) - -(defun ensure-stream-data (stream) - (with-slots (buffer index) stream - (when (= index (length buffer)) - (setf buffer (funcall (cdr (assoc stream *functions*))) - index 0)) - buffer)) diff --git a/examples/debug-ui/readme.md b/examples/debug-ui/readme.md index 2c676e8..8776aaa 100644 --- a/examples/debug-ui/readme.md +++ b/examples/debug-ui/readme.md @@ -27,7 +27,7 @@ Howto * extract `local-projects/lqml-debug.tgz` under `~/quicklisp/local-projects/` * add `lqml-debug` as your very first dependency in your `app.asd` -* modify your `main.qml` as can be seen in `examples/` +* modify your `main.qml` as can be seen in [examples](./examples/) * comment out evtl. present `eval.lisp` (used in simple repl) and `Ext.Repl {}`