about summary refs log tree commit diff
path: root/src/stklos/debug.stk
diff options
context:
space:
mode:
authorLudovic Courtes2005-10-31 16:16:54 +0000
committerLudovic Courtes2005-10-31 16:16:54 +0000
commit89a424521b753ee7c2c67ebdc957865657f647c4 (patch)
tree7d15f69ef9aa87cd6e89153d34240baa031177c2 /src/stklos/debug.stk
parentfe831fd1e716de64a1b92beeabe4d865546dd986 (diff)
downloadskribilo-89a424521b753ee7c2c67ebdc957865657f647c4.tar.gz
skribilo-89a424521b753ee7c2c67ebdc957865657f647c4.tar.lz
skribilo-89a424521b753ee7c2c67ebdc957865657f647c4.zip
Moved the STkLos and Bigloo code to `legacy'.
Moved the STkLos and Bigloo code from `src' to `legacy'.

git-archimport-id: lcourtes@laas.fr--2005-mobile/skribilo--devel--1.2--patch-9
Diffstat (limited to 'src/stklos/debug.stk')
-rw-r--r--src/stklos/debug.stk161
1 files changed, 0 insertions, 161 deletions
diff --git a/src/stklos/debug.stk b/src/stklos/debug.stk
deleted file mode 100644
index a9fefde..0000000
--- a/src/stklos/debug.stk
+++ /dev/null
@@ -1,161 +0,0 @@
-;;;;
-;;;; debug.stk	-- Debug Facilities (stolen to Manuel Serrano) 
-;;;; 
-;;;; 
-;;;; Copyright © 2003-2004 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
-;;;; This program 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 of the License, or
-;;;; (at your option) any later version.
-;;;; 
-;;;; This program 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 program; if not, write to the Free Software
-;;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, 
-;;;; USA.
-;;;; 
-;;;;           Author: Erick Gallesio [eg@essi.fr]
-;;;;    Creation date: 10-Aug-2003 20:45 (eg)
-;;;; Last file update: 28-Oct-2004 13:16 (eg)
-;;;;
-
-
-(define-module SKRIBE-DEBUG-MODULE
-  (export debug-item skribe-debug set-skribe-debug! add-skribe-debug-symbol
-	  no-debug-color)
-
-(define *skribe-debug* 			0)
-(define *skribe-debug-symbols*		'())
-(define *skribe-debug-color* 		#t)
-(define *skribe-debug-item* 		#f)
-(define *debug-port* 			(current-error-port))
-(define *debug-depth* 			0)
-(define *debug-margin* 			"")
-(define *skribe-margin-debug-level*	0)
-
-
-(define (set-skribe-debug! val)
-  (set! *skribe-debug* val))
-
-(define (add-skribe-debug-symbol s)
-  (set! *skribe-debug-symbols* (cons s *skribe-debug-symbols*)))
-
-
-(define (no-debug-color)
-  (set! *skribe-debug-color* #f))
-
-(define (skribe-debug)
-  *skribe-debug*)
-
-;;
-;;   debug-port
-;;
-; (define (debug-port . o)
-;    (cond
-;       ((null? o)
-;        *debug-port*)
-;       ((output-port? (car o))
-;        (set! *debug-port* o)
-;        o)
-;       (else
-;        (error 'debug-port "Illegal debug port" (car o)))))
-;
-
-;;;
-;;; debug-color
-;;;
-(define (debug-color col . o)
-  (with-output-to-string
-    (if (and *skribe-debug-color*
-	     (equal? (getenv "TERM") "xterm")
-	     (interactive-port? *debug-port*))	
-	(lambda ()
-	  (format #t "[1;~Am" (+ 31 col))
-	  (for-each display o)
-	  (display ""))
-	(lambda ()
-	  (for-each display o)))))
-
-;;;
-;;; debug-bold
-;;;
-(define (debug-bold . o)
-   (apply debug-color -30 o))
-
-;;;
-;;; debug-item
-;;;
-(define (debug-item . args)
-  (when (or (>= *skribe-debug* *skribe-margin-debug-level*)
-	    *skribe-debug-item*)
-    (display *debug-margin* *debug-port*)
-    (display (debug-color (- *debug-depth* 1) "- ") *debug-port*)
-    (for-each (lambda (a) (display a *debug-port*)) args)
-    (newline *debug-port*)))
-
-;;(define-macro (debug-item  . args)
-;;  `())
-
-;;;
-;;; %with-debug-margin
-;;;
-(define (%with-debug-margin margin thunk)
-  (let ((om *debug-margin*))
-    (set! *debug-depth* (+ *debug-depth* 1))
-    (set! *debug-margin* (string-append om margin))
-    (let ((res (thunk)))
-      (set! *debug-depth* (- *debug-depth* 1))
-      (set! *debug-margin* om)
-      res)))
-      
-;;;
-;;; %with-debug
-;;
-(define (%with-debug lvl lbl thunk)
-  (let ((ol *skribe-margin-debug-level*)
-	(oi *skribe-debug-item*))
-    (set! *skribe-margin-debug-level* lvl)
-    (let ((r (if (or (and (number? lvl) (>= *skribe-debug* lvl))
-		     (and (symbol? lbl)
-			  (memq lbl *skribe-debug-symbols*)
-			  (set! *skribe-debug-item* #t)))
-		 (begin
-		   (display *debug-margin* *debug-port*)
-		   (display (if (= *debug-depth* 0)
-				(debug-color *debug-depth* "+ " lbl)
-				(debug-color *debug-depth* "--+ " lbl))
-			    *debug-port*)
-		   (newline *debug-port*)
-		   (%with-debug-margin (debug-color *debug-depth* "  |")
-				       thunk))
-		 (thunk))))
-      (set! *skribe-debug-item* oi)
-      (set! *skribe-margin-debug-level* ol)
-      r)))
-
-(define-macro (with-debug  level label . body)
-  `((in-module SKRIBE-DEBUG-MODULE %with-debug) ,level ,label (lambda () ,@body)))
-
-;;(define-macro (with-debug  level label . body)
-;;  `(begin ,@body))
-
-)
-
-#|
-Example:
-
-(with-debug 0 'foo1.1
-  (debug-item 'foo2.1)
-  (debug-item 'foo2.2)
-  (with-debug 0 'foo2.3
-     (debug-item 'foo3.1)
-     (with-debug 0 'foo3.2
-	(debug-item 'foo4.1)
-	(debug-item 'foo4.2))
-     (debug-item 'foo3.3))
-  (debug-item 'foo2.4))
-|#