[PATCH] Single stepping through code from Emacs

[Neil Jerram]

Here is a minor enhancement to Guile's Emacs support.  I'll commit in
a few days; let me know if you have any comments before that.

      Neil

When you use GDS to evaluate Scheme code from Emacs, you can now use
`C-u' to indicate that you want to single step through that code. See
`Evaluating Scheme Code' in the manual for more details.

        * scheme-using.texi (Evaluating Scheme Code): Document use of
        `C-u' prefix with evaluation commands.

        * gds-scheme.el (gds-eval-region, gds-eval-expression)
        (gds-eval-defun, gds-eval-last-sexp): Support `C-u' prefix,
        meaning that user wants to single step through the code.

        * gds-client.scm (handle-nondebug-protocol): Add support for
        setting a trap on code that is about to be evaluated.
---
 NEWS                      |    6 ++++++
 doc/ref/scheme-using.texi |    8 ++++++++
 emacs/gds-scheme.el       |   28 +++++++++++++++-------------
 ice-9/gds-client.scm      |   10 ++++++++--
 4 files changed, 37 insertions(+), 15 deletions(-)

diff --git a/NEWS b/NEWS
index 2c93494..b12cbbc 100644
--- a/NEWS
+++ b/NEWS
@@ -11,6 +11,12 @@ Changes in 1.8.6 (since 1.8.5)

 ** New convenience function `scm_c_symbol_length ()'

+** Single stepping through code from Emacs
+
+When you use GDS to evaluate Scheme code from Emacs, you can now use
+`C-u' to indicate that you want to single step through that code. See
+`Evaluating Scheme Code' in the manual for more details.
+
 * Bugs fixed

 ** Internal `scm_i_' functions now have "hidden" linkage with GCC/ELF
diff --git a/doc/ref/scheme-using.texi b/doc/ref/scheme-using.texi
index 59cc0e6..a8a2568 100644
--- a/doc/ref/scheme-using.texi
+++ b/doc/ref/scheme-using.texi
@@ -842,6 +842,14 @@ region contains a balanced expression, or try to
expand the region so
 that it does; it uses the region exactly as it is.
 @end table

+If you type @kbd{C-u} before one of these commands, GDS will
+immediately pop up a Scheme stack buffer, showing the requested
+evaluation, so that you can single step through it.  (This is achieved
+by setting a @code{<source-trap>} trap at the start of the requested
+evaluation; see @ref{Source Traps} for more on how those work.)  The
+Scheme stack display, and the options for continuing through the code,
+are described in the next two sections.
+

 @node Displaying the Scheme Stack
 @subsection Displaying the Scheme Stack
diff --git a/emacs/gds-scheme.el b/emacs/gds-scheme.el
index bc3a20b..ed3874f 100755
--- a/emacs/gds-scheme.el
+++ b/emacs/gds-scheme.el
@@ -279,7 +279,7 @@ region's code."
       (setq line (count-lines (point-min) (point))))
     (cons line column)))

-(defun gds-eval-region (start end)
+(defun gds-eval-region (start end &optional debugp)
   "Evaluate the current region."
   (interactive "r")
   (or gds-client
@@ -289,24 +289,26 @@ region's code."
        (port-name (gds-port-name start end))
        (lc (gds-line-and-column start)))
     (let ((code (buffer-substring-no-properties start end)))
-      (gds-send (format "eval (region . %S) %s %S %d %d %S"
+      (gds-send (format "eval (region . %S) %s %S %d %d %S %s"
                        (gds-abbreviated code)
                        (if module (prin1-to-string module) "#f")
                        port-name (car lc) (cdr lc)
-                       code)
+                       code
+                       (if debugp '(debug) '(none)))
                gds-client))))

-(defun gds-eval-expression (expr &optional correlator)
+(defun gds-eval-expression (expr &optional correlator debugp)
   "Evaluate the supplied EXPR (a string)."
-  (interactive "sEvaluate expression: \nP")
+  (interactive "sEvaluate expression: \ni\nP")
   (or gds-client
       (gds-auto-associate-buffer)
       (call-interactively 'gds-associate-buffer))
   (set-text-properties 0 (length expr) nil expr)
-  (gds-send (format "eval (%S . %S) #f \"Emacs expression\" 0 0 %S"
+  (gds-send (format "eval (%S . %S) #f \"Emacs expression\" 0 0 %S %s"
                    (or correlator 'expression)
                    (gds-abbreviated expr)
-                   expr)
+                   expr
+                   (if debugp '(debug) '(none)))
            gds-client))

 (defconst gds-abbreviated-length 35)
@@ -325,19 +327,19 @@ region's code."
       (concat (substring code 0 (- gds-abbreviated-length 3)) "...")
     code))

-(defun gds-eval-defun ()
+(defun gds-eval-defun (&optional debugp)
   "Evaluate the defun (top-level form) at point."
-  (interactive)
+  (interactive "P")
   (save-excursion
    (end-of-defun)
    (let ((end (point)))
      (beginning-of-defun)
-     (gds-eval-region (point) end))))
+     (gds-eval-region (point) end debugp))))

-(defun gds-eval-last-sexp ()
+(defun gds-eval-last-sexp (&optional debugp)
   "Evaluate the sexp before point."
-  (interactive)
-  (gds-eval-region (save-excursion (backward-sexp) (point)) (point)))
+  (interactive "P")
+  (gds-eval-region (save-excursion (backward-sexp) (point)) (point) debugp))

 ;;;; Help.

diff --git a/ice-9/gds-client.scm b/ice-9/gds-client.scm
index 4db4f82..960015a 100755
--- a/ice-9/gds-client.scm
+++ b/ice-9/gds-client.scm
@@ -352,7 +352,7 @@ Thanks!\n\n"

     ((eval)
      (set! last-lazy-trap-context #f)
-     (apply (lambda (correlator module port-name line column code)
+     (apply (lambda (correlator module port-name line column code flags)
               (with-input-from-string code
                 (lambda ()
                   (set-port-filename! (current-input-port) port-name)
@@ -380,7 +380,13 @@ Thanks!\n\n"
                                            (+ n 1))))
                               ;; Another complete expression read; add
                               ;; it to the list.
-                             (loop (cons x exprs) (read)))))
+                             (begin
+                               (if (and (pair? x)
+                                        (memq 'debug flags))
+                                   (install-trap (make <source-trap>
+                                                   #:expression x
+                                                   #:behaviour 
gds-debug-trap)))
+                               (loop (cons x exprs) (read))))))
                       (lambda (key . args)
                         (write-form `(eval-results
                                       ,correlator
-- 
1.4.4.4