2005-07-06 04:57:44 -04:00
|
|
|
(define debug-mode #t)
|
|
|
|
|
2005-05-18 11:24:49 -04:00
|
|
|
(define *tty-port* #f)
|
|
|
|
|
|
|
|
(define (init-tty-debug-output!)
|
2005-07-06 04:57:44 -04:00
|
|
|
(and debug-mode
|
|
|
|
(call-with-values
|
|
|
|
open-pty
|
|
|
|
(lambda (input-port name)
|
|
|
|
(set! *tty-port* (dup->outport input-port))
|
|
|
|
(close input-port)
|
|
|
|
(set-port-buffering *tty-port* bufpol/block 8192)
|
|
|
|
name))))
|
2005-05-18 11:24:49 -04:00
|
|
|
|
|
|
|
(define debug-message
|
|
|
|
(lambda args
|
2005-08-18 05:19:48 -04:00
|
|
|
(if (and debug-mode *tty-port*)
|
2005-07-06 04:57:44 -04:00
|
|
|
(with-current-output-port*
|
|
|
|
*tty-port*
|
|
|
|
(lambda ()
|
2005-10-11 11:40:44 -04:00
|
|
|
(for-each write args)
|
2005-07-06 04:57:44 -04:00
|
|
|
(newline)
|
|
|
|
(flush-tty/output *tty-port*))))))
|
2005-05-18 14:56:30 -04:00
|
|
|
|