summary refs log tree commit diff
path: root/src/guile/skribe/debug.scm
diff options
context:
space:
mode:
authorLudovic Court`es2005-09-23 16:16:44 +0000
committerLudovic Court`es2005-09-23 16:16:44 +0000
commit15456d415e58a5823700fe3198cf3916e917f2b9 (patch)
tree3b3bb9c26e2b79653f1b0fe193ae64964b2f624a /src/guile/skribe/debug.scm
parentc323ee2c0207a02d8af1d0366fdf000f051fdb27 (diff)
parenta85155f7c411761cfbd75431f265675ae0f394e3 (diff)
downloadskribilo-15456d415e58a5823700fe3198cf3916e917f2b9.tar.gz
skribilo-15456d415e58a5823700fe3198cf3916e917f2b9.tar.lz
skribilo-15456d415e58a5823700fe3198cf3916e917f2b9.zip
Lots of changes...
Patches applied:

 * lcourtes@laas.fr--2005-mobile/skribilo--devel--1.2--base-0
   tag of lcourtes@laas.fr--2004-libre/skribilo--devel--1.2--patch-5

 * lcourtes@laas.fr--2005-mobile/skribilo--devel--1.2--patch-1
   Lots of changes.


git-archimport-id: lcourtes@laas.fr--2004-libre/skribilo--devel--1.2--patch-6
Diffstat (limited to 'src/guile/skribe/debug.scm')
-rw-r--r--src/guile/skribe/debug.scm160
1 files changed, 0 insertions, 160 deletions
diff --git a/src/guile/skribe/debug.scm b/src/guile/skribe/debug.scm
deleted file mode 100644
index e2bff27..0000000
--- a/src/guile/skribe/debug.scm
+++ /dev/null
@@ -1,160 +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)
-   :export (with-debug %with-debug
-	    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)
-  `(%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))
-