*** orig/lisp/cmuscheme.el
--- mod/lisp/cmuscheme.el
***************
*** 127,132 ****
--- 127,134 ----
  (define-key scheme-mode-map "\C-c\M-r" 'scheme-send-region-and-go)
  (define-key scheme-mode-map "\C-c\M-c" 'scheme-compile-definition)
  (define-key scheme-mode-map "\C-c\C-c" 'scheme-compile-definition-and-go)
+ (define-key scheme-mode-map "\C-c\C-t" 'scheme-trace-procedure)
+ (define-key scheme-mode-map "\C-c\C-x" 'scheme-expand-current-form)
  (define-key scheme-mode-map "\C-c\C-z" 'switch-to-scheme)
  (define-key scheme-mode-map "\C-c\C-l" 'scheme-load-file)
  (define-key scheme-mode-map "\C-c\C-k" 'scheme-compile-file) ;k for "kompile"
***************
*** 143,148 ****
--- 145,154 ----
      '("Compile Definition & Go" . scheme-compile-definition-and-go))
    (define-key map [com-def]
      '("Compile Definition" . scheme-compile-definition))
+   (define-key map [exp-form]
+     '("Expand current form" . scheme-expand-current-form))
+   (define-key map [trace-proc]
+     '("Trace procedure" . scheme-trace-procedure))
    (define-key map [send-def-go]
      '("Evaluate Last Definition & Go" . scheme-send-definition-and-go))
    (define-key map [send-def]
***************
*** 153,159 ****
      '("Evaluate Region" . scheme-send-region))
    (define-key map [send-sexp]
      '("Evaluate Last S-expression" . scheme-send-last-sexp))
! )
  
  (defvar scheme-buffer)
  
--- 159,165 ----
      '("Evaluate Region" . scheme-send-region))
    (define-key map [send-sexp]
      '("Evaluate Last S-expression" . scheme-send-last-sexp))
!   )
  
  (defvar scheme-buffer)
  
***************
*** 311,316 ****
--- 317,385 ----
       (beginning-of-defun)
       (scheme-compile-region (point) end))))
  
+ (defcustom scheme-trace-command "(trace %s)"
+   "*Template for issuing commands to trace a Scheme procedure.
+ Some Scheme implementations might require more elaborate commands here.
+ For PLT-Scheme, e.g., one should use
+ 
+    (setq scheme-trace-command \"(begin (require (lib \\\"trace.ss\\\")) (trace %s))\")
+ 
+ For Scheme 48 and Scsh use \",trace %s\"."
+   :type 'string
+   :group 'cmuscheme)
+ 
+ (defcustom scheme-untrace-command "(untrace %s)"
+   "*Template for switching off tracing of a Scheme procedure.
+ Scheme 48 and Scsh users should set this variable to \",untrace %s\"."
+ 
+   :type 'string
+   :group 'cmuscheme)
+ 
+ (defun scheme-trace-procedure (proc &optional untrace)
+   "Trace procedure PROC in the inferior Scheme process.
+ With a prefix argument switch off tracing of procedure PROC."
+   (interactive
+    (list (let ((current (symbol-at-point))
+                (action (if current-prefix-arg "Untrace" "Trace")))
+            (if current
+                (read-string (format "%s procedure [%s]: " action current) nil nil (symbol-name current))
+              (read-string (format "%s procedure: " action))))
+          current-prefix-arg))
+   (when (= (length proc) 0)
+     (error "Invalid procedure name"))
+   (comint-send-string (scheme-proc)
+                       (format 
+                        (if untrace scheme-untrace-command scheme-trace-command)
+                        proc))
+   (comint-send-string (scheme-proc) "\n"))
+ 
+ (defcustom scheme-macro-expand-command "(expand %s)"
+   "*Template for macro-expanding a Scheme form.
+ For Scheme 48 and Scsh use \",expand %s\"."
+   :type 'string
+   :group 'cmuscheme)
+ 
+ (defun scheme-expand-current-form ()
+   "Macro-expand the form at point in the inferior Scheme process."
+   (interactive)
+   (let ((current-form (scheme-form-at-point)))
+     (if current-form
+         (progn
+           (comint-send-string (scheme-proc)
+                               (format 
+                                scheme-macro-expand-command
+                                current-form))
+           (comint-send-string (scheme-proc) "\n"))      
+       (error "Not at a form"))))
+ 
+ (defun scheme-form-at-point ()
+   (let ((next-sexp (thing-at-point 'sexp)))
+     (if (and next-sexp (string-equal (substring next-sexp 0 1) "("))
+         next-sexp
+       (save-excursion
+         (backward-up-list)
+         (scheme-form-at-point)))))
+ 
  (defun switch-to-scheme (eob-p)
    "Switch to the scheme process buffer.
  With argument, position cursor at end of buffer."