Index: commonmod.scm
==================================================================
--- commonmod.scm
+++ commonmod.scm
@@ -21,11 +21,11 @@
 (declare (unit commonmod))
 
 (module commonmod
 	*
 	
-(import scheme chicken data-structures extras files)
+(import scheme chicken data-structures extras files ports)
 (import (prefix sqlite3 sqlite3:) posix typed-records srfi-18 srfi-69
 	md5 message-digest
 	regex srfi-1)
 
 ;;======================================================================
@@ -149,14 +149,88 @@
   (let ((adat (get-section cfgdat "areas")))
     (map (lambda (entry)
 	   `(,(car entry) . 
 	     ,(val->alist (cadr entry))))
 	 adat)))
+
+;;======================================================================
+;; debug stuff
+;;======================================================================
+
+(define verbosity (make-parameter '()))
 	 
 ;; (define (debug:print . params) #f)
 ;; (define (debug:print-info . params) #f)
 ;; 
 ;; (define (set-functions dbgp dbgpinfo)
 ;;   (set! debug:print dbgp)
 ;;   (set! debug:print-info dbgpinfo))
 
+;; this was cached based on results from profiling but it turned out the profiling
+;; somehow went wrong - perhaps too many processes writing to it. Leaving the caching
+;; in for now but can probably take it out later.
+;;
+(define (debug-calc-verbosity vstr arg) ;; arg is 'v (verbose) or 'q (quiet)
+  (let* ((res (cond
+	       ((number? vstr) vstr)
+	       ((not (string?  vstr))   1)
+	       ;; ((string-match  "^\\s*$" vstr) 1)
+	       (vstr           (let ((debugvals  (filter number? (map string->number (string-split vstr ",")))))
+				 (cond
+				  ((> (length debugvals) 1) debugvals)
+				  ((> (length debugvals) 0)(car debugvals))
+				  (else 1))))
+	       ((eq? arg 'v)   2) ;; verbose
+	       ((eq? arg 'q)   0) ;; quiet
+	       (else                   1))))
+    (verbosity res)
+    res))
+
+;; 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)
+  (let* ((vb (verbosity)))
+    (cond
+   ((and (number? vb)   ;; number number
+	 (number? n))
+    (<= n vb))
+   ((and (list? vb)     ;; list   number
+	 (number? n))
+    (member n vb))
+   ((and (list? vb)     ;; list   list
+	 (list? n))
+    (not (null? (lset-intersection! eq? vb n))))
+   ((and (number? vb)
+	 (list? n))
+    (member vb n)))))
+
+(define (debug-setup debug-arg) ;; debug-arg= #f, #t or 'noprop
+  (let ((debugstr (or debug-arg ;; (args:get-arg "-debug")
+		      ;; (args:get-arg "-debug-noprop")
+		      (get-environment-variable "MT_DEBUG_MODE"))))
+    (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 (and (not (eq? debug-arg 'noprop))
+	     (or debug-arg
+		 (not (get-environment-variable "MT_DEBUG_MODE"))))
+	(setenv "MT_DEBUG_MODE" (if (list? (verbosity))
+				    (string-intersperse (map conc (verbosity)) ",")
+				    (conc (verbosity)))))))
+
+(define (debug-print n e . params)
+  (if (debug-debug-mode n)
+      (with-output-to-port (or e (current-error-port))
+	(lambda ()
+	  ;; (if *logging*
+	      ;; (db:log-event (apply conc params))
+	  (apply print params)
+	  )))) ;; )
 )