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
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
|
;; Copyright (C) 2003-2008 Shawn Betts
;;
;; This file is part of stumpwm.
;;
;; stumpwm is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;; stumpwm is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this software; see the file COPYING. If not, see
;; <http://www.gnu.org/licenses/>.
;;; Commentary:
;;
;; This file contains the code for debugging stumpwm.
;;
;;; Code:
(in-package #:stumpwm)
(defvar *debug-level* 0
"Set this variable to a number > 0 to turn on debugging. The greater the number the more debugging output.")
(defvar *debug-expose-events* nil
"Set this variable for a visual indication of expose events on internal StumpWM windows.")
(defvar *debug-stream* (make-synonym-stream '*error-output*)
"This is the stream debugging output is sent to. It defaults to
*error-output*. It may be more convenient for you to pipe debugging
output directly to a file.")
(defun dformat (level fmt &rest args)
(when (>= *debug-level* level)
(multiple-value-bind (sec m h) (get-decoded-system-time)
(format *debug-stream* "~2,'0d:~2,'0d:~2,'0d ~2,' d " h m sec level))
;; strip out non base-char chars quick-n-dirty like
(write-string (map 'string (lambda (ch)
(if (typep ch 'standard-char)
ch #\?))
(apply 'format nil fmt args))
*debug-stream*)
(force-output *debug-stream*)))
(defvar *redirect-stream* nil
"This variable Keeps track of the stream all output is sent to when
`redirect-all-output' is called so if it changes we can close it
before reopening.")
(defun redirect-all-output (file)
"Elect to redirect all output to the specified file. For instance,
if you want everything to go to ~/.stumpwm.d/debug-output.txt you would
do:
@example
(redirect-all-output (data-dir-file \"debug-output\" \"txt\"))
@end example
"
(when (typep *redirect-stream* 'file-stream)
(close *redirect-stream*))
(setf *redirect-stream* (open file :direction :output :if-exists :append :if-does-not-exist :create)
*error-output* *redirect-stream*
*standard-output* *redirect-stream*
*trace-output* *redirect-stream*
*debug-stream* *redirect-stream*))
(defun rotate-log ()
(let ((log-filename (merge-pathnames "stumpwm.log"
(data-dir)))
(bkp-log-filename (merge-pathnames "stumpwm.log.1"
(data-dir))))
(when (probe-file log-filename)
(rename-file log-filename bkp-log-filename))))
(defun open-log ()
(rotate-log)
(let ((log-filename (merge-pathnames "stumpwm.log"
(data-dir))))
(setf *debug-stream* (open log-filename :direction :output
:if-exists :supersede
:if-does-not-exist :create))))
(defun close-log ()
(when (boundp '*debug-stream*)
(close *debug-stream*)
(makunbound '*debug-stream*)))
|
