blob: 73d5de140182bdddeed5a0604829f5c7c9440124 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
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)))
|
