revision

examples/debug-ui/lisp/d-debug-ui.lisp

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

examples/debug-ui/lisp/d-dialogs.lisp

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

examples/debug-ui/lisp/d-input-hook.lisp

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

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 {}`