emacs/gds.el

   1 ;;; gds.el -- frontend for Guile development in Emacs
   2
   3 ;;;; Copyright (C) 2003, 2004 Free Software Foundation, Inc.
   4 ;;;;
   5 ;;;; This library is free software; you can redistribute it and/or
   6 ;;;; modify it under the terms of the GNU Lesser General Public
   7 ;;;; License as published by the Free Software Foundation; either
   8 ;;;; version 3 of the License, or (at your option) any later version.
   9 ;;;;
  10 ;;;; This library is distributed in the hope that it will be useful,
  11 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  12 ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  13 ;;;; Lesser General Public License for more details.
  14 ;;;;
  15 ;;;; You should have received a copy of the GNU Lesser General Public
  16 ;;;; License along with this library; if not, write to the Free
  17 ;;;; Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
  18 ;;;; 02111-1307 USA
  19
  20 ; TODO:
  21 ; ?transcript
  22 ; scheme-mode menu
  23 ; interrupt/sigint/async-break
  24 ; (module browsing)
  25 ; load file
  26 ; doing common protocol from debugger
  27 ; thread override for debugging
  28
  29 ;;;; Prerequisites.
  30
  31 (require 'scheme)
  32 (require 'cl)
  33 (require 'gds-server)
  34 (require 'gds-scheme)
  35
  36 ;; The subprocess object for the debug server.
  37 (defvar gds-debug-server nil)
  38
  39 (defvar gds-unix-socket-name (format "/tmp/.gds-socket-%d" (emacs-pid))
  40   "Name of the Unix domain socket that GDS will listen on.")
  41
  42 (defvar gds-tcp-port 8333
  43   "The TCP port number that GDS will listen on.")
  44
  45 (defun gds-run-debug-server ()
  46   "Start (or restart, if already running) the GDS debug server process."
  47   (interactive)
  48   (if gds-debug-server (gds-kill-debug-server))
  49   (setq gds-debug-server
  50         (gds-start-server "gds-debug"
  51                           gds-unix-socket-name
  52                           gds-tcp-port
  53                           'gds-debug-protocol))
  54   (process-kill-without-query gds-debug-server)
  55   ;; Add the Unix socket name to the environment, so that Guile
  56   ;; clients started from within this Emacs will be able to use it,
  57   ;; and thereby ensure that they connect to the GDS in this Emacs.
  58   (setenv "GDS_UNIX_SOCKET_NAME" gds-unix-socket-name))
  59
  60 (defun gds-kill-debug-server ()
  61   "Kill the GDS debug server process."
  62   (interactive)
  63   (mapcar (function gds-client-gone)
  64           (mapcar (function car) gds-client-info))
  65   (condition-case nil
  66       (progn
  67         (kill-process gds-debug-server)
  68         (accept-process-output gds-debug-server 0 200))
  69     (error))
  70   (setq gds-debug-server nil))
  71
  72 ;; Send input to the subprocess.
  73 (defun gds-send (string client)
  74   (with-current-buffer (get-buffer-create "*GDS Transcript*")
  75     (goto-char (point-max))
  76     (insert (number-to-string client) ": (" string ")\n"))
  77   (gds-client-put client 'thread-id nil)
  78   (gds-show-client-status client gds-running-text)
  79   (process-send-string gds-debug-server (format "(%S %s)\n" client string)))
  80
  81
  82 ;;;; Per-client information
  83
  84 (defun gds-client-put (client property value)
  85   (let ((client-info (assq client gds-client-info)))
  86     (if client-info
  87         (let ((prop-info (memq property client-info)))
  88           (if prop-info
  89               (setcar (cdr prop-info) value)
  90             (setcdr client-info
  91                     (list* property value (cdr client-info)))))
  92       (setq gds-client-info
  93             (cons (list client property value) gds-client-info)))))
  94
  95 (defun gds-client-get (client property)
  96   (let ((client-info (assq client gds-client-info)))
  97     (and client-info
  98          (cadr (memq property client-info)))))
  99
 100 (defvar gds-client-info '())
 101
 102 (defun gds-get-client-buffer (client)
 103   (let ((existing-buffer (gds-client-get client 'stack-buffer)))
 104     (if (and existing-buffer
 105              (buffer-live-p existing-buffer))
 106         existing-buffer
 107       (let ((new-buffer (generate-new-buffer (gds-client-get client 'name))))
 108         (with-current-buffer new-buffer
 109           (gds-debug-mode)
 110           (setq gds-client client)
 111           (setq gds-stack nil))
 112         (gds-client-put client 'stack-buffer new-buffer)
 113         new-buffer))))
 114
 115 (defun gds-client-gone (client &rest ignored)
 116   ;; Kill the client's stack buffer, if it has one.
 117   (let ((stack-buffer (gds-client-get client 'stack-buffer)))
 118     (if (and stack-buffer
 119              (buffer-live-p stack-buffer))
 120         (kill-buffer stack-buffer)))
 121   ;; Dissociate all the client's associated buffers.
 122   (mapcar (function (lambda (buffer)
 123                       (if (buffer-live-p buffer)
 124                           (with-current-buffer buffer
 125                             (gds-dissociate-buffer)))))
 126           (copy-sequence (gds-client-get client 'associated-buffers)))
 127   ;; Remove this client's record from gds-client-info.
 128   (setq gds-client-info (delq (assq client gds-client-info) gds-client-info)))
 129
 130 (defvar gds-client nil)
 131 (make-variable-buffer-local 'gds-client)
 132
 133 (defvar gds-stack nil)
 134 (make-variable-buffer-local 'gds-stack)
 135
 136 (defvar gds-tweaking nil)
 137 (make-variable-buffer-local 'gds-tweaking)
 138
 139 (defvar gds-selected-frame-index nil)
 140 (make-variable-buffer-local 'gds-selected-frame-index)
 141
 142
 143 ;;;; Debugger protocol
 144
 145 (defcustom gds-protocol-hook nil
 146   "Hook called on receipt of a protocol form from the GDS client."
 147   :type 'hook
 148   :group 'gds)
 149
 150 (defun gds-debug-protocol (client form)
 151   (run-hook-with-args 'gds-protocol-hook form)
 152   (or (eq client '*)
 153       (let ((proc (car form)))
 154         (cond ((eq proc 'name)
 155                ;; (name ...) - client name.
 156                (gds-client-put client 'name (caddr form)))
 157
 158               ((eq proc 'stack)
 159                ;; (stack ...) - stack information.
 160                (with-current-buffer (gds-get-client-buffer client)
 161                  (setq gds-stack (cddr form))
 162                  (setq gds-tweaking (memq 'instead (cadr gds-stack)))
 163                  (setq gds-selected-frame-index (cadr form))
 164                  (gds-display-stack)))
 165
 166               ((eq proc 'closed)
 167                ;; (closed) - client has gone/died.
 168                (gds-client-gone client))
 169
 170               ((eq proc 'eval-result)
 171                ;; (eval-result RESULT) - result of evaluation.
 172                (if gds-last-eval-result
 173                    (message "%s" (cadr form))
 174                  (setq gds-last-eval-result (cadr form))))
 175
 176               ((eq proc 'info-result)
 177                ;; (info-result RESULT) - info about selected frame.
 178                (message "%s" (cadr form)))
 179
 180               ((eq proc 'thread-id)
 181                ;; (thread-id THREAD) - says which client thread is reading.
 182                (let ((thread-id (cadr form))
 183                      (debug-thread-id (gds-client-get client 'debug-thread-id)))
 184                  (if (and debug-thread-id
 185                           (/= thread-id debug-thread-id))
 186                      ;; Tell the newly reading thread to go away.
 187                      (gds-send "dismiss" client)
 188                    ;; Either there's no current debug-thread-id, or
 189                    ;; the thread now reading is the debug thread.
 190                    (if debug-thread-id
 191                        (progn
 192                          ;; Reset the debug-thread-id.
 193                          (gds-client-put client 'debug-thread-id nil)
 194                          ;; Indicate debug status in modelines.
 195                          (gds-show-client-status client gds-debug-text))
 196                      ;; Indicate normal read status in modelines..
 197                      (gds-show-client-status client gds-ready-text)))))
 198
 199               ((eq proc 'debug-thread-id)
 200                ;; (debug-thread-id THREAD) - debug override indication.
 201                (gds-client-put client 'debug-thread-id (cadr form))
 202                ;; If another thread is already reading, send it away.
 203                (if (gds-client-get client 'thread-id)
 204                    (gds-send "dismiss" client)))
 205
 206               (t
 207                ;; Non-debug-specific protocol.
 208                (gds-nondebug-protocol client proc (cdr form)))))))
 209
 210
 211 ;;;; Displaying a stack
 212
 213 (define-derived-mode gds-debug-mode
 214   scheme-mode
 215   "Guile-Debug"
 216   "Major mode for debugging a Guile client application."
 217   (use-local-map gds-mode-map))
 218
 219 (defun gds-display-stack-first-line ()
 220   (let ((flags (cadr gds-stack)))
 221     (cond ((memq 'application flags)
 222            (insert "Calling procedure:\n"))
 223           ((memq 'evaluation flags)
 224            (insert "Evaluating expression"
 225                    (cond ((stringp gds-tweaking) (format " (tweaked: %s)"
 226                                                          gds-tweaking))
 227                          (gds-tweaking " (tweakable)")
 228                          (t ""))
 229                    ":\n"))
 230           ((memq 'return flags)
 231            (let ((value (cadr (memq 'return flags))))
 232              (while (string-match "\n" value)
 233                (setq value (replace-match "\\n" nil t value)))
 234              (insert "Return value"
 235                      (cond ((stringp gds-tweaking) (format " (tweaked: %s)"
 236                                                            gds-tweaking))
 237                            (gds-tweaking " (tweakable)")
 238                            (t ""))
 239                      ": " value "\n")))
 240           ((memq 'error flags)
 241            (let ((value (cadr (memq 'error flags))))
 242              (while (string-match "\n" value)
 243                (setq value (replace-match "\\n" nil t value)))
 244              (insert "Error: " value "\n")))
 245           (t
 246            (insert "Stack: " (prin1-to-string flags) "\n")))))
 247
 248 (defun gds-display-stack ()
 249   (if gds-undisplay-timer
 250       (cancel-timer gds-undisplay-timer))
 251   (setq gds-undisplay-timer nil)
 252   ;(setq buffer-read-only nil)
 253   (mapcar 'delete-overlay
 254           (overlays-in (point-min) (point-max)))
 255   (erase-buffer)
 256   (gds-display-stack-first-line)
 257   (let ((frames (car gds-stack)))
 258     (while frames
 259       (let ((frame-text (cadr (car frames)))
 260             (frame-source (caddr (car frames))))
 261         (while (string-match "\n" frame-text)
 262           (setq frame-text (replace-match "\\n" nil t frame-text)))
 263         (insert "   "
 264                 (if frame-source "s" " ")
 265                 frame-text
 266                 "\n"))
 267       (setq frames (cdr frames))))
 268   ;(setq buffer-read-only t)
 269   (gds-show-selected-frame))
 270
 271 (defun gds-tweak (expr)
 272   (interactive "sTweak expression or return value: ")
 273   (or gds-tweaking
 274       (error "The current stack cannot be tweaked"))
 275   (setq gds-tweaking
 276         (if (> (length expr) 0)
 277             expr
 278           t))
 279   (save-excursion
 280     (goto-char (point-min))
 281     (delete-region (point) (progn (forward-line 1) (point)))
 282     (gds-display-stack-first-line)))
 283
 284 (defvar gds-undisplay-timer nil)
 285 (make-variable-buffer-local 'gds-undisplay-timer)
 286
 287 (defvar gds-undisplay-wait 1)
 288
 289 (defun gds-undisplay-buffer ()
 290   (if gds-undisplay-timer
 291       (cancel-timer gds-undisplay-timer))
 292   (setq gds-undisplay-timer
 293         (run-at-time gds-undisplay-wait
 294                      nil
 295                      (function kill-buffer)
 296                      (current-buffer))))
 297
 298 (defun gds-show-selected-frame ()
 299   (setq gds-local-var-cache nil)
 300   (goto-char (point-min))
 301   (forward-line (+ gds-selected-frame-index 1))
 302   (delete-char 3)
 303   (insert "=> ")
 304   (beginning-of-line)
 305   (gds-show-selected-frame-source (caddr (nth gds-selected-frame-index
 306                                               (car gds-stack)))))
 307
 308 (defun gds-unshow-selected-frame ()
 309   (if gds-frame-source-overlay
 310       (move-overlay gds-frame-source-overlay 0 0))
 311   (save-excursion
 312     (goto-char (point-min))
 313     (forward-line (+ gds-selected-frame-index 1))
 314     (delete-char 3)
 315     (insert "   ")))
 316
 317 ;; Overlay used to highlight the source expression corresponding to
 318 ;; the selected frame.
 319 (defvar gds-frame-source-overlay nil)
 320
 321 (defcustom gds-source-file-name-transforms nil
 322   "Alist of regexps and substitutions for transforming Scheme source
 323 file names.  Each element in the alist is (REGEXP . SUBSTITUTION).
 324 Each source file name in a Guile backtrace is compared against each
 325 REGEXP in turn until the first one that matches, then `replace-match'
 326 is called with SUBSTITUTION to transform that file name.
 327
 328 This mechanism targets the situation where you are working on a Guile
 329 application and want to install it, in /usr/local say, before each
 330 test run.  In this situation, even though Guile is reading your Scheme
 331 files from /usr/local/share/guile, you probably want Emacs to pop up
 332 the corresponding files from your working codebase instead.  Therefore
 333 you would add an element to this alist to transform
 334 \"^/usr/local/share/guile/whatever\" to \"~/codebase/whatever\"."
 335   :type '(alist :key-type regexp :value-type string)
 336   :group 'gds)
 337
 338 (defun gds-show-selected-frame-source (source)
 339   ;; Highlight the frame source, if possible.
 340   (if source
 341       (let ((filename (car source))
 342             (client gds-client)
 343             (transforms gds-source-file-name-transforms))
 344         ;; Apply possible transforms to the source file name.
 345         (while transforms
 346           (if (string-match (caar transforms) filename)
 347               (let ((trans-fn (replace-match (cdar transforms)
 348                                              t nil filename)))
 349                 (if (file-readable-p trans-fn)
 350                     (setq filename trans-fn
 351                           transforms nil))))
 352           (setq transforms (cdr transforms)))
 353         ;; Try to map the (possibly transformed) source file to a
 354         ;; buffer.
 355         (let ((source-buffer (gds-source-file-name-to-buffer filename)))
 356           (if source-buffer
 357               (with-current-buffer source-buffer
 358                 (if gds-frame-source-overlay
 359                     nil
 360                   (setq gds-frame-source-overlay (make-overlay 0 0))
 361                   (overlay-put gds-frame-source-overlay 'face 'highlight)
 362                   (overlay-put gds-frame-source-overlay
 363                                'help-echo
 364                                (function gds-show-local-var)))
 365                 ;; Move to source line.  Note that Guile line numbering
 366                 ;; is 0-based, while Emacs numbering is 1-based.
 367                 (save-restriction
 368                   (widen)
 369                   (goto-line (+ (cadr source) 1))
 370                   (move-to-column (caddr source))
 371                   (move-overlay gds-frame-source-overlay
 372                                 (point)
 373                                 (if (not (looking-at ")"))
 374                                     (save-excursion (forward-sexp 1) (point))
 375                                   ;; It seems that the source
 376                                   ;; coordinates for backquoted
 377                                   ;; expressions are at the end of the
 378                                   ;; sexp rather than the beginning...
 379                                   (save-excursion (forward-char 1)
 380                                                   (backward-sexp 1) (point)))
 381                                 (current-buffer)))
 382                 ;; Record that this source buffer has been touched by a
 383                 ;; GDS client process.
 384                 (setq gds-last-touched-by client))
 385             (message "Source for this frame cannot be shown: %s:%d:%d"
 386                      filename
 387                      (cadr source)
 388                      (caddr source)))))
 389     (message "Source for this frame was not recorded"))
 390   (gds-display-buffers))
 391
 392 (defvar gds-local-var-cache nil)
 393
 394 (defun gds-show-local-var (window overlay position)
 395   (let ((frame-index gds-selected-frame-index)
 396         (client gds-client))
 397     (with-current-buffer (overlay-buffer overlay)
 398       (save-excursion
 399         (goto-char position)
 400         (let ((gds-selected-frame-index frame-index)
 401               (gds-client client)
 402               (varname (thing-at-point 'symbol))
 403               (state (parse-partial-sexp (overlay-start overlay) (point))))
 404           (when (and gds-selected-frame-index
 405                      gds-client
 406                      varname
 407                      (not (or (nth 3 state)
 408                               (nth 4 state))))
 409             (set-text-properties 0 (length varname) nil varname)
 410             (let ((existing (assoc varname gds-local-var-cache)))
 411               (if existing
 412                   (cdr existing)
 413                 (gds-evaluate varname)
 414                 (setq gds-last-eval-result nil)
 415                 (while (not gds-last-eval-result)
 416                   (accept-process-output gds-debug-server))
 417                 (setq gds-local-var-cache
 418                       (cons (cons varname gds-last-eval-result)
 419                             gds-local-var-cache))
 420                 gds-last-eval-result))))))))
 421
 422 (defun gds-source-file-name-to-buffer (filename)
 423   ;; See if filename begins with gds-emacs-buffer-port-name-prefix.
 424   (if (string-match (concat "^"
 425                             (regexp-quote gds-emacs-buffer-port-name-prefix))
 426                     filename)
 427       ;; It does, so get the named buffer.
 428       (get-buffer (substring filename (match-end 0)))
 429     ;; It doesn't, so treat as a file name.
 430     (and (file-readable-p filename)
 431          (find-file-noselect filename))))
 432
 433 (defun gds-select-stack-frame (&optional frame-index)
 434   (interactive)
 435   (let ((new-frame-index (or frame-index
 436                              (gds-current-line-frame-index))))
 437     (or (and (>= new-frame-index 0)
 438              (< new-frame-index (length (car gds-stack))))
 439         (error (if frame-index
 440                    "No more frames in this direction"
 441                  "No frame here")))
 442     (gds-unshow-selected-frame)
 443     (setq gds-selected-frame-index new-frame-index)
 444     (gds-show-selected-frame)))
 445
 446 (defun gds-up ()
 447   (interactive)
 448   (gds-select-stack-frame (- gds-selected-frame-index 1)))
 449
 450 (defun gds-down ()
 451   (interactive)
 452   (gds-select-stack-frame (+ gds-selected-frame-index 1)))
 453
 454 (defun gds-current-line-frame-index ()
 455   (- (count-lines (point-min)
 456                   (save-excursion
 457                     (beginning-of-line)
 458                     (point)))
 459      1))
 460
 461 (defun gds-display-buffers ()
 462   (let ((buf (current-buffer)))
 463     ;; If there's already a window showing the buffer, use it.
 464     (let ((window (get-buffer-window buf t)))
 465       (if window
 466           (progn
 467             (make-frame-visible (window-frame window))
 468             (select-window window))
 469         (switch-to-buffer buf)
 470         (setq window (get-buffer-window buf t))))
 471     ;; If there is an associated source buffer, display it as well.
 472     (if (and gds-frame-source-overlay
 473              (overlay-end gds-frame-source-overlay)
 474              (> (overlay-end gds-frame-source-overlay) 1))
 475         (progn
 476           (delete-other-windows)
 477           (let ((window (display-buffer
 478                          (overlay-buffer gds-frame-source-overlay))))
 479             (set-window-point window
 480                               (overlay-start gds-frame-source-overlay)))))))
 481
 482
 483 ;;;; Debugger commands.
 484
 485 ;; Typically but not necessarily used from the `stack' view.
 486
 487 (defun gds-send-tweaking ()
 488   (if (stringp gds-tweaking)
 489       (gds-send (format "tweak %S" gds-tweaking) gds-client)))
 490
 491 (defun gds-go ()
 492   (interactive)
 493   (gds-send-tweaking)
 494   (gds-send "continue" gds-client)
 495   (gds-unshow-selected-frame)
 496   (gds-undisplay-buffer))
 497
 498 (defvar gds-last-eval-result t)
 499
 500 (defun gds-evaluate (expr)
 501   (interactive "sEvaluate variable or expression: ")
 502   (gds-send (format "evaluate %d %s"
 503                     gds-selected-frame-index
 504                     (prin1-to-string expr))
 505             gds-client))
 506
 507 (defun gds-frame-info ()
 508   (interactive)
 509   (gds-send (format "info-frame %d" gds-selected-frame-index)
 510             gds-client))
 511
 512 (defun gds-frame-args ()
 513   (interactive)
 514   (gds-send (format "info-args %d" gds-selected-frame-index)
 515             gds-client))
 516
 517 (defun gds-proc-source ()
 518   (interactive)
 519   (gds-send (format "proc-source %d" gds-selected-frame-index)
 520             gds-client))
 521
 522 (defun gds-traps-here ()
 523   (interactive)
 524   (gds-send "traps-here" gds-client))
 525
 526 (defun gds-step-into ()
 527   (interactive)
 528   (gds-send-tweaking)
 529   (gds-send (format "step-into %d" gds-selected-frame-index)
 530             gds-client)
 531   (gds-unshow-selected-frame)
 532   (gds-undisplay-buffer))
 533
 534 (defun gds-step-over ()
 535   (interactive)
 536   (gds-send-tweaking)
 537   (gds-send (format "step-over %d" gds-selected-frame-index)
 538             gds-client)
 539   (gds-unshow-selected-frame)
 540   (gds-undisplay-buffer))
 541
 542 (defun gds-step-file ()
 543   (interactive)
 544   (gds-send-tweaking)
 545   (gds-send (format "step-file %d" gds-selected-frame-index)
 546             gds-client)
 547   (gds-unshow-selected-frame)
 548   (gds-undisplay-buffer))
 549
 550
 551
 552
 553 ;;;; Guile Interaction mode keymap and menu items.
 554
 555 (defvar gds-mode-map (make-sparse-keymap))
 556 (define-key gds-mode-map "c" (function gds-go))
 557 (define-key gds-mode-map "g" (function gds-go))
 558 (define-key gds-mode-map "q" (function gds-go))
 559 (define-key gds-mode-map "e" (function gds-evaluate))
 560 (define-key gds-mode-map "I" (function gds-frame-info))
 561 (define-key gds-mode-map "A" (function gds-frame-args))
 562 (define-key gds-mode-map "S" (function gds-proc-source))
 563 (define-key gds-mode-map "T" (function gds-traps-here))
 564 (define-key gds-mode-map "\C-m" (function gds-select-stack-frame))
 565 (define-key gds-mode-map "u" (function gds-up))
 566 (define-key gds-mode-map [up] (function gds-up))
 567 (define-key gds-mode-map "\C-p" (function gds-up))
 568 (define-key gds-mode-map "d" (function gds-down))
 569 (define-key gds-mode-map [down] (function gds-down))
 570 (define-key gds-mode-map "\C-n" (function gds-down))
 571 (define-key gds-mode-map " " (function gds-step-file))
 572 (define-key gds-mode-map "i" (function gds-step-into))
 573 (define-key gds-mode-map "o" (function gds-step-over))
 574 (define-key gds-mode-map "t" (function gds-tweak))
 575
 576
 577 (defvar gds-menu nil
 578   "Global menu for GDS commands.")
 579 (if nil;gds-menu
 580     nil
 581   (setq gds-menu (make-sparse-keymap "Guile-Debug"))
 582   (define-key gds-menu [traps-here]
 583     '(menu-item "Show Traps Here" gds-traps-here))
 584   (define-key gds-menu [proc-source]
 585     '(menu-item "Show Procedure Source" gds-proc-source))
 586   (define-key gds-menu [frame-args]
 587     '(menu-item "Show Frame Args" gds-frame-args))
 588   (define-key gds-menu [frame-info]
 589     '(menu-item "Show Frame Info" gds-frame-info))
 590   (define-key gds-menu [separator-1]
 591     '("--"))
 592   (define-key gds-menu [evaluate]
 593     '(menu-item "Evaluate..." gds-evaluate))
 594   (define-key gds-menu [separator-2]
 595     '("--"))
 596   (define-key gds-menu [down]
 597     '(menu-item "Move Down A Frame" gds-down))
 598   (define-key gds-menu [up]
 599     '(menu-item "Move Up A Frame" gds-up))
 600   (define-key gds-menu [separator-3]
 601     '("--"))
 602   (define-key gds-menu [step-over]
 603     '(menu-item "Step Over Current Expression" gds-step-over))
 604   (define-key gds-menu [step-into]
 605     '(menu-item "Step Into Current Expression" gds-step-into))
 606   (define-key gds-menu [step-file]
 607     '(menu-item "Step Through Current Source File" gds-step-file))
 608   (define-key gds-menu [separator-4]
 609     '("--"))
 610   (define-key gds-menu [go]
 611     '(menu-item "Go  [continue execution]" gds-go))
 612   (define-key gds-mode-map [menu-bar gds-debug]
 613     (cons "Guile-Debug" gds-menu)))
 614
 615
 616 ;;;; Autostarting the GDS server.
 617
 618 (defcustom gds-autorun-debug-server t
 619   "Whether to automatically run the GDS server when `gds.el' is loaded."
 620   :type 'boolean
 621   :group 'gds)
 622
 623 (defcustom gds-server-socket-type 'tcp
 624   "This option is now obsolete and has no effect."
 625   :group 'gds
 626   :type '(choice (const :tag "TCP" tcp)
 627                  (const :tag "Unix" unix)))
 628
 629 ;;;; If requested, autostart the server after loading.
 630
 631 (if (and gds-autorun-debug-server
 632          (not gds-debug-server))
 633     (gds-run-debug-server))
 634
 635 ;;;; The end!
 636
 637 (provide 'gds)
 638
 639 ;;; gds.el ends here.