Work (in progress) on new debugging frontend.

emacs/gds.el

@@ -0,0 +1,748 @@
+;;; gds.el -- Guile debugging frontend
+
+;;;; Copyright (C) 2003 Free Software Foundation, Inc.
+;;;;
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 2.1 of the License, or (at your option) any later
+;;;; version.
+;;;; 
+;;;; This library 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
+;;;; Lesser General Public License for more details.
+;;;; 
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free
+;;;; Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
+;;;; 02111-1307 USA
+
+
+;;;; Prerequisites.
+
+(require 'widget)
+(require 'wid-edit)
+
+
+;;;; Debugging (of this code!).
+
+(defsubst dmessage (msg &rest args)
+  ;;(apply (function message) msg args)
+  )
+
+
+;;;; Customization group setup.
+
+(defgroup gds nil
+  "Customization options for Guile Debugging."
+  :group 'scheme)
+
+
+;;;; Communication with the (ice-9 debugger ui-server) subprocess.
+
+;; The subprocess object.
+(defvar gds-process nil)
+
+;; Subprocess output goes into the `*GDS Process*' buffer, and
+;; is then read from there one form at a time.  `gds-read-cursor' is
+;; the buffer position of the start of the next unread form.
+(defvar gds-read-cursor nil)
+
+;; Start (or restart) the subprocess.
+(defun gds-start ()
+  (if gds-process (gds-shutdown))
+  (with-current-buffer (get-buffer-create "*GDS Process*")
+    (erase-buffer)
+    (setq gds-process
+	  (let ((process-connection-type nil)) ; use a pipe
+	    (start-process "gds"
+			   (current-buffer)
+			   "guile"
+			   "-q"
+			   "--debug"
+			   "-e"
+			   "run"
+			   "-s"
+			   "/home/neil/Guile/cvs/guile-core/ice-9/debugger/ui-server.scm"))))
+  (setq gds-read-cursor (point-min))
+  (set-process-filter gds-process (function gds-filter))
+  (set-process-sentinel gds-process (function gds-sentinel))
+  (set-process-coding-system gds-process 'latin-1-unix))
+
+;; Shutdown the subprocess and cleanup all associated data.
+(defun gds-shutdown ()
+  ;; Do cleanup for all clients.
+  (while gds-names
+    (gds-client-cleanup (caar gds-names)))
+  ;; Reset any remaining variables.
+  (setq gds-displayed-client nil
+	gds-waiting nil)
+  ;; If the timer is running, cancel it.
+  (if gds-timer
+      (cancel-timer gds-timer))
+  (setq gds-timer nil)
+  ;; Kill the subprocess.
+  (process-kill-without-query gds-process)
+  (condition-case nil
+      (progn
+	(kill-process gds-process)
+	(accept-process-output gds-process 0 200))
+    (error))
+  (setq gds-process nil))
+
+;; Subprocess output filter: inserts normally into the process buffer,
+;; then tries to reread the output one form at a time and delegates
+;; processing of each form to `gds-handle-input'.
+(defun gds-filter (proc string)
+  (with-current-buffer (process-buffer proc)
+    (save-excursion
+      (goto-char (process-mark proc))
+      (insert-before-markers string))
+    (goto-char gds-read-cursor)
+    (while (let ((form (condition-case nil
+			   (read (current-buffer))
+			 (error nil))))
+	     (if form
+		 (save-excursion
+		   (gds-handle-input form)))
+	     form)
+      (setq gds-read-cursor (point)))))
+
+;; Subprocess sentinel: do nothing.  (Currently just here to avoid
+;; inserting un-`read'able process status messages into the process
+;; buffer.)
+(defun gds-sentinel (proc event)
+  )
+
+;; Send input to the subprocess.
+(defun gds-send (string)
+  (process-send-string gds-process string))
+
+
+;;;; Multiple application scheduling.
+
+;; At any moment one Guile application has the focus of the frontend
+;; code.  `gds-displayed-client' holds the port number of that client.
+;; If there are no Guile applications wanting the focus - that is,
+;; ready for debugging instructions - `gds-displayed-client' is nil.
+(defvar gds-displayed-client nil)
+
+;; The list of other Guile applications waiting for focus, referenced
+;; by their port numbers.
+(defvar gds-waiting nil)
+
+;; An idle timer that we use to avoid confusing any user work when
+;; popping up debug buffers.  `gds-timer' is non-nil whenever the
+;; timer is running and nil whenever it is not running.
+(defvar gds-timer nil)
+
+;; Debug the specified client.  If it already has the focus, do so
+;; immediately, but using the idle timer to ensure that it doesn't
+;; confuse any work the user may be doing.  Non-structural work is
+;; delegated to `gds-display-state'.
+(defun gds-debug (&optional client)
+  (dmessage "gds-debug")
+  ;; If `client' is specified, add it to the end of `gds-waiting',
+  ;; unless that client is already the current client or it is already
+  ;; in the waiting list.
+  (if (and client
+	   (not (eq client gds-displayed-client))
+	   (not (memq client gds-waiting)))
+      (setq gds-waiting (append gds-waiting (list client))))
+  ;; Now update `client' to be the next client in the list.
+  (setq client (or gds-displayed-client (car gds-waiting)))
+  ;; If conditions are right, start the idle timer.
+  (if (and client
+	   (or (null gds-displayed-client)
+	       (eq gds-displayed-client client)))
+      (gds-display-state (or gds-displayed-client
+			     (prog1 (car gds-waiting)
+			       (setq gds-waiting
+				     (cdr gds-waiting)))))))
+
+;; Give up focus because debugging is done for now.  Display detail in
+;; case of no waiting clients is delegated to `gds-clear-display'.
+(defun gds-focus-done ()
+  (gds-clear-display)
+  (gds-debug))
+
+;; Although debugging of this client isn't done, yield focus to the
+;; next waiting client.
+(defun gds-focus-yield ()
+  (interactive)
+  (if (and (null gds-waiting)
+	   (y-or-n-p "No other clients waiting - bury *Guile Debug* buffer? "))
+      (bury-buffer)
+    (or (memq gds-displayed-client gds-waiting)
+	(setq gds-waiting (append gds-waiting (list gds-displayed-client))))
+    (gds-focus-done)))
+
+
+;;;; Per-client state information.
+
+;; Alist mapping client port numbers to application names.  The names
+;; in this list have been uniquified by `gds-uniquify'.
+(defvar gds-names nil)
+
+;; Return unique form of NAME.
+(defun gds-uniquify (name)
+  (let ((count 1)
+	(maybe-unique name))
+    (while (member maybe-unique (mapcar (function cdr) gds-names))
+      (setq count (1+ count)
+	    maybe-unique (concat name "<" (number-to-string count) ">")))
+    maybe-unique))
+
+;; Alist mapping client port numbers to last known status.
+;;
+;; Status is one of the following symbols.
+;;
+;;   `running' - application is running.
+;;
+;;   `waiting-for-input' - application is blocked waiting for
+;;   instruction from the frontend.
+;;
+;;   `ready-for-input' - application is not blocked but can also
+;;   accept asynchronous instructions from the frontend.
+;;
+(defvar gds-statuses nil)
+
+;; Alist mapping client port numbers to last printed outputs.
+(defvar gds-outputs nil)
+
+;; Alist mapping client port numbers to last known stacks.
+(defvar gds-stacks nil)
+
+;; Alist mapping client port numbers to module information.  This
+;; looks like:
+;;
+;; ((4 ((guile) t sym1 sym2 ...) ((guile-user)) ((ice-9 debug) nil sym3 sym4) ...) ...)
+;;
+;; So, for example:
+;;
+;; (assq client gds-modules)
+;; =>
+;; (4 ((guile) t sym1 sym2 ...) ((guile-user)) ((ice-9 debug) nil sym3 sym4) ...)
+;;
+;; The t or nil after the module name indicates whether the module is
+;; displayed in expanded form (that is, showing the bindings in that
+;; module).
+;;
+;; The syms are actually all strings, because some Guile symbols are
+;; not readable by Emacs.
+(defvar gds-modules nil)
+
+
+;;;; Handling debugging instructions.
+
+;; General dispatch function called by the subprocess filter.
+(defun gds-handle-input (form)
+  (dmessage "Form: %S" form)
+  (let ((client (car form)))
+    (cond ((eq client '*))
+	  (t
+	   (let ((proc (cadr form)))
+
+	     (cond ((eq proc 'name)
+		    ;; (name ...) - Application's name.
+		    (setq gds-names
+			  (cons (cons client (gds-uniquify (caddr form)))
+				gds-names)))
+
+		   ((eq proc 'stack)
+		    ;; (stack ...) - Stack at an error or breakpoint.
+		    (gds-set gds-stacks client (cddr form)))
+
+		   ((eq proc 'modules)
+		    ;; (modules ...) - Application's loaded modules.
+		    (gds-set gds-modules client
+			     (mapcar (function list) (cddr form))))
+
+		   ((eq proc 'output)
+		    ;; (output ...) - Last printed output.
+		    (gds-set gds-outputs client (caddr form)))
+
+		   ((eq proc 'status)
+		    ;; (status ...) - Application status indication.
+		    (let ((status (caddr form)))
+		      (gds-set gds-statuses client status)
+		      (cond ((eq status 'waiting-for-input)
+			     (gds-debug client))
+			    ((eq status 'running)
+			     (if (eq client gds-displayed-client)
+				 (gds-display-state client)))
+			    (t
+			     (error "Unexpected status: %S" status)))))
+
+		   ((eq proc 'module)
+		    ;; (module MODULE ...) - The specified module's bindings.
+		    (let* ((modules (assq client gds-modules))
+			   (minfo (assoc (caddr form) modules)))
+		      (if minfo
+			  (setcdr (cdr minfo) (cdddr form)))))
+
+		   ((eq proc 'closed)
+		    ;; (closed) - Client has gone away.
+		    (gds-client-cleanup client))
+
+		   ))))))
+
+;; Store latest status, stack or module list for the specified client.
+(defmacro gds-set (alist client val)
+  `(let ((existing (assq ,client ,alist)))
+     (if existing
+	 (setcdr existing ,val)
+       (setq ,alist
+	     (cons (cons client ,val) ,alist)))))
+
+;; Cleanup processing when CLIENT goes away.
+(defun gds-client-cleanup (client)
+  (if (eq client gds-displayed-client)
+      (gds-focus-done))
+  (setq gds-names
+	(delq (assq client gds-names) gds-names))
+  (setq gds-stacks
+	(delq (assq client gds-stacks) gds-stacks))
+  (setq gds-modules
+	(delq (assq client gds-modules) gds-modules)))
+
+
+;;;; Displaying debugging information.
+
+(defvar gds-client-buffer nil)
+
+(define-derived-mode gds-mode
+  fundamental-mode
+  "Guile Debugging"
+  "Major mode for Guile debugging information buffers.")
+
+(defun gds-set-client-buffer (&optional client)
+  (if (and gds-client-buffer
+	   (buffer-live-p gds-client-buffer))
+      (set-buffer gds-client-buffer)
+    (setq gds-client-buffer (get-buffer-create "*Guile Debug*"))
+    (set-buffer gds-client-buffer)
+    (gds-mode))
+  ;; Rename to something we don't want first.  Otherwise, if the
+  ;; buffer is already correctly named, we get a confusing change
+  ;; from, say, `*Guile Debug: REPL*' to `*Guile Debug: REPL*<2>'.
+  (rename-buffer "*Guile Debug Fake Buffer Name*" t)
+  (rename-buffer (if client
+		     (concat "*Guile Debug: "
+			     (cdr (assq client gds-names))
+			     "*")
+		   "*Guile Debug*")
+		 t)			; Rename uniquely if needed,
+					; although it shouldn't be.
+  (force-mode-line-update t))
+
+(defun gds-clear-display ()
+  ;; Clear the client buffer.
+  (gds-set-client-buffer)
+  (let ((inhibit-read-only t))
+    (erase-buffer)
+    (insert "Stack:\nNo clients ready for debugging.\n")
+    (goto-char (point-min)))
+  (setq gds-displayed-stack 'no-clients)
+  (setq gds-displayed-modules nil)
+  (setq gds-displayed-client nil)
+  (bury-buffer))
+
+;; Determine whether the client display buffer is visible in the
+;; currently selected frame (i.e. where the user is editing).
+(defun gds-buffer-visible-in-selected-frame-p ()
+  (let ((visible-p nil))
+    (walk-windows (lambda (w)
+		    (if (eq (window-buffer w) gds-client-buffer)
+			(setq visible-p t))))
+    visible-p))
+
+;; Cached display variables for `gds-display-state'.
+(defvar gds-displayed-stack nil)
+(defvar gds-displayed-modules nil)
+
+;; Types of display areas in the *Guile Debug* buffer.
+(defvar gds-display-types '("Status" "Stack" "Modules"))
+(defvar gds-display-type-regexp
+  (concat "^\\("
+	  (substring (apply (function concat)
+			    (mapcar (lambda (type)
+				      (concat "\\|" type))
+				    gds-display-types))
+		     2)
+	  "\\):"))
+
+(defun gds-maybe-delete-region (type)
+  (let ((beg (save-excursion
+	       (goto-char (point-min))
+	       (and (re-search-forward (concat "^"
+					       (regexp-quote type)
+					       ":")
+				       nil t)
+		    (match-beginning 0)))))
+    (if beg
+	(delete-region beg
+		       (save-excursion
+			 (goto-char beg)
+			 (end-of-line)
+			 (or (and (re-search-forward gds-display-type-regexp
+						     nil t)
+				  (match-beginning 0))
+			     (point-max)))))))
+
+(defun gds-maybe-skip-region (type)
+  (if (looking-at (regexp-quote type))
+      (if (re-search-forward gds-display-type-regexp nil t 2)
+	  (beginning-of-line)
+	(goto-char (point-max)))))
+
+(defun gds-display-state (client)
+  (dmessage "gds-display-state")
+  ;; Avoid continually popping up the last associated source buffer
+  ;; unless it really is still current.
+  (setq gds-selected-frame-source-buffer nil)
+  (gds-set-client-buffer client)
+  (let ((stack (cdr (assq client gds-stacks)))
+	(modules (cdr (assq client gds-modules)))
+	(inhibit-read-only t)
+	(p (if (eq client gds-displayed-client)
+	       (point)
+	     (point-min)))
+	stack-changed)
+    ;; Start at top of buffer.
+    (goto-char (point-min))
+    ;; Display status; too simple to be worth caching.
+    (gds-maybe-delete-region "Status")
+    (widget-insert "Status: "
+		   (cdr (assq (cdr (assq client gds-statuses))
+			      '((running . "running")
+				(waiting-for-input . "waiting for input")
+				(ready-for-input . "ready for input"))))
+		   "\n\n")
+    (let ((output (cdr (assq client gds-outputs))))
+      (if (> (length output) 0)
+	  (widget-insert output "\n\n")))
+    ;; Display stack.
+    (dmessage "insert stack")
+    (if (equal stack gds-displayed-stack)
+	(gds-maybe-skip-region "Stack")
+      ;; Note that stack has changed.
+      (if stack (setq stack-changed t))
+      ;; Delete existing stack.
+      (gds-maybe-delete-region "Stack")
+      ;; Insert new stack.		       
+      (if stack (gds-insert-stack stack))
+      ;; Record displayed stack.
+      (setq gds-displayed-stack stack))
+    ;; Display module list.
+    (dmessage "insert modules")
+    (if (equal modules gds-displayed-modules)
+	(gds-maybe-skip-region "Modules")
+      ;; Delete existing module list.
+      (gds-maybe-delete-region "Modules")
+      ;; Insert new list.
+      (if modules (gds-insert-modules modules))
+      ;; Record displayed list.
+      (setq gds-displayed-modules (copy-tree modules)))
+    ;; Finish off.
+    (dmessage "widget-setup")
+    (widget-setup)
+    (if stack-changed
+	;; Stack is being seen for the first time, so make sure top of
+	;; buffer is visible.
+	(progn
+	  (goto-char (point-min))
+	  (re-search-forward "^Stack:")
+	  (forward-line (+ 1 (cadr stack))))
+      ;; Restore point from before buffer was redrawn.
+      (goto-char p)))
+  (setq gds-displayed-client client)
+  (dmessage "consider display")
+  (if (eq (window-buffer (selected-window)) gds-client-buffer)
+      ;; *Guile Debug* buffer already selected.
+      (gds-display-buffers)
+    (dmessage "Running GDS timer")
+    (setq gds-timer
+	  (run-with-idle-timer 0.5
+			       nil
+			       (lambda ()
+				 (setq gds-timer nil)
+				 (gds-display-buffers))))))
+
+(defun gds-display-buffers ()
+  ;; If there's already a window showing the *Guile Debug* buffer, use
+  ;; it.
+  (let ((window (get-buffer-window gds-client-buffer t)))
+    (if window
+	(progn
+	  (make-frame-visible (window-frame window))
+	  (raise-frame (window-frame window))
+	  (select-frame (window-frame window))
+	  (select-window window))
+      (switch-to-buffer gds-client-buffer)))
+  ;; If there is an associated source buffer, display it as well.
+  (if gds-selected-frame-source-buffer
+      (let ((window (display-buffer gds-selected-frame-source-buffer)))
+	(set-window-point window
+			  (overlay-start gds-selected-frame-source-overlay))))
+  ;; Force redisplay.
+  (sit-for 0))
+
+(defun old-stuff ()
+  (if (gds-buffer-visible-in-selected-frame-p)
+      ;; Buffer already visible enough.
+      nil
+    ;; Delete any views of the buffer in other frames - we don't want
+    ;; views all over the place.
+    (delete-windows-on gds-client-buffer)
+    ;; Run idle timer to display the buffer as soon as user isn't in
+    ;; the middle of something else.
+    ))
+
+(defun gds-insert-stack (stack)
+  (let ((frames (car stack))
+	(index (cadr stack))
+	(flags (caddr stack))
+	frame items)
+    (widget-insert "Stack: " (prin1-to-string flags) "\n")
+    (let ((i -1))
+      (gds-show-selected-frame (caddr (nth index frames)))
+      (while frames
+	(setq frame (car frames)
+	      frames (cdr frames)
+	      i (+ i 1)
+	      items (cons (list 'item
+				(let ((s (cadr frame)))
+				  (put-text-property 0 1 'index i s)
+				  s))
+			  items))))
+    (setq items (nreverse items))
+    (apply (function widget-create)
+	     'radio-button-choice
+	     :value (cadr (nth index items))
+	     :notify (function gds-select-stack-frame)
+	     items)
+    (widget-insert "\n")))
+
+(defun gds-select-stack-frame (widget &rest ignored)
+  (let* ((s (widget-value widget))
+	 (ind (memq 'index (text-properties-at 0 s))))
+    (gds-send (format "(%S debugger-command frame %d)\n"
+		      gds-displayed-client
+		      (cadr ind)))))
+
+;; Overlay used to highlight the source expression corresponding to
+;; the selected frame.
+(defvar gds-selected-frame-source-overlay nil)
+
+;; Buffer containing source for the selected frame.
+(defvar gds-selected-frame-source-buffer nil)
+
+(defun gds-show-selected-frame (source)
+  ;; Highlight the frame source, if possible.
+  (if (and source
+	   (file-readable-p (car source)))
+      (with-current-buffer (find-file-noselect (car source))
+	(if gds-selected-frame-source-overlay
+	    nil
+	  (setq gds-selected-frame-source-overlay (make-overlay 0 0))
+	  (overlay-put gds-selected-frame-source-overlay 'face 'highlight))
+	;; Move to source line.  Note that Guile line numbering is
+	;; 0-based, while Emacs numbering is 1-based.
+	(save-restriction
+	  (widen)
+	  (goto-line (+ (cadr source) 1))
+	  (move-to-column (caddr source))
+	  (move-overlay gds-selected-frame-source-overlay
+			(point)
+			(if (not (looking-at ")"))
+			    (save-excursion (forward-sexp 1) (point))
+			  ;; It seems that the source coordinates for
+			  ;; backquoted expressions are at the end of
+			  ;; the sexp rather than the beginning...
+			  (save-excursion (forward-char 1)
+					  (backward-sexp 1) (point)))
+			(current-buffer)))
+	(setq gds-selected-frame-source-buffer (current-buffer)))
+    (if gds-selected-frame-source-overlay
+	(move-overlay gds-selected-frame-source-overlay 0 0))))
+
+(defcustom gds-module-filter '(t (guile nil) (ice-9 nil) (oop nil))
+  "Specification of which Guile modules the debugger should display.
+This is a list with structure (DEFAULT EXCEPTION EXCEPTION...), where
+DEFAULT is `t' or `nil' and each EXCEPTION has the structure (SYMBOL
+DEFAULT EXCEPTION EXCEPTION...).
+
+A Guile module name `(x y z)' is matched against this filter as
+follows.  If one of the top level EXCEPTIONs has SYMBOL `x', continue
+by matching the rest of the module name, in this case `(y z)', against
+that SYMBOL's DEFAULT and next level EXCEPTION list.  Otherwise, if
+the current DEFAULT is `t' display the module, and if the current
+DEFAULT is `nil', don't display it.
+
+This variable is usually set to exclude Guile system modules that are
+not of primary interest when debugging application code."
+  :type 'sexp
+  :group 'gds)
+
+(defun gds-show-module-p (name)
+  ;; Determine whether to display the NAMEd module by matching NAME
+  ;; against `gds-module-filter'.
+  (let ((default (car gds-module-filter))
+	(exceptions (cdr gds-module-filter)))
+    (let ((exception (assq (car name) exceptions)))
+      (if exception
+	  (let ((gds-module-filter (cdr exception)))
+	    (gds-show-module-p (cdr name)))
+	default))))
+
+(defun gds-insert-modules (modules)
+  (insert "Modules:\n")
+  (while modules
+    (let ((minfo (car modules)))
+      (if (gds-show-module-p (car minfo))
+	  (let ((w (widget-create 'push-button
+				  :notify (function gds-module-notify)
+				  (if (and (cdr minfo)
+					   (cadr minfo))
+				      "-" "+"))))
+	    (widget-put w :module (cons client (car minfo)))
+	    (widget-insert " " (prin1-to-string (car minfo)) "\n")
+	    (if (cadr minfo)
+		(let ((syms (cddr minfo)))
+		  (while syms
+		    (widget-insert " > " (car syms) "\n")
+		    (setq syms (cdr syms))))))))
+    (setq modules (cdr modules))))
+
+(defun gds-module-notify (w &rest ignore)
+  (let* ((module (widget-get w :module))
+	 (client (car module))
+	 (name (cdr module))
+	 (modules (assq client gds-modules))
+	 (minfo (assoc name modules)))
+    (if (cdr minfo)
+	;; Just toggle expansion state.
+	(progn
+	  (setcar (cdr minfo) (not (cadr minfo)))
+	  (gds-display-state client))
+      ;; Set flag to indicate module expanded.
+      (setcdr minfo (list t))
+      ;; Get symlist from Guile.
+      (gds-send (format "(%S query-module %S)\n" client name)))))
+
+
+;;;; Guile Debugging keymap.
+
+(set-keymap-parent gds-mode-map widget-keymap)
+(define-key gds-mode-map "g" (function gds-go))
+(define-key gds-mode-map "b" (function gds-set-breakpoint))
+(define-key gds-mode-map "q" (function gds-quit))
+(define-key gds-mode-map "y" (function gds-yield))
+(define-key gds-mode-map " " (function gds-next))
+(define-key gds-mode-map "e" (function gds-evaluate))
+(define-key gds-mode-map "i" (function gds-step-in))
+(define-key gds-mode-map "o" (function gds-step-out))
+(define-key gds-mode-map "t" (function gds-trace-finish))
+
+(defun gds-client-waiting ()
+  (eq (cdr (assq gds-displayed-client gds-statuses)) 'waiting-for-input))
+
+(defun gds-go ()
+  (interactive)
+  (gds-send (format "(%S debugger-command continue)\n" gds-displayed-client)))
+
+(defun gds-quit ()
+  (interactive)
+  (if (gds-client-waiting)
+      (if (y-or-n-p "Client is waiting for instruction - tell it to continue? ")
+	  (gds-go)))
+  (gds-yield))
+
+(defun gds-yield ()
+  (interactive)
+  (if (gds-client-waiting)
+      (gds-focus-yield)
+    (gds-focus-done)))
+
+(defun gds-next ()
+  (interactive)
+  (gds-send (format "(%S debugger-command next 1)\n" gds-displayed-client)))
+
+(defun gds-evaluate (expr)
+  (interactive "sEvaluate (in this stack frame): ")
+  (gds-send (format "(%S debugger-command evaluate %s)\n"
+		    gds-displayed-client
+		    (prin1-to-string expr))))
+
+(defun gds-step-in ()
+  (interactive)
+  (gds-send (format "(%S debugger-command step 1)\n" gds-displayed-client)))
+
+(defun gds-step-out ()
+  (interactive)
+  (gds-send (format "(%S debugger-command finish)\n" gds-displayed-client)))
+
+(defun gds-trace-finish ()
+  (interactive)
+  (gds-send (format "(%S debugger-command trace-finish)\n"
+		    gds-displayed-client)))
+
+(defun gds-set-breakpoint ()
+  (interactive)
+  (cond ((gds-in-source-buffer)
+	 (gds-set-source-breakpoint))
+	((gds-in-stack)
+	 (gds-set-stack-breakpoint))
+	((gds-in-modules)
+	 (gds-set-module-breakpoint))
+	(t
+	 (error "No way to set a breakpoint from here"))))
+
+(defun gds-in-source-buffer ()
+  ;; Not yet worked out what will be available in Scheme source
+  ;; buffers.
+  nil)
+
+(defun gds-in-stack ()
+  (and (eq (current-buffer) gds-client-buffer)
+       (save-excursion
+	 (and (re-search-backward "^\\(Stack\\|Modules\\):" nil t)
+	      (looking-at "Stack")))))
+
+(defun gds-in-modules ()
+  (and (eq (current-buffer) gds-client-buffer)
+       (save-excursion
+	 (and (re-search-backward "^\\(Stack\\|Modules\\):" nil t)
+	      (looking-at "Modules")))))
+
+(defun gds-set-module-breakpoint ()
+  (let ((sym (save-excursion
+	       (beginning-of-line)
+	       (and (looking-at " > \\([^ \n\t]+\\)")
+		    (match-string 1))))
+	(module (save-excursion
+		  (and (re-search-backward "^\\[[+---]\\] \\(([^)]+)\\)" nil t)
+		       (match-string 1)))))
+    (or sym
+	(error "Couldn't find procedure name on current line"))
+    (or module
+	(error "Couldn't find module name for current line"))
+    (let ((behaviour
+	   (completing-read
+	    (format "Behaviour for breakpoint at %s:%s (default debug-here): "
+		    module sym)
+	    '(("debug-here")
+	      ("trace-here")
+	      ("trace-subtree"))
+	    nil
+	    t
+	    nil
+	    nil
+	    "debug-here")))
+      (gds-send (format "(%S set-breakpoint %s %s %s)\n"
+			gds-displayed-client
+			module
+			sym
+			behaviour)))))