core: Tune debug printing.
[mes.git] / module / mes / guile.mes
index 321e2cc570ff37cf971ad85ca61a0d1788a07025..8009f96d0d5b4e825b6453a284cce128da8961ee 100644 (file)
@@ -48,7 +48,7 @@
         (if (eq? c #\*eof*) '()
             (cons c (read-string (read-char)))))
       (let ((string (list->string (read-string (read-char)))))
-        (if (and=> (getenv "MES_DEBUG") (compose (cut > <> 2) string->number))
+        (if (and=> (getenv "MES_DEBUG") (compose (cut > <> 3) string->number))
             (core:display-error (string-append "drained: `" string "'\n")))
         string)))
 
@@ -68,7 +68,7 @@
   (define save-peek-char peek-char)
   (define save-read-char read-char)
   (define save-unread-char unread-char)
-  (if (and=> (getenv "MES_DEBUG") (compose (cut > <> 2) string->number))
+  (if (and=> (getenv "MES_DEBUG") (compose (cut > <> 3) string->number))
       (core:display-error (string-append "with-input-from-string: `" string "'\n")))
   (let ((tell 0)
         (end (string-length string)))
 
 (define core:open-input-file open-input-file)
 (define (open-input-file file)
-  (let ((port (core:open-input-file file)))
-    (when (getenv "MES_DEBUG")
-      (core:display-error (string-append "open-input-file: `" file "'\n"))
-      (core:display-error "port=")
-      (core:display-error port)
-      (core:display-error "\n"))
+  (let ((port (core:open-input-file file))
+        (debug (and=> (getenv "MES_DEBUG") string->number)))
+    (when (and debug (> debug 1))
+      (core:display-error (string-append "open-input-file: `" file "'"))
+      (when (> debug 3)
+        (core:display-error " port=")
+        (core:display-error port)))
+    (core:display-error "\n")
     port))
 
 (define open-input-string
   (let ((save-set-current-input-port #f)
         (string-port #f))
     (lambda (string)
-      (if (and=> (getenv "MES_DEBUG") (compose (cut > <> 2) string->number))
+      (if (and=> (getenv "MES_DEBUG") (compose (cut > <> 3) string->number))
           (core:display-error (string-append "open-input-string: `" string "'\n")))
       (set! save-set-current-input-port set-current-input-port)
       (set! string-port (cons '*string-port* (gensym)))
                   (tell 0)
                   (end (string-length string)))
               (lambda (port)
-                (when (and=> (getenv "MES_DEBUG") (compose (cut > <> 2) string->number))
+                (when (and=> (getenv "MES_DEBUG") (compose (cut > <> 5) string->number))
                     (core:display-error (string-append "open-input-string: `" string "' save-set-current-input-port port="))
                     (core:display-error port)
                     (core:display-error "\n"))
                             (lambda (c) (set! tell (1- tell)) c))
                       (set! set-current-input-port
                             (lambda (port)
-                              (when (getenv "MES_DEBUG")
+                              (when (and=> (getenv "MES_DEBUG") (compose (cut > <> 4) string->number))
                                 (core:display-error (string-append "open-input-string: `" string "' set-current-input-port port="))
                                 (core:display-error port)
                                 (core:display-error "\n"))