(require 'widget)
(require 'wid-edit)
(require 'scheme)
+(require 'cl)
+(require 'comint)
+(require 'info)
;;;; Customization group setup.
;; the buffer position of the start of the next unread form.
(defvar gds-read-cursor nil)
+;; The guile executable used by the GDS server and captive client
+;; processes.
+(defcustom gds-guile-program "guile"
+ "*The guile executable used by GDS, specifically by its server and
+captive client processes."
+ :type 'string
+ :group 'gds)
+
(defun gds-start ()
"Start (or restart, if already running) the GDS subprocess."
(interactive)
+ (gds-kill-captive)
(if gds-process (gds-shutdown))
(with-current-buffer (get-buffer-create "*GDS Process*")
(erase-buffer)
(let ((process-connection-type nil)) ; use a pipe
(start-process "gds"
(current-buffer)
- "guile"
+ gds-guile-program
"-q"
"--debug"
"-c"
(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))
+ (set-process-coding-system gds-process 'latin-1-unix)
+ (process-kill-without-query gds-process))
;; Shutdown the subprocess and cleanup all associated data.
(defun gds-shutdown ()
"Shut down the GDS subprocess."
(interactive)
;; Reset variables.
- (setq gds-buffers nil
- gds-focus-client nil
- gds-waiting nil)
+ (setq gds-buffers nil)
;; Kill the subprocess.
- (process-kill-without-query gds-process)
(condition-case nil
(progn
(kill-process gds-process)
;; Send input to the subprocess.
(defun gds-send (string client)
- (process-send-string gds-process (format "(%S %s)\n" client string)))
+ (process-send-string gds-process (format "(%S %s)\n" client string))
+ (let ((buf (gds-client-ref 'gds-transcript)))
+ (if buf
+ (with-current-buffer buf
+ (goto-char (point-max))
+ (let ((inhibit-read-only t))
+ (insert (format "tx (%S %s)\n" client string)))))))
-;;;; Multiple application scheduling.
+;;;; Focussing in and out on interaction with a particular client.
+
+;;;; The slight possible problems here are that popping up a client's
+;;;; interaction windows when that client wants attention might
+;;;; interrupt something else that the Emacs user was working on at
+;;;; the time, and that if multiple clients are being debugged at the
+;;;; same time, their popping up of interaction windows might become
+;;;; confusing. For this reason, we allow GDS's behavior to be
+;;;; customized via the variables `gds-focus-in-function' and
+;;;; `gds-focus-out-function'.
+;;;;
+;;;; That said, the default policy, which is probably OK for most
+;;;; users most of the time, is very simple: when a client wants
+;;;; attention, its interaction windows are popped up immediately.
+
+(defun gds-request-focus (client)
+ (funcall gds-focus-in-function client))
+
+(defcustom gds-focus-in-function (function gds-focus-in)
+ "Function to call when a GDS client program wants user attention.
+The function is called with one argument, the CLIENT in question."
+ :type 'function
+ :group 'gds)
+
+(defun gds-focus-in (client)
+ (gds-display-buffers client))
+
+(defun gds-quit ()
+ (interactive)
+ (funcall gds-focus-out-function))
+
+(defcustom gds-focus-out-function (function gds-focus-out)
+ "Function to call when user quits interacting with a GDS client."
+ :type 'function
+ :group 'gds)
+
+(defun gds-focus-out ()
+ (if (if (gds-client-blocked)
+ (y-or-n-p "Client is waiting for input. Quit anyway? ")
+ t)
+ (bury-buffer (current-buffer))))
+
+
+;;;; Multiple client focus -- an alternative implementation.
+
+;;;; The following code is provided as an alternative example of how a
+;;;; customized GDS could schedule the display of multiple clients
+;;;; that are competing for user attention.
-;; Here is how we schedule the display of multiple clients that are
-;; competing for user attention.
-;;
;; - `gds-waiting' holds a list of clients that want attention but
;; haven't yet got it. A client is added to this list for two
;; reasons. (1) When it is blocked waiting for user input.
;; says that it is no longer blocked, and a small time passes without
;; it becoming blocked again. (2) If the user explicitly `quits'
;; that client.
-(defvar gds-focus-client nil)
-(defvar gds-waiting nil)
-
-(defun gds-request-focus (client)
- (cond ((eq client gds-focus-client)
- ;; CLIENT already has the focus. Display its buffer.
- (gds-display-buffers))
- (gds-focus-client
- ;; Another client has the focus. Add CLIENT to `gds-waiting'.
- (or (memq client gds-waiting)
- (setq gds-waiting (append gds-waiting (list client)))))
- (t
- ;; Give focus to CLIENT and display its buffer.
- (setq gds-focus-client client)
- (gds-display-buffers))))
-
-;; Explicitly give up focus.
-(defun gds-quit ()
- (interactive)
- (if (or (car gds-waiting)
- (not (gds-client-blocked))
- (y-or-n-p
- "Client is blocked and no others are waiting. Still quit? "))
- (progn
- (bury-buffer (current-buffer))
- ;; Pass on the focus.
- (setq gds-focus-client (car gds-waiting)
- gds-waiting (cdr gds-waiting))
- ;; If this client is blocked, add it back into the waiting list.
- (if (gds-client-blocked)
- (gds-request-focus gds-client))
- ;; If there is a new focus client, request display for it.
- (if gds-focus-client
- (gds-request-focus gds-focus-client)))))
+;;
+;; (defvar gds-focus-client nil)
+;; (defvar gds-waiting nil)
+;;
+;; (defun gds-focus-in-alternative (client)
+;; (cond ((eq client gds-focus-client)
+;; ;; CLIENT already has the focus. Display its buffer.
+;; (gds-display-buffers client))
+;; (gds-focus-client
+;; ;; Another client has the focus. Add CLIENT to `gds-waiting'.
+;; (or (memq client gds-waiting)
+;; (setq gds-waiting (append gds-waiting (list client)))))
+;; (t
+;; ;; Give focus to CLIENT and display its buffer.
+;; (setq gds-focus-client client)
+;; (gds-display-buffers client))))
+;;
+;; (defun gds-focus-out-alternative ()
+;; (if (or (car gds-waiting)
+;; (not (gds-client-blocked))
+;; (y-or-n-p
+;; "Client is blocked and no others are waiting. Still quit? "))
+;; (progn
+;; (bury-buffer (current-buffer))
+;; ;; Pass on the focus.
+;; (setq gds-focus-client (car gds-waiting)
+;; gds-waiting (cdr gds-waiting))
+;; ;; If this client is blocked, add it back into the waiting list.
+;; (if (gds-client-blocked)
+;; (gds-request-focus gds-client))
+;; ;; If there is a new focus client, request display for it.
+;; (if gds-focus-client
+;; (gds-request-focus gds-focus-client)))))
;;;; GDS protocol dispatch.
(goto-char (point-max))
(let ((inhibit-read-only t))
(insert (format "rx %S" (cons client (cons proc args))) "\n")))
+
(cond (;; (name ...) - Client name.
(eq proc 'name)
(setq gds-pid (cadr args))
(setq gds-status 'closed)
(gds-update-buffers)
(setq gds-buffers
- (delq (assq client gds-buffers) gds-buffers))
- (if (eq client gds-focus-client)
- (gds-quit)))
+ (delq (assq client gds-buffers) gds-buffers)))
(;; (eval-results ...) - Results of evaluation.
(eq proc 'eval-results)
(gds-display-results client (car args) (cdr args)))
- ((eq proc 'completion-result)
+ (;; (completion-result ...) - Available completions.
+ (eq proc 'completion-result)
(setq gds-completion-results (or (car args) t)))
(;; (breakpoint-set FILE LINE COLUMN INFO) - Breakpoint set.
(setq os nil))
(setq os (cdr os)))))))))
+ (;; (thread-status THREAD-TYPE THREAD-NUMBER STATUS [CORRELATOR])
+ (eq proc 'thread-status)
+ (if (eq (car args) 'eval)
+ (let ((number (nth 1 args))
+ (status (nth 2 args))
+ (correlator (nth 3 args)))
+ (if (eq status 'busy)
+ (progn
+ (setq gds-evals-in-progress
+ (append gds-evals-in-progress
+ (list (cons number correlator))))
+ (run-at-time 0.5 nil
+ (function gds-display-slow-eval)
+ buf number correlator)
+ (gds-promote-view 'interaction))
+ (let ((existing (assq number gds-evals-in-progress)))
+ (if existing
+ (setq gds-evals-in-progress
+ (delq existing gds-evals-in-progress)))))
+ (gds-update-buffers))))
+
)))
+(defun gds-display-slow-eval (buf number correlator)
+ (with-current-buffer buf
+ (let ((entry (assq number gds-evals-in-progress)))
+ (if (and entry
+ (eq (cdr entry) correlator))
+ (progn
+ (gds-promote-view 'interaction)
+ (gds-request-focus gds-client))))))
+
;;;; Per-client buffer state.
(define-derived-mode gds-mode
scheme-mode
"Guile Interaction"
- "Major mode for interacting with a Guile client application.")
+ "Major mode for interacting with a Guile client application."
+ (widget-minor-mode 1))
(defvar gds-client nil
"GDS client's port number.")
(setq gds-buffers (delq existing gds-buffers))
(gds-client-buffer client 'name '("(GDS buffer killed)"))))))
+;; Get the current buffer's associated client's value of SYM.
+(defun gds-client-ref (sym &optional client)
+ (and (or client gds-client)
+ (let ((buf (assq (or client gds-client) gds-buffers)))
+ (and buf
+ (cdr buf)
+ (buffer-live-p (cdr buf))
+ (with-current-buffer (cdr buf)
+ (symbol-value sym))))))
+
(defun gds-client-blocked ()
- (eq gds-status 'waiting-for-input))
+ (eq (gds-client-ref 'gds-status) 'waiting-for-input))
(defvar gds-delayed-update-timer nil)
(t
(error "Bad GDS view %S" view)))
;; Finish off.
- (widget-setup)
(force-mode-line-update t)))
(defun gds-update-buffers-in-a-while ()
(setq gds-delayed-update-timer
(run-at-time 0.5 nil (function gds-update-delayed-update-buffers)))))
-(defun gds-display-buffers ()
- (if gds-focus-client
- (let ((gds-focus-buffer (cdr (assq gds-focus-client gds-buffers))))
- ;; If there's already a window showing the buffer, use it.
- (let ((window (get-buffer-window gds-focus-buffer t)))
- (if window
- (progn
- (make-frame-visible (window-frame window))
- (select-frame (window-frame window))
- (select-window window))
- ;(select-window (display-buffer gds-focus-buffer))
- (display-buffer gds-focus-buffer)))
- ;; If there is an associated source buffer, display it as well.
- (if (and (eq (car gds-views) 'stack)
- gds-frame-source-overlay
- (> (overlay-end gds-frame-source-overlay) 0))
- (let ((window (display-buffer
- (overlay-buffer gds-frame-source-overlay))))
- (set-window-point window
- (overlay-start gds-frame-source-overlay)))))))
+(defun gds-display-buffers (client)
+ (let ((buf (cdr (assq client gds-buffers))))
+ ;; 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-frame (window-frame window))
+ (select-window window))
+ ;;(select-window (display-buffer buf))
+ (display-buffer buf)))
+ ;; If there is an associated source buffer, display it as well.
+ (if (and (eq (car gds-views) 'stack)
+ gds-frame-source-overlay
+ (> (overlay-end gds-frame-source-overlay) 1))
+ (let ((window (display-buffer
+ (overlay-buffer gds-frame-source-overlay))))
+ (set-window-point window
+ (overlay-start gds-frame-source-overlay))))))
;;;; Management of `views'.
"The exception keys for which to debug a GDS client.")
(make-variable-buffer-local 'gds-exception-keys)
+(defvar gds-evals-in-progress nil
+ "Alist describing evaluations in progress.")
+(make-variable-buffer-local 'gds-evals-in-progress)
+
+(defvar gds-results nil
+ "Last help or evaluation results.")
+(make-variable-buffer-local 'gds-results)
+
+(defcustom gds-heading-face 'info-menu-header
+ "*Face used for headings in Guile Interaction buffers."
+ :type 'face
+ :group 'gds)
+
(defun gds-insert-interaction ()
(erase-buffer)
;; Insert stuff for interacting with a running (non-blocked) Guile
;; client.
- (widget-insert (buffer-name)
- ", "
+ (gds-heading-insert (buffer-name))
+ (widget-insert " "
(cdr (assq gds-status
'((running . "running (cannot accept input)")
(waiting-for-input . "waiting for input")
(closed . "closed"))))
", in "
gds-current-module
- "\n")
+ "\n\n")
(widget-create 'push-button
:notify (function gds-sigint)
"SIGINT")
(widget-create 'editable-field
:notify (function gds-set-exception-keys)
gds-exception-keys)
- (widget-insert "\n"))
+ ;; Evaluation report area.
+ (widget-insert "\n")
+ (gds-heading-insert "Recent Evaluations")
+ (widget-insert " To run an evaluation, see the Guile->Evaluate menu.\n")
+ (if gds-results
+ (widget-insert "\n" (cdr gds-results)))
+ (let ((evals gds-evals-in-progress))
+ (while evals
+ (widget-insert "\n" (cddar evals) " - running ")
+ (let ((w (widget-create 'push-button
+ :notify (function gds-interrupt-eval)
+ "Interrupt")))
+ (widget-put w :thread-number (caar evals)))
+ (widget-insert "\n")
+ (setq evals (cdr evals)))))
+
+(defun gds-heading-insert (text)
+ (let ((start (point)))
+ (widget-insert text)
+ (let ((o (make-overlay start (point))))
+ (overlay-put o 'face gds-heading-face)
+ (overlay-put o 'evaporate t))))
(defun gds-sigint (w &rest ignore)
(interactive)
(defun gds-async-break (w &rest ignore)
(interactive)
- (gds-send "async-break" gds-focus-client))
+ (gds-send "async-break" gds-client))
+
+(defun gds-interrupt-eval (w &rest ignore)
+ (interactive)
+ (gds-send (format "interrupt-eval %S" (widget-get w :thread-number))
+ gds-client))
(defun gds-toggle-debug-exceptions (w &rest ignore)
(interactive)
(let* ((s (widget-value widget))
(ind (memq 'index (text-properties-at 0 s))))
(gds-send (format "debugger-command frame %d" (cadr ind))
- gds-focus-client)))
+ gds-client)))
;; Overlay used to highlight the source expression corresponding to
;; the selected frame.
(defun gds-query-modules ()
(interactive)
- (gds-send "query-modules" gds-focus-client))
+ (gds-send "query-modules" gds-client))
(defun gds-view-browser ()
(interactive)
(defun gds-go ()
(interactive)
- (gds-send "debugger-command continue" gds-focus-client))
+ (gds-send "debugger-command continue" gds-client))
(defun gds-next ()
(interactive)
- (gds-send "debugger-command next 1" gds-focus-client))
+ (gds-send "debugger-command next 1" gds-client))
(defun gds-evaluate (expr)
(interactive "sEvaluate (in this stack frame): ")
(gds-send (format "debugger-command evaluate %s" (prin1-to-string expr))
- gds-focus-client))
+ gds-client))
(defun gds-step-in ()
(interactive)
- (gds-send "debugger-command step 1" gds-focus-client))
+ (gds-send "debugger-command step 1" gds-client))
(defun gds-step-out ()
(interactive)
- (gds-send "debugger-command finish" gds-focus-client))
+ (gds-send "debugger-command finish" gds-client))
(defun gds-trace-finish ()
(interactive)
- (gds-send "debugger-command trace-finish" gds-focus-client))
+ (gds-send "debugger-command trace-finish" gds-client))
(defun gds-frame-info ()
(interactive)
- (gds-send "debugger-command info-frame" gds-focus-client))
+ (gds-send "debugger-command info-frame" gds-client))
(defun gds-frame-args ()
(interactive)
- (gds-send "debugger-command info-args" gds-focus-client))
+ (gds-send "debugger-command info-args" gds-client))
+
+(defun gds-debug-trap-hooks ()
+ (interactive)
+ (gds-send "debugger-command debug-trap-hooks" gds-client))
+
+(defun gds-up ()
+ (interactive)
+ (gds-send "debugger-command up 1" gds-client))
+
+(defun gds-down ()
+ (interactive)
+ (gds-send "debugger-command down 1" gds-client))
;;;; Setting breakpoints.
module
sym
behaviour)
- gds-focus-client))))
+ gds-client))))
;;;; Scheme source breakpoints.
;; connection, receive the result and any output generated through the
;; same connection, and display the result and output to the user.
;;
-;; Where there are multiple Guile applications known to GDS, GDS by
-;; default sends code to the one that holds the debugging focus,
-;; i.e. `gds-focus-client'. Where no application has the focus,
-;; or the command is invoked with `C-u', GDS asks the user which
-;; application is intended.
+;; For each buffer where evaluations can be requested, GDS uses the
+;; buffer-local variable `gds-client' to track which GDS client
+;; program should receive and handle that buffer's evaluations. In
+;; the common case where GDS is only managing one client program, a
+;; buffer's value of `gds-client' is set automatically to point to
+;; that program the first time that an evaluation (or help or
+;; completion) is requested. If there are multiple GDS clients
+;; running at that time, GDS asks the user which one is intended.
(defun gds-read-client ()
- (let* ((def (if gds-focus-client
- (cdr (assq gds-focus-client gds-names))))
+ (let* ((def (and gds-client (cdr (assq gds-client gds-names))))
(prompt (if def
(concat "Application for eval (default "
def
client)))
(defun gds-choose-client (client)
+ ;; Only keep the supplied client number if it is still valid.
+ (if (integerp client)
+ (setq client (gds-client-ref 'gds-client client)))
+ ;; Only keep the current buffer's setting of `gds-client' if it is
+ ;; still valid.
+ (if gds-client
+ (setq gds-client (gds-client-ref 'gds-client)))
+
(or ;; If client is an integer, it is the port number of the
;; intended client.
- (if (integerp client) client)
+ (if (integerp client)
+ client)
;; Any other non-nil value indicates invocation with a prefix
;; arg, which forces asking the user which application is
;; intended.
- (if client (gds-read-client))
- ;; If ask not forced, and there is a client with the focus,
- ;; default to that one.
- gds-focus-client
- ;; If there are no clients at this point, and we are allowed to
- ;; autostart a captive Guile, do so.
+ (if client
+ (setq gds-client (gds-read-client)))
+ ;; If ask not forced, and current buffer is associated with a
+ ;; client, use that client.
+ gds-client
+ ;; If there are no clients at this point, and we are
+ ;; allowed to autostart a captive Guile, do so.
(and (null gds-buffers)
gds-autostart-captive
(progn
(while (null gds-buffers)
(accept-process-output (get-buffer-process gds-captive)
0 100000))
- (caar gds-buffers)))
+ (setq gds-client (caar gds-buffers))))
;; If there is only one known client, use that one.
(if (and (car gds-buffers)
(null (cdr gds-buffers)))
- (caar gds-buffers))
+ (setq gds-client (caar gds-buffers)))
;; Last resort - ask the user.
- (gds-read-client)
+ (setq gds-client (gds-read-client))
;; Signal an error.
(error "No application chosen.")))
(setq column (current-column)) ; 0-based
(beginning-of-line)
(setq line (count-lines (point-min) (point)))) ; 0-based
- (gds-send (format "eval region %s %S %d %d %s %S"
- (if module (prin1-to-string module) "#f")
- port-name line column
- (let ((bpinfo (gds-region-breakpoint-info start end)))
- ;; Make sure that "no bpinfo" is represented
- ;; as "()", not "nil", as Scheme doesn't
- ;; understand "nil".
- (if bpinfo (format "%S" bpinfo) "()"))
- (buffer-substring-no-properties start end))
- client)))
+ (let ((code (buffer-substring-no-properties start end)))
+ (gds-send (format "eval (region . %S) %s %S %d %d %s %S"
+ (gds-abbreviated code)
+ (if module (prin1-to-string module) "#f")
+ port-name line column
+ (let ((bpinfo (gds-region-breakpoint-info start end)))
+ ;; Make sure that "no bpinfo" is represented
+ ;; as "()", not "nil", as Scheme doesn't
+ ;; understand "nil".
+ (if bpinfo (format "%S" bpinfo) "()"))
+ code)
+ client))))
(defun gds-eval-expression (expr &optional client correlator)
"Evaluate the supplied EXPR (a string)."
(interactive "sEvaluate expression: \nP")
(setq client (gds-choose-client client))
- (gds-send (format "eval %S #f \"Emacs expression\" 0 0 () %S"
+ (set-text-properties 0 (length expr) nil expr)
+ (gds-send (format "eval (%S . %S) #f \"Emacs expression\" 0 0 () %S"
(or correlator 'expression)
+ (gds-abbreviated expr)
expr)
client))
+(defconst gds-abbreviated-length 35)
+
+(defun gds-abbreviated (code)
+ (let ((nlpos (string-match (regexp-quote "\n") code)))
+ (while nlpos
+ (setq code
+ (if (= nlpos (- (length code) 1))
+ (substring code 0 nlpos)
+ (concat (substring code 0 nlpos)
+ "\\n"
+ (substring code (+ nlpos 1)))))
+ (setq nlpos (string-match (regexp-quote "\n") code))))
+ (if (> (length code) gds-abbreviated-length)
+ (concat (substring code 0 (- gds-abbreviated-length 3)) "...")
+ code))
+
(defun gds-eval-defun (&optional client)
"Evaluate the defun (top-level form) at point."
(interactive "P")
"Guile apropos (regexp): ")))
(list (if (zerop (length val)) sym val)
current-prefix-arg)))
+ (set-text-properties 0 (length regex) nil regex)
(gds-eval-expression (format "(apropos %S)" regex) client 'help))
(defvar gds-completion-results nil)
;;;; Display of evaluation and help results.
(defun gds-display-results (client correlator results)
- (let ((helpp (eq correlator 'help)))
+ (let ((helpp (eq (car correlator) 'help)))
(let ((buf (get-buffer-create (if helpp
"*Guile Help*"
"*Guile Results*"))))
- (save-excursion
- (set-buffer buf)
- (erase-buffer)
- (scheme-mode)
- (while results
- (insert (car results))
- (if helpp
- nil
- (mapcar (function (lambda (value)
- (insert " => " value "\n")))
- (cadr results))
- (insert "\n"))
- (setq results (cddr results)))
- (goto-char (point-min))
- (if (and helpp (looking-at "Evaluating in "))
- (delete-region (point) (progn (forward-line 1) (point)))))
- (pop-to-buffer buf)
- (run-hooks 'temp-buffer-show-hook)
- (other-window 1))))
+ (setq gds-results
+ (save-excursion
+ (set-buffer buf)
+ (erase-buffer)
+ (scheme-mode)
+ (insert (cdr correlator) "\n\n")
+ (while results
+ (insert (car results))
+ (or (bolp) (insert "\\\n"))
+ (if helpp
+ nil
+ (if (cadr results)
+ (mapcar (function (lambda (value)
+ (insert " => " value "\n")))
+ (cadr results))
+ (insert " => no (or unspecified) value\n"))
+ (insert "\n"))
+ (setq results (cddr results)))
+ (goto-char (point-min))
+ (if (and helpp (looking-at "Evaluating in "))
+ (delete-region (point) (progn (forward-line 1) (point))))
+ (cons correlator (buffer-string))))
+ ;;(pop-to-buffer buf)
+ ;;(run-hooks 'temp-buffer-show-hook)
+ ;;(other-window 1)
+ ))
+ (gds-promote-view 'interaction)
+ (gds-request-focus client))
;;;; Loading (evaluating) a whole Scheme file.
(define-key scheme-mode-map "\C-x\e " 'gds-delete-source-breakpoint)
-;;;; GDS (Guile Interaction) mode keymap and menu items.
-
-(set-keymap-parent gds-mode-map widget-keymap)
+;;;; Guile Interaction mode keymap and menu items.
(define-key gds-mode-map "M" (function gds-query-modules))
(define-key gds-mode-map "t" (function gds-trace-finish))
(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 "H" (function gds-debug-trap-hooks))
+(define-key gds-mode-map "u" (function gds-up))
+(define-key gds-mode-map "d" (function gds-down))
(define-key gds-mode-map "b" (function gds-set-breakpoint))
(define-key gds-mode-map "vi" (function gds-view-interaction))
(setq gds-debug-menu (make-sparse-keymap "Debug"))
(define-key gds-debug-menu [go]
'(menu-item "Go" gds-go))
+ (define-key gds-debug-menu [down]
+ '(menu-item "Move Down 1 Frame" gds-down))
+ (define-key gds-debug-menu [up]
+ '(menu-item "Move Up 1 Frame" gds-up))
(define-key gds-debug-menu [trace-finish]
'(menu-item "Trace This Frame" gds-trace-finish))
(define-key gds-debug-menu [step-out]
(define-key gds-menu [view]
`(menu-item "View" ,gds-view-menu :enable gds-views))
(define-key gds-menu [debug]
- `(menu-item "Debug" ,gds-debug-menu :enable (and gds-focus-client
+ `(menu-item "Debug" ,gds-debug-menu :enable (and gds-client
(gds-client-blocked))))
(define-key gds-menu [breakpoint]
`(menu-item "Breakpoints" ,gds-breakpoint-menu :enable t))
:type 'boolean
:group 'gds)
-(if (and gds-autostart-server
- (not gds-process))
- (gds-start))
-
;;;; `Captive' Guile - a Guile process that is started when needed to
;;;; provide help, completion, evaluations etc.
nil
(let ((process-connection-type nil))
(setq gds-captive (make-comint "captive-guile"
- "guile"
+ gds-guile-program
nil
"-q")))
(let ((proc (get-buffer-process gds-captive)))
+ (process-kill-without-query proc)
(comint-send-string proc "(set! %load-path (cons \"/home/neil/Guile/cvs/guile-core\" %load-path))\n")
(comint-send-string proc "(debug-enable 'backtrace)\n")
(comint-send-string proc "(use-modules (emacs gds-client))\n")
(defun gds-kill-captive ()
(if gds-captive
- (let ((proc (get-buffer-process gds-captive)))
- (process-kill-without-query proc)
- (condition-case nil
- (progn
- (kill-process proc)
- (accept-process-output gds-process 0 200))
- (error)))))
+ (condition-case nil
+ (progn
+ (kill-process (get-buffer-process gds-captive))
+ (accept-process-output gds-process 0 200))
+ (error))))
+
+
+;;;; If requested, autostart the server after loading.
+
+(if (and gds-autostart-server
+ (not gds-process))
+ (gds-start))
;;;; The end!
HCoop / bpt / guile.git / blobdiff