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
|
;;======================================================================
;; Copyright 2006-2012, Matthew Welland.
;;
;; This program is made available under the GNU GPL version 2.0 or
;; greater. See the accompanying file COPYING for details.
;;
;; This program is distributed WITHOUT ANY WARRANTY; without even the
;; implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
;; PURPOSE.
;;======================================================================
(define (debug:calc-verbosity vstr)
(cond
(vstr
(let ((debugvals (string-split vstr ",")))
(if (> (length debugvals) 1)
(map string->number debugvals)
(string->number (car debugvals)))))
((args:get-arg "-v") 2)
((args:get-arg "-q") 0)
(else 1)))
;; check verbosity, #t is ok
(define (debug:check-verbosity verbosity vstr)
(if (not (or (number? verbosity)
(list? verbosity)))
(begin
(print "ERROR: Invalid debug value " vstr)
#f)
#t))
(define (debug:debug-mode n)
(or (and (number? *verbosity*)
(<= n *verbosity*))
(and (list? *verbosity*)
(member n *verbosity*))))
(define (debug:setup)
(let ((debugstr (or (args:get-arg "-debug")
(getenv "MT_DEBUG_MODE"))))
(set! *verbosity* (debug:calc-verbosity debugstr))
(debug:check-verbosity *verbosity* debugstr)
(if (or (args:get-arg "-debug")
(not (getenv "MT_DEBUG_MODE")))
(setenv "MT_DEBUG_MODE" (if (list? *verbosity*)
(string-intersperse (map conc *verbosity*) ",")
(conc *verbosity*))))))
|
>
>
|
|
|
|
|
>
|
|
>
>
|
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
|
;;======================================================================
;; Copyright 2006-2012, Matthew Welland.
;;
;; This program is made available under the GNU GPL version 2.0 or
;; greater. See the accompanying file COPYING for details.
;;
;; This program is distributed WITHOUT ANY WARRANTY; without even the
;; implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
;; PURPOSE.
;;======================================================================
(use trace)
(define (debug:calc-verbosity vstr)
(cond
((string-match "^\\s*$" vstr) #f)
(vstr (let ((debugvals (string-split vstr ",")))
(cond
((> (length debugvals) 1)(map string->number debugvals))
((> (length debugvals) 0)(string->number (car debugvals)))
(else #f))))
((args:get-arg "-v") 2)
((args:get-arg "-q") 0)
(else 1)))
;; check verbosity, #t is ok
(define (debug:check-verbosity verbosity vstr)
(if (not (or (number? verbosity)
(list? verbosity)))
(begin
(print "ERROR: Invalid debug value \"" vstr "\"")
#f)
#t))
(define (debug:debug-mode n)
(or (and (number? *verbosity*)
(<= n *verbosity*))
(and (list? *verbosity*)
(member n *verbosity*))))
(define (debug:setup)
(let ((debugstr (or (args:get-arg "-debug")
(getenv "MT_DEBUG_MODE"))))
(set! *verbosity* (debug:calc-verbosity debugstr))
(debug:check-verbosity *verbosity* debugstr)
;; if we were handed a bad verbosity rule then we will override it with 1 and continue
(if (not *verbosity*)(set! *verbosity* 1))
(if (or (args:get-arg "-debug")
(not (getenv "MT_DEBUG_MODE")))
(setenv "MT_DEBUG_MODE" (if (list? *verbosity*)
(string-intersperse (map conc *verbosity*) ",")
(conc *verbosity*))))))
|