aboutsummaryrefslogtreecommitdiff
path: root/src/debugging.lisp
diff options
context:
space:
mode:
Diffstat (limited to 'src/debugging.lisp')
-rw-r--r--src/debugging.lisp44
1 files changed, 44 insertions, 0 deletions
diff --git a/src/debugging.lisp b/src/debugging.lisp
new file mode 100644
index 0000000..73d5de1
--- /dev/null
+++ b/src/debugging.lisp
@@ -0,0 +1,44 @@
+(in-package #:weekend)
+
+(defvar *debugging* nil
+ "If T, the debugger will be evoked.")
+
+(defvar *debug-indent* nil
+ "If an integer, debug print will print this many spaces before printing the debug message. It will then increment the count.
+
+The debug indent is bound when request handling starts.")
+
+(defvar *debug-log* nil
+ "An output stream bound when request handling begins and guaranteed to
+be written to *ERROR-OUTPUT* when the handling finishes or raises an
+error condition.")
+
+(defmacro with-debug-extent ((&key (stream '*error-output*)) &body body)
+ "When *DEBUGGING* is non NIL, calls to DEBUG-PRINT appearing anywhere
+within the runtime extent of BODY will print to this handler thread's
+debug log."
+ `(let ((*debug-log* (and *debugging* (make-debug-log)))
+ (*debug-indent* (and *debugging* 0)))
+ (unwind-protect (progn ,@body)
+ (write-debug-log :stream ,stream))))
+
+(defun make-debug-log ()
+ (make-array 512
+ :element-type 'character
+ :fill-pointer 0
+ :adjustable t))
+
+(defun toggle-debugging ()
+ (setf *debugging* (not *debugging*)))
+
+(defun debug-print (&rest objects)
+ (when (and *debugging* *debug-log*)
+ (with-output-to-string (*standard-output* *debug-log*)
+ (write-string "DEBUG: ")
+ (loop :repeat (or *debug-indent* 0) :do (write-char #\space))
+ (format *standard-output* "~{~s ~}~%" objects)
+ (when *debug-indent* (incf *debug-indent* 2)))))
+
+(defun write-debug-log (&key (stream *error-output*))
+ (when (and *debugging* *debug-log*)
+ (write-string *debug-log* stream)))