From e817ee7b3df9586086d7ac2689f3b6a4cc92d2d2 Mon Sep 17 00:00:00 2001
From: Trevor Daniels <t.daniels@treda.co.uk>
Date: Sat, 9 Jan 2010 00:22:23 +0000
Subject: [PATCH] Debug: another iteration of Scheme debug aids

 - extracted from a patch prepared by Ian Hulin
---
 ly/guile-debugger.ly   | 21 +++++++++------
 scm/guile-debugger.scm | 59 +++++++++++++++++++++++++++++++++++-------
 2 files changed, 62 insertions(+), 18 deletions(-)

diff --git a/ly/guile-debugger.ly b/ly/guile-debugger.ly
index 401aff95fc..dc8368a415 100644
--- a/ly/guile-debugger.ly
+++ b/ly/guile-debugger.ly
@@ -18,29 +18,34 @@
 
 
 %%  \include this file to enable the setting of breakpoints in guile.
-%%  Once loaded, this file will open a guile debug prompt.  Type
-%%  help
-%%  at the debug prompt to get a list of possible commands.
+%%  Once loaded, this file will open a guile prompt.  Type
+%%  (debug-help)
+%%  at the guile prompt to get a list of possible commands.
 %%  For more information, see the Contributor's Guide.
 
 
 \version "2.13.10"
 
-% define lilypond-module as a variable in the guile-user module and set to the current
-% Scheme module (which will be the lilypond top-level
+% define lilypond-module as a variable in the guile-user module and set
+% to the current Scheme module (which will be the lilypond top-level
 % module)
 
 #(module-define! (resolve-module '(guile-user))
                  'lilypond-module
                  (current-module))
 %
-% Ensure we have command-line recall available at guile> prompt
+% Ensure we have command-line recall available at the guile prompt
 %
 #(use-modules (ice-9 readline))
 #(activate-readline)
-#(display "\n Guile debugger for Lilypond\n")
+#(display "\n Guile debugger for Lilypond")
+#(display "\n For help enter (debug-help)\n")
+%
+% Ensure debugger definitions are available in lilypond-module and guile-user
+%
 #(use-modules (scm guile-debugger))
-#(newline)
+#(ly:module-copy (resolve-module '(guile-user))
+                 (resolve-module '(scm guile-debugger)))
 #(top-repl)
 %
 % top-repl has re-set the module to guile-user,
diff --git a/scm/guile-debugger.scm b/scm/guile-debugger.scm
index 809f01ef0e..0b99e1a3f4 100755
--- a/scm/guile-debugger.scm
+++ b/scm/guile-debugger.scm
@@ -22,21 +22,60 @@
   #:use-module (ice-9 debugging steps)
   #:use-module (ice-9 debugging ice-9-debugger-extensions)
   #:use-module (ice-9 readline)
-  #:export (set-break! set-trace! set-trace-subtree!))
+  #:export (set-break!
+	    clear-break!
+	    set-trace-call!
+	    clear-trace-call!
+	    set-trace-subtree!
+	    clear-trace-subtree!
+	    debug-help))
 
 (define (set-break! proc)
   (install-trap (make <procedure-trap>
-		      #:procedure proc
-		      #:behaviour debug-trap)))
+		  #:procedure proc
+		  #:behaviour debug-trap)))
+(define (clear-break! proc)
+  (uninstall-trap (make <procedure-trap>
+		    #:procedure proc
+		    #:behaviour debug-trap)))
 
-(define (set-trace! proc)
+
+(define (set-trace-call! proc)
   (install-trap (make <procedure-trap>
-		      #:procedure proc
-		      #:behaviour (list trace-trap
-					trace-at-exit))))
+		  #:procedure proc
+		  #:behaviour (list trace-trap
+				    trace-at-exit))))
+(define (clear-trace-call! proc)
+  (uninstall-trap (make <procedure-trap>
+		    #:procedure proc
+		    #:behaviour (list trace-trap
+				      trace-at-exit))))
 
 (define (set-trace-subtree! proc)
   (install-trap (make <procedure-trap>
-		      #:procedure proc
-		      #:behaviour (list trace-trap
-					trace-until-exit))))
+		  #:procedure proc
+		  #:behaviour (list trace-trap
+				    trace-until-exit))))
+
+(define (clear-trace-subtree! proc)
+  (uninstall-trap (make <procedure-trap>
+		    #:procedure proc
+		    #:behaviour (list trace-trap
+				      trace-until-exit))))
+
+(define (debug-help )
+  (display "\nYou may add the following commands as debugging statements in your source file\n")
+  (display "or enter the set-x! commands at the guile prompt:\n\n")
+  (display " (set-break! <procedure>)\n")
+  (display "   causes guile to enter debugger on a call to <procedure>\n")
+  (display " (clear-break! <procedure>)\n")
+  (display "   disables a breakpoint previously set on a call to <procedure>\n")
+  (display " (set-trace-call! <procedure>)\n")
+  (display "   prints out a line when Scheme enters or exits <procedure>\n")
+  (display " (clear-trace-call! <procedure>)\n")
+  (display "   turns off tracing calls to <procedure>\n")
+  (display " (set-trace-subtree! <procedure>)\n")
+  (display "   displays each line of Scheme code executed during a call to <procedure>\n")
+  (display " (clear-trace-subtree! <procedure>)\n")
+  (display "   turns off tracing code during calls to <procedure>\n")
+  (newline))
-- 
2.39.2