mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-04-29 19:30:36 +02:00
53befeb700
(Not quite finished, the following will be done tomorrow. module/srfi/*.scm module/rnrs/*.scm module/scripts/*.scm testsuite/*.scm guile-readline/* )
628 lines
21 KiB
EmacsLisp
628 lines
21 KiB
EmacsLisp
;;; gds.el -- frontend for Guile development in Emacs
|
|
|
|
;;;; Copyright (C) 2003, 2004 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 3 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
|
|
|
|
; TODO:
|
|
; ?transcript
|
|
; scheme-mode menu
|
|
; interrupt/sigint/async-break
|
|
; (module browsing)
|
|
; load file
|
|
; doing common protocol from debugger
|
|
; thread override for debugging
|
|
|
|
;;;; Prerequisites.
|
|
|
|
(require 'scheme)
|
|
(require 'cl)
|
|
(require 'gds-server)
|
|
(require 'gds-scheme)
|
|
|
|
;; The subprocess object for the debug server.
|
|
(defvar gds-debug-server nil)
|
|
|
|
(defvar gds-socket-type-alist '((tcp . 8333)
|
|
(unix . "/tmp/.gds_socket"))
|
|
"Maps each of the possible socket types that the GDS server can
|
|
listen on to the path that it should bind to for each one.")
|
|
|
|
(defun gds-run-debug-server ()
|
|
"Start (or restart, if already running) the GDS debug server process."
|
|
(interactive)
|
|
(if gds-debug-server (gds-kill-debug-server))
|
|
(setq gds-debug-server
|
|
(gds-start-server "gds-debug"
|
|
(cdr (assq gds-server-socket-type
|
|
gds-socket-type-alist))
|
|
'gds-debug-protocol))
|
|
(process-kill-without-query gds-debug-server))
|
|
|
|
(defun gds-kill-debug-server ()
|
|
"Kill the GDS debug server process."
|
|
(interactive)
|
|
(mapcar (function gds-client-gone)
|
|
(mapcar (function car) gds-client-info))
|
|
(condition-case nil
|
|
(progn
|
|
(kill-process gds-debug-server)
|
|
(accept-process-output gds-debug-server 0 200))
|
|
(error))
|
|
(setq gds-debug-server nil))
|
|
|
|
;; Send input to the subprocess.
|
|
(defun gds-send (string client)
|
|
(with-current-buffer (get-buffer-create "*GDS Transcript*")
|
|
(goto-char (point-max))
|
|
(insert (number-to-string client) ": (" string ")\n"))
|
|
(gds-client-put client 'thread-id nil)
|
|
(gds-show-client-status client gds-running-text)
|
|
(process-send-string gds-debug-server (format "(%S %s)\n" client string)))
|
|
|
|
|
|
;;;; Per-client information
|
|
|
|
(defun gds-client-put (client property value)
|
|
(let ((client-info (assq client gds-client-info)))
|
|
(if client-info
|
|
(let ((prop-info (memq property client-info)))
|
|
(if prop-info
|
|
(setcar (cdr prop-info) value)
|
|
(setcdr client-info
|
|
(list* property value (cdr client-info)))))
|
|
(setq gds-client-info
|
|
(cons (list client property value) gds-client-info)))))
|
|
|
|
(defun gds-client-get (client property)
|
|
(let ((client-info (assq client gds-client-info)))
|
|
(and client-info
|
|
(cadr (memq property client-info)))))
|
|
|
|
(defvar gds-client-info '())
|
|
|
|
(defun gds-get-client-buffer (client)
|
|
(let ((existing-buffer (gds-client-get client 'stack-buffer)))
|
|
(if (and existing-buffer
|
|
(buffer-live-p existing-buffer))
|
|
existing-buffer
|
|
(let ((new-buffer (generate-new-buffer (gds-client-get client 'name))))
|
|
(with-current-buffer new-buffer
|
|
(gds-debug-mode)
|
|
(setq gds-client client)
|
|
(setq gds-stack nil))
|
|
(gds-client-put client 'stack-buffer new-buffer)
|
|
new-buffer))))
|
|
|
|
(defun gds-client-gone (client &rest ignored)
|
|
;; Kill the client's stack buffer, if it has one.
|
|
(let ((stack-buffer (gds-client-get client 'stack-buffer)))
|
|
(if (and stack-buffer
|
|
(buffer-live-p stack-buffer))
|
|
(kill-buffer stack-buffer)))
|
|
;; Dissociate all the client's associated buffers.
|
|
(mapcar (function (lambda (buffer)
|
|
(if (buffer-live-p buffer)
|
|
(with-current-buffer buffer
|
|
(gds-dissociate-buffer)))))
|
|
(copy-sequence (gds-client-get client 'associated-buffers)))
|
|
;; Remove this client's record from gds-client-info.
|
|
(setq gds-client-info (delq (assq client gds-client-info) gds-client-info)))
|
|
|
|
(defvar gds-client nil)
|
|
(make-variable-buffer-local 'gds-client)
|
|
|
|
(defvar gds-stack nil)
|
|
(make-variable-buffer-local 'gds-stack)
|
|
|
|
(defvar gds-tweaking nil)
|
|
(make-variable-buffer-local 'gds-tweaking)
|
|
|
|
(defvar gds-selected-frame-index nil)
|
|
(make-variable-buffer-local 'gds-selected-frame-index)
|
|
|
|
|
|
;;;; Debugger protocol
|
|
|
|
(defun gds-debug-protocol (client form)
|
|
(or (eq client '*)
|
|
(let ((proc (car form)))
|
|
(cond ((eq proc 'name)
|
|
;; (name ...) - client name.
|
|
(gds-client-put client 'name (caddr form)))
|
|
|
|
((eq proc 'stack)
|
|
;; (stack ...) - stack information.
|
|
(with-current-buffer (gds-get-client-buffer client)
|
|
(setq gds-stack (cddr form))
|
|
(setq gds-tweaking (memq 'instead (cadr gds-stack)))
|
|
(setq gds-selected-frame-index (cadr form))
|
|
(gds-display-stack)))
|
|
|
|
((eq proc 'closed)
|
|
;; (closed) - client has gone/died.
|
|
(gds-client-gone client))
|
|
|
|
((eq proc 'eval-result)
|
|
;; (eval-result RESULT) - result of evaluation.
|
|
(if gds-last-eval-result
|
|
(message "%s" (cadr form))
|
|
(setq gds-last-eval-result (cadr form))))
|
|
|
|
((eq proc 'info-result)
|
|
;; (info-result RESULT) - info about selected frame.
|
|
(message "%s" (cadr form)))
|
|
|
|
((eq proc 'thread-id)
|
|
;; (thread-id THREAD) - says which client thread is reading.
|
|
(let ((thread-id (cadr form))
|
|
(debug-thread-id (gds-client-get client 'debug-thread-id)))
|
|
(if (and debug-thread-id
|
|
(/= thread-id debug-thread-id))
|
|
;; Tell the newly reading thread to go away.
|
|
(gds-send "dismiss" client)
|
|
;; Either there's no current debug-thread-id, or
|
|
;; the thread now reading is the debug thread.
|
|
(if debug-thread-id
|
|
(progn
|
|
;; Reset the debug-thread-id.
|
|
(gds-client-put client 'debug-thread-id nil)
|
|
;; Indicate debug status in modelines.
|
|
(gds-show-client-status client gds-debug-text))
|
|
;; Indicate normal read status in modelines..
|
|
(gds-show-client-status client gds-ready-text)))))
|
|
|
|
((eq proc 'debug-thread-id)
|
|
;; (debug-thread-id THREAD) - debug override indication.
|
|
(gds-client-put client 'debug-thread-id (cadr form))
|
|
;; If another thread is already reading, send it away.
|
|
(if (gds-client-get client 'thread-id)
|
|
(gds-send "dismiss" client)))
|
|
|
|
(t
|
|
;; Non-debug-specific protocol.
|
|
(gds-nondebug-protocol client proc (cdr form)))))))
|
|
|
|
|
|
;;;; Displaying a stack
|
|
|
|
(define-derived-mode gds-debug-mode
|
|
scheme-mode
|
|
"Guile-Debug"
|
|
"Major mode for debugging a Guile client application."
|
|
(use-local-map gds-mode-map))
|
|
|
|
(defun gds-display-stack-first-line ()
|
|
(let ((flags (cadr gds-stack)))
|
|
(cond ((memq 'application flags)
|
|
(insert "Calling procedure:\n"))
|
|
((memq 'evaluation flags)
|
|
(insert "Evaluating expression"
|
|
(cond ((stringp gds-tweaking) (format " (tweaked: %s)"
|
|
gds-tweaking))
|
|
(gds-tweaking " (tweakable)")
|
|
(t ""))
|
|
":\n"))
|
|
((memq 'return flags)
|
|
(let ((value (cadr (memq 'return flags))))
|
|
(while (string-match "\n" value)
|
|
(setq value (replace-match "\\n" nil t value)))
|
|
(insert "Return value"
|
|
(cond ((stringp gds-tweaking) (format " (tweaked: %s)"
|
|
gds-tweaking))
|
|
(gds-tweaking " (tweakable)")
|
|
(t ""))
|
|
": " value "\n")))
|
|
((memq 'error flags)
|
|
(let ((value (cadr (memq 'error flags))))
|
|
(while (string-match "\n" value)
|
|
(setq value (replace-match "\\n" nil t value)))
|
|
(insert "Error: " value "\n")))
|
|
(t
|
|
(insert "Stack: " (prin1-to-string flags) "\n")))))
|
|
|
|
(defun gds-display-stack ()
|
|
(if gds-undisplay-timer
|
|
(cancel-timer gds-undisplay-timer))
|
|
(setq gds-undisplay-timer nil)
|
|
;(setq buffer-read-only nil)
|
|
(mapcar 'delete-overlay
|
|
(overlays-in (point-min) (point-max)))
|
|
(erase-buffer)
|
|
(gds-display-stack-first-line)
|
|
(let ((frames (car gds-stack)))
|
|
(while frames
|
|
(let ((frame-text (cadr (car frames)))
|
|
(frame-source (caddr (car frames))))
|
|
(while (string-match "\n" frame-text)
|
|
(setq frame-text (replace-match "\\n" nil t frame-text)))
|
|
(insert " "
|
|
(if frame-source "s" " ")
|
|
frame-text
|
|
"\n"))
|
|
(setq frames (cdr frames))))
|
|
;(setq buffer-read-only t)
|
|
(gds-show-selected-frame))
|
|
|
|
(defun gds-tweak (expr)
|
|
(interactive "sTweak expression or return value: ")
|
|
(or gds-tweaking
|
|
(error "The current stack cannot be tweaked"))
|
|
(setq gds-tweaking
|
|
(if (> (length expr) 0)
|
|
expr
|
|
t))
|
|
(save-excursion
|
|
(goto-char (point-min))
|
|
(delete-region (point) (progn (forward-line 1) (point)))
|
|
(gds-display-stack-first-line)))
|
|
|
|
(defvar gds-undisplay-timer nil)
|
|
(make-variable-buffer-local 'gds-undisplay-timer)
|
|
|
|
(defvar gds-undisplay-wait 1)
|
|
|
|
(defun gds-undisplay-buffer ()
|
|
(if gds-undisplay-timer
|
|
(cancel-timer gds-undisplay-timer))
|
|
(setq gds-undisplay-timer
|
|
(run-at-time gds-undisplay-wait
|
|
nil
|
|
(function kill-buffer)
|
|
(current-buffer))))
|
|
|
|
(defun gds-show-selected-frame ()
|
|
(setq gds-local-var-cache nil)
|
|
(goto-char (point-min))
|
|
(forward-line (+ gds-selected-frame-index 1))
|
|
(delete-char 3)
|
|
(insert "=> ")
|
|
(beginning-of-line)
|
|
(gds-show-selected-frame-source (caddr (nth gds-selected-frame-index
|
|
(car gds-stack)))))
|
|
|
|
(defun gds-unshow-selected-frame ()
|
|
(if gds-frame-source-overlay
|
|
(move-overlay gds-frame-source-overlay 0 0))
|
|
(save-excursion
|
|
(goto-char (point-min))
|
|
(forward-line (+ gds-selected-frame-index 1))
|
|
(delete-char 3)
|
|
(insert " ")))
|
|
|
|
;; Overlay used to highlight the source expression corresponding to
|
|
;; the selected frame.
|
|
(defvar gds-frame-source-overlay nil)
|
|
|
|
(defcustom gds-source-file-name-transforms nil
|
|
"Alist of regexps and substitutions for transforming Scheme source
|
|
file names. Each element in the alist is (REGEXP . SUBSTITUTION).
|
|
Each source file name in a Guile backtrace is compared against each
|
|
REGEXP in turn until the first one that matches, then `replace-match'
|
|
is called with SUBSTITUTION to transform that file name.
|
|
|
|
This mechanism targets the situation where you are working on a Guile
|
|
application and want to install it, in /usr/local say, before each
|
|
test run. In this situation, even though Guile is reading your Scheme
|
|
files from /usr/local/share/guile, you probably want Emacs to pop up
|
|
the corresponding files from your working codebase instead. Therefore
|
|
you would add an element to this alist to transform
|
|
\"^/usr/local/share/guile/whatever\" to \"~/codebase/whatever\"."
|
|
:type '(alist :key-type regexp :value-type string)
|
|
:group 'gds)
|
|
|
|
(defun gds-show-selected-frame-source (source)
|
|
;; Highlight the frame source, if possible.
|
|
(if source
|
|
(let ((filename (car source))
|
|
(client gds-client)
|
|
(transforms gds-source-file-name-transforms))
|
|
;; Apply possible transforms to the source file name.
|
|
(while transforms
|
|
(if (string-match (caar transforms) filename)
|
|
(let ((trans-fn (replace-match (cdar transforms)
|
|
t nil filename)))
|
|
(if (file-readable-p trans-fn)
|
|
(setq filename trans-fn
|
|
transforms nil))))
|
|
(setq transforms (cdr transforms)))
|
|
;; Try to map the (possibly transformed) source file to a
|
|
;; buffer.
|
|
(let ((source-buffer (gds-source-file-name-to-buffer filename)))
|
|
(if source-buffer
|
|
(with-current-buffer source-buffer
|
|
(if gds-frame-source-overlay
|
|
nil
|
|
(setq gds-frame-source-overlay (make-overlay 0 0))
|
|
(overlay-put gds-frame-source-overlay 'face 'highlight)
|
|
(overlay-put gds-frame-source-overlay
|
|
'help-echo
|
|
(function gds-show-local-var)))
|
|
;; 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-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)))
|
|
;; Record that this source buffer has been touched by a
|
|
;; GDS client process.
|
|
(setq gds-last-touched-by client))
|
|
(message "Source for this frame cannot be shown: %s:%d:%d"
|
|
filename
|
|
(cadr source)
|
|
(caddr source)))))
|
|
(message "Source for this frame was not recorded"))
|
|
(gds-display-buffers))
|
|
|
|
(defvar gds-local-var-cache nil)
|
|
|
|
(defun gds-show-local-var (window overlay position)
|
|
(let ((frame-index gds-selected-frame-index)
|
|
(client gds-client))
|
|
(with-current-buffer (overlay-buffer overlay)
|
|
(save-excursion
|
|
(goto-char position)
|
|
(let ((gds-selected-frame-index frame-index)
|
|
(gds-client client)
|
|
(varname (thing-at-point 'symbol))
|
|
(state (parse-partial-sexp (overlay-start overlay) (point))))
|
|
(when (and gds-selected-frame-index
|
|
gds-client
|
|
varname
|
|
(not (or (nth 3 state)
|
|
(nth 4 state))))
|
|
(set-text-properties 0 (length varname) nil varname)
|
|
(let ((existing (assoc varname gds-local-var-cache)))
|
|
(if existing
|
|
(cdr existing)
|
|
(gds-evaluate varname)
|
|
(setq gds-last-eval-result nil)
|
|
(while (not gds-last-eval-result)
|
|
(accept-process-output gds-debug-server))
|
|
(setq gds-local-var-cache
|
|
(cons (cons varname gds-last-eval-result)
|
|
gds-local-var-cache))
|
|
gds-last-eval-result))))))))
|
|
|
|
(defun gds-source-file-name-to-buffer (filename)
|
|
;; See if filename begins with gds-emacs-buffer-port-name-prefix.
|
|
(if (string-match (concat "^"
|
|
(regexp-quote gds-emacs-buffer-port-name-prefix))
|
|
filename)
|
|
;; It does, so get the named buffer.
|
|
(get-buffer (substring filename (match-end 0)))
|
|
;; It doesn't, so treat as a file name.
|
|
(and (file-readable-p filename)
|
|
(find-file-noselect filename))))
|
|
|
|
(defun gds-select-stack-frame (&optional frame-index)
|
|
(interactive)
|
|
(let ((new-frame-index (or frame-index
|
|
(gds-current-line-frame-index))))
|
|
(or (and (>= new-frame-index 0)
|
|
(< new-frame-index (length (car gds-stack))))
|
|
(error (if frame-index
|
|
"No more frames in this direction"
|
|
"No frame here")))
|
|
(gds-unshow-selected-frame)
|
|
(setq gds-selected-frame-index new-frame-index)
|
|
(gds-show-selected-frame)))
|
|
|
|
(defun gds-up ()
|
|
(interactive)
|
|
(gds-select-stack-frame (- gds-selected-frame-index 1)))
|
|
|
|
(defun gds-down ()
|
|
(interactive)
|
|
(gds-select-stack-frame (+ gds-selected-frame-index 1)))
|
|
|
|
(defun gds-current-line-frame-index ()
|
|
(- (count-lines (point-min)
|
|
(save-excursion
|
|
(beginning-of-line)
|
|
(point)))
|
|
1))
|
|
|
|
(defun gds-display-buffers ()
|
|
(let ((buf (current-buffer)))
|
|
;; If there's already a window showing the buffer, use it.
|
|
(let ((window (get-buffer-window buf t)))
|
|
(if window
|
|
(progn
|
|
(make-frame-visible (window-frame window))
|
|
(select-window window))
|
|
(switch-to-buffer buf)
|
|
(setq window (get-buffer-window buf t))))
|
|
;; If there is an associated source buffer, display it as well.
|
|
(if (and gds-frame-source-overlay
|
|
(overlay-end gds-frame-source-overlay)
|
|
(> (overlay-end gds-frame-source-overlay) 1))
|
|
(progn
|
|
(delete-other-windows)
|
|
(let ((window (display-buffer
|
|
(overlay-buffer gds-frame-source-overlay))))
|
|
(set-window-point window
|
|
(overlay-start gds-frame-source-overlay)))))))
|
|
|
|
|
|
;;;; Debugger commands.
|
|
|
|
;; Typically but not necessarily used from the `stack' view.
|
|
|
|
(defun gds-send-tweaking ()
|
|
(if (stringp gds-tweaking)
|
|
(gds-send (format "tweak %S" gds-tweaking) gds-client)))
|
|
|
|
(defun gds-go ()
|
|
(interactive)
|
|
(gds-send-tweaking)
|
|
(gds-send "continue" gds-client)
|
|
(gds-unshow-selected-frame)
|
|
(gds-undisplay-buffer))
|
|
|
|
(defvar gds-last-eval-result t)
|
|
|
|
(defun gds-evaluate (expr)
|
|
(interactive "sEvaluate variable or expression: ")
|
|
(gds-send (format "evaluate %d %s"
|
|
gds-selected-frame-index
|
|
(prin1-to-string expr))
|
|
gds-client))
|
|
|
|
(defun gds-frame-info ()
|
|
(interactive)
|
|
(gds-send (format "info-frame %d" gds-selected-frame-index)
|
|
gds-client))
|
|
|
|
(defun gds-frame-args ()
|
|
(interactive)
|
|
(gds-send (format "info-args %d" gds-selected-frame-index)
|
|
gds-client))
|
|
|
|
(defun gds-proc-source ()
|
|
(interactive)
|
|
(gds-send (format "proc-source %d" gds-selected-frame-index)
|
|
gds-client))
|
|
|
|
(defun gds-traps-here ()
|
|
(interactive)
|
|
(gds-send "traps-here" gds-client))
|
|
|
|
(defun gds-step-into ()
|
|
(interactive)
|
|
(gds-send-tweaking)
|
|
(gds-send (format "step-into %d" gds-selected-frame-index)
|
|
gds-client)
|
|
(gds-unshow-selected-frame)
|
|
(gds-undisplay-buffer))
|
|
|
|
(defun gds-step-over ()
|
|
(interactive)
|
|
(gds-send-tweaking)
|
|
(gds-send (format "step-over %d" gds-selected-frame-index)
|
|
gds-client)
|
|
(gds-unshow-selected-frame)
|
|
(gds-undisplay-buffer))
|
|
|
|
(defun gds-step-file ()
|
|
(interactive)
|
|
(gds-send-tweaking)
|
|
(gds-send (format "step-file %d" gds-selected-frame-index)
|
|
gds-client)
|
|
(gds-unshow-selected-frame)
|
|
(gds-undisplay-buffer))
|
|
|
|
|
|
|
|
|
|
;;;; Guile Interaction mode keymap and menu items.
|
|
|
|
(defvar gds-mode-map (make-sparse-keymap))
|
|
(define-key gds-mode-map "c" (function gds-go))
|
|
(define-key gds-mode-map "g" (function gds-go))
|
|
(define-key gds-mode-map "q" (function gds-go))
|
|
(define-key gds-mode-map "e" (function gds-evaluate))
|
|
(define-key gds-mode-map "I" (function gds-frame-info))
|
|
(define-key gds-mode-map "A" (function gds-frame-args))
|
|
(define-key gds-mode-map "S" (function gds-proc-source))
|
|
(define-key gds-mode-map "T" (function gds-traps-here))
|
|
(define-key gds-mode-map "\C-m" (function gds-select-stack-frame))
|
|
(define-key gds-mode-map "u" (function gds-up))
|
|
(define-key gds-mode-map [up] (function gds-up))
|
|
(define-key gds-mode-map "\C-p" (function gds-up))
|
|
(define-key gds-mode-map "d" (function gds-down))
|
|
(define-key gds-mode-map [down] (function gds-down))
|
|
(define-key gds-mode-map "\C-n" (function gds-down))
|
|
(define-key gds-mode-map " " (function gds-step-file))
|
|
(define-key gds-mode-map "i" (function gds-step-into))
|
|
(define-key gds-mode-map "o" (function gds-step-over))
|
|
(define-key gds-mode-map "t" (function gds-tweak))
|
|
|
|
|
|
(defvar gds-menu nil
|
|
"Global menu for GDS commands.")
|
|
(if nil;gds-menu
|
|
nil
|
|
(setq gds-menu (make-sparse-keymap "Guile-Debug"))
|
|
(define-key gds-menu [traps-here]
|
|
'(menu-item "Show Traps Here" gds-traps-here))
|
|
(define-key gds-menu [proc-source]
|
|
'(menu-item "Show Procedure Source" gds-proc-source))
|
|
(define-key gds-menu [frame-args]
|
|
'(menu-item "Show Frame Args" gds-frame-args))
|
|
(define-key gds-menu [frame-info]
|
|
'(menu-item "Show Frame Info" gds-frame-info))
|
|
(define-key gds-menu [separator-1]
|
|
'("--"))
|
|
(define-key gds-menu [evaluate]
|
|
'(menu-item "Evaluate..." gds-evaluate))
|
|
(define-key gds-menu [separator-2]
|
|
'("--"))
|
|
(define-key gds-menu [down]
|
|
'(menu-item "Move Down A Frame" gds-down))
|
|
(define-key gds-menu [up]
|
|
'(menu-item "Move Up A Frame" gds-up))
|
|
(define-key gds-menu [separator-3]
|
|
'("--"))
|
|
(define-key gds-menu [step-over]
|
|
'(menu-item "Step Over Current Expression" gds-step-over))
|
|
(define-key gds-menu [step-into]
|
|
'(menu-item "Step Into Current Expression" gds-step-into))
|
|
(define-key gds-menu [step-file]
|
|
'(menu-item "Step Through Current Source File" gds-step-file))
|
|
(define-key gds-menu [separator-4]
|
|
'("--"))
|
|
(define-key gds-menu [go]
|
|
'(menu-item "Go [continue execution]" gds-go))
|
|
(define-key gds-mode-map [menu-bar gds-debug]
|
|
(cons "Guile-Debug" gds-menu)))
|
|
|
|
|
|
;;;; Autostarting the GDS server.
|
|
|
|
(defcustom gds-autorun-debug-server t
|
|
"Whether to automatically run the GDS server when `gds.el' is loaded."
|
|
:type 'boolean
|
|
:group 'gds)
|
|
|
|
(defcustom gds-server-socket-type 'tcp
|
|
"What kind of socket the GDS server should listen on."
|
|
:group 'gds
|
|
:type '(choice (const :tag "TCP" tcp)
|
|
(const :tag "Unix" unix)))
|
|
|
|
;;;; If requested, autostart the server after loading.
|
|
|
|
(if (and gds-autorun-debug-server
|
|
(not gds-debug-server))
|
|
(gds-run-debug-server))
|
|
|
|
;;;; The end!
|
|
|
|
(provide 'gds)
|
|
|
|
;;; gds.el ends here.
|