mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-04-29 19:30:36 +02:00
* gds.el (gds-handle-client-input): Handle new `thread-status'
protocol. (gds-display-slow-eval): New. (gds-client-ref): Bugfix: buf -> (cdr buf). (gds-display-buffers): Bugfix: minimum overlay end value is 1, not 0. (gds-evals-in-progress): New. (gds-results): New. (gds-insert-interaction): Show evaluations in progress (with button to interrupt them) and results of last help or evaluation. (gds-interrupt-eval): New. (gds-debug-trap-hooks, gds-up, gds-down): New. (gds-eval-region, gds-eval-expression): Include abbreviated code in eval correlator. (gds-abbreviated-length, gds-abbreviated): New. (gds-mode-map): New keys for gds-debug-trap-hooks, gds-up, gds-down. (gds-debug-menu): New menu entries for gds-up, gds-down. * gds-client.scm (gds-connect): Enable trapping for gds-eval stacks. (ui-read-thread-proc): Write 'running status earlier. (stack->emacs-readable): Limit stack length to 'depth debug option. (handle-instruction): Update format of eval correlator. (handle-instruction-1): Resolve module names from root module instead of from current module. (resolve-module-from-root): New. (handle-instruction-1): New protocol `interrupt-eval'. (eval-thread-table): New. (eval-thread): Add thread to eval-thread-table; write new protocol to frontend to communicate eval thread status; update for new correlator format; bind correlator local before entering loop2. (gds-eval): Use start-stack 'gds-eval-stack to rebase stack. * gds.el (gds-start, gds-start-captive): Do `process-kill-without-query' as soon as processes started, ... (gds-shutdown, gds-kill-captive): ... instead of here. (gds-display-results): More clearly show unspecified results; show results in interaction view instead of in separate window. (gds-send): Add sent protocol to transcript.
This commit is contained in:
Neil Jerram
parent
328df3e3be
commit
15e6a33592
4 changed files with 240 additions and 59 deletions
|
|
@ -1,2 +1,6 @@
|
|||
Makefile
|
||||
Makefile.in
|
||||
version.texi
|
||||
*.info
|
||||
stamp-vti
|
||||
mdate-sh
|
||||
|
|
|
|||
|
|
@ -1,3 +1,47 @@
|
|||
2004-01-28 Neil Jerram <neil@ossau.uklinux.net>
|
||||
|
||||
* gds.el (gds-handle-client-input): Handle new `thread-status'
|
||||
protocol.
|
||||
(gds-display-slow-eval): New.
|
||||
(gds-client-ref): Bugfix: buf -> (cdr buf).
|
||||
(gds-display-buffers): Bugfix: minimum overlay end value is 1, not
|
||||
0.
|
||||
(gds-evals-in-progress): New.
|
||||
(gds-results): New.
|
||||
(gds-insert-interaction): Show evaluations in progress (with
|
||||
button to interrupt them) and results of last help or evaluation.
|
||||
(gds-interrupt-eval): New.
|
||||
(gds-debug-trap-hooks, gds-up, gds-down): New.
|
||||
(gds-eval-region, gds-eval-expression): Include abbreviated code
|
||||
in eval correlator.
|
||||
(gds-abbreviated-length, gds-abbreviated): New.
|
||||
(gds-mode-map): New keys for gds-debug-trap-hooks, gds-up,
|
||||
gds-down.
|
||||
(gds-debug-menu): New menu entries for gds-up, gds-down.
|
||||
|
||||
* gds-client.scm (gds-connect): Enable trapping for gds-eval
|
||||
stacks.
|
||||
(ui-read-thread-proc): Write 'running status earlier.
|
||||
(stack->emacs-readable): Limit stack length to 'depth debug
|
||||
option.
|
||||
(handle-instruction): Update format of eval correlator.
|
||||
(handle-instruction-1): Resolve module names from root module
|
||||
instead of from current module.
|
||||
(resolve-module-from-root): New.
|
||||
(handle-instruction-1): New protocol `interrupt-eval'.
|
||||
(eval-thread-table): New.
|
||||
(eval-thread): Add thread to eval-thread-table; write new protocol
|
||||
to frontend to communicate eval thread status; update for new
|
||||
correlator format; bind correlator local before entering loop2.
|
||||
(gds-eval): Use start-stack 'gds-eval-stack to rebase stack.
|
||||
|
||||
* gds.el (gds-start, gds-start-captive): Do
|
||||
`process-kill-without-query' as soon as processes started, ...
|
||||
(gds-shutdown, gds-kill-captive): ... instead of here.
|
||||
(gds-display-results): More clearly show unspecified results; show
|
||||
results in interaction view instead of in separate window.
|
||||
(gds-send): Add sent protocol to transcript.
|
||||
|
||||
2004-01-26 Neil Jerram <neil@ossau.uklinux.net>
|
||||
|
||||
* gds.el (gds-request-focus, gds-quit): Simplify. Old algorithm
|
||||
|
|
|
|||
|
|
@ -23,6 +23,7 @@
|
|||
#:use-module (ice-9 debugger breakpoints procedural)
|
||||
#:use-module (ice-9 debugger breakpoints source)
|
||||
#:use-module (ice-9 debugger state)
|
||||
#:use-module (ice-9 debugger trap-hooks)
|
||||
#:use-module (ice-9 debugger utils)
|
||||
#:use-module (ice-9 optargs)
|
||||
#:use-module (ice-9 regex)
|
||||
|
|
@ -101,6 +102,7 @@ decimal IP address where the UI server is running; default is
|
|||
"w"))
|
||||
;; Announce ourselves to the server.
|
||||
(write-form (list 'name name (getpid)))
|
||||
(add-trapped-stack-id! 'gds-eval-stack)
|
||||
;; Start the UI read thread.
|
||||
(set! ui-read-thread (make-thread ui-read-thread-proc)))
|
||||
|
||||
|
|
@ -124,6 +126,7 @@ decimal IP address where the UI server is running; default is
|
|||
;; this purpose. This design avoids having to modify application code
|
||||
;; at the expense of requiring a Guile with threads support.
|
||||
(define (ui-read-thread-proc)
|
||||
(write-status 'running)
|
||||
(let ((eval-thread-needed? #t))
|
||||
;; Start up the default eval thread.
|
||||
(make-thread eval-thread 1 (lambda () (not eval-thread-needed?)))
|
||||
|
|
@ -269,7 +272,8 @@ decimal IP address where the UI server is running; default is
|
|||
;; Return Emacs-readable representation of STACK.
|
||||
(map (lambda (index)
|
||||
(frame->emacs-readable (stack-ref stack index)))
|
||||
(iota (stack-length stack))))
|
||||
(iota (min (stack-length stack)
|
||||
(cadr (memq 'depth (debug-options)))))))
|
||||
|
||||
(define (frame->emacs-readable frame)
|
||||
;; Return Emacs-readable representation of FRAME.
|
||||
|
|
@ -336,7 +340,7 @@ decimal IP address where the UI server is running; default is
|
|||
(apply throw key args))
|
||||
(else
|
||||
(write-form
|
||||
`(eval-results error
|
||||
`(eval-results (error . "")
|
||||
"GDS Internal Error\n"
|
||||
,(list (with-output-to-string
|
||||
(lambda ()
|
||||
|
|
@ -373,7 +377,7 @@ decimal IP address where the UI server is running; default is
|
|||
,(or (loaded-module-source name) "(no source file)")
|
||||
,@(sort (module-map (lambda (key value)
|
||||
(symbol->string key))
|
||||
(resolve-module name))
|
||||
(resolve-module-from-root name))
|
||||
string<?))))
|
||||
state)
|
||||
((debugger-command)
|
||||
|
|
@ -397,7 +401,7 @@ decimal IP address where the UI server is running; default is
|
|||
(display (cadddr ins))
|
||||
(display "' behaviour; doing `debug-here' instead.\n")
|
||||
(debug-here))))
|
||||
(module-ref (resolve-module (cadr ins)) (caddr ins)))
|
||||
(module-ref (resolve-module-from-root (cadr ins)) (caddr ins)))
|
||||
state)
|
||||
((eval)
|
||||
(apply (lambda (correlator module port-name line column bpinfo code)
|
||||
|
|
@ -406,7 +410,7 @@ decimal IP address where the UI server is running; default is
|
|||
(set-port-filename! (current-input-port) port-name)
|
||||
(set-port-line! (current-input-port) line)
|
||||
(set-port-column! (current-input-port) column)
|
||||
(let ((m (and module (resolve-module module))))
|
||||
(let ((m (and module (resolve-module-from-root module))))
|
||||
(let loop ((exprs '()) (x (read)))
|
||||
(if (eof-object? x)
|
||||
;; Expressions to be evaluated have all been
|
||||
|
|
@ -468,11 +472,23 @@ decimal IP address where the UI server is running; default is
|
|||
(debug-stack (make-stack #t 3) #:continuable))
|
||||
thread))
|
||||
state)
|
||||
((interrupt-eval)
|
||||
(let ((thread (hash-ref eval-thread-table (cadr ins))))
|
||||
(system-async-mark (lambda ()
|
||||
(debug-stack (make-stack #t 3) #:continuable))
|
||||
thread))
|
||||
state)
|
||||
(else state)))
|
||||
|
||||
(define the-ice-9-debugger-commands-module
|
||||
(resolve-module '(ice-9 debugger commands)))
|
||||
|
||||
(define (resolve-module-from-root name)
|
||||
(save-module-excursion
|
||||
(lambda ()
|
||||
(set-current-module the-root-module)
|
||||
(resolve-module name))))
|
||||
|
||||
|
||||
;;;; {Module Browsing}
|
||||
|
||||
|
|
@ -565,12 +581,19 @@ decimal IP address where the UI server is running; default is
|
|||
(set! count (+ count 1))
|
||||
count)))
|
||||
|
||||
(define eval-thread-table (make-hash-table 3))
|
||||
|
||||
(define (eval-thread depth thread-should-exit-thunk)
|
||||
;; Acquire mutex to check trigger variables.
|
||||
(with-mutex eval-work-mutex
|
||||
(let ((thread-number (next-thread-number)))
|
||||
;; Add this thread to global hash, so we can correlate back to
|
||||
;; this thread from the ID used by the GDS front end.
|
||||
(hash-set! eval-thread-table thread-number (current-thread))
|
||||
(trc 'eval-thread depth thread-number "entering loop")
|
||||
(let loop ()
|
||||
;; Tell the front end this thread is ready.
|
||||
(write-form `(thread-status eval ,thread-number ready))
|
||||
(cond ((thread-should-exit-thunk)
|
||||
;; Allow thread to exit.
|
||||
)
|
||||
|
|
@ -579,8 +602,11 @@ decimal IP address where the UI server is running; default is
|
|||
;; Take a local copy of the work, reset global
|
||||
;; variables, then do the work with mutex released.
|
||||
(trc 'eval-thread depth thread-number "starting work")
|
||||
(let ((work eval-work)
|
||||
(subthread-needed? #t))
|
||||
(let* ((work eval-work)
|
||||
(subthread-needed? #t)
|
||||
(correlator (car work)))
|
||||
;; Tell the front end this thread is busy.
|
||||
(write-form `(thread-status eval ,thread-number busy ,correlator))
|
||||
(set! eval-work-available #f)
|
||||
(signal-condition-variable eval-work-taken)
|
||||
(without-mutex eval-work-mutex
|
||||
|
|
@ -591,14 +617,12 @@ decimal IP address where the UI server is running; default is
|
|||
(make-thread eval-thread (+ depth 1)
|
||||
(lambda () (not subthread-needed?)))
|
||||
;; Do the evaluation(s).
|
||||
(let loop2 ((correlator (car work))
|
||||
(m (cadr work))
|
||||
(let loop2 ((m (cadr work))
|
||||
(exprs (cddr work))
|
||||
(results '()))
|
||||
(if (null? exprs)
|
||||
(write-form `(eval-results ,correlator ,@results))
|
||||
(loop2 correlator
|
||||
m
|
||||
(loop2 m
|
||||
(cdr exprs)
|
||||
(append results (gds-eval (car exprs) m))))))
|
||||
(trc 'eval-thread depth thread-number "work done")
|
||||
|
|
@ -615,7 +639,9 @@ decimal IP address where the UI server is running; default is
|
|||
(wait-condition-variable eval-work-changed eval-work-mutex)
|
||||
(trc 'eval-thread depth thread-number "wait done")
|
||||
(loop))))
|
||||
(trc 'eval-thread depth thread-number "exiting"))))
|
||||
(trc 'eval-thread depth thread-number "exiting")
|
||||
;; Tell the front end this thread is ready.
|
||||
(write-form `(thread-status eval ,thread-number exiting)))))
|
||||
|
||||
(define (gds-eval x m)
|
||||
;; Consumer to accept possibly multiple values and present them for
|
||||
|
|
@ -635,7 +661,8 @@ decimal IP address where the UI server is running; default is
|
|||
(newline)
|
||||
(set! value
|
||||
(call-with-values (lambda ()
|
||||
(eval x m))
|
||||
(start-stack 'gds-eval-stack
|
||||
(eval x m)))
|
||||
value-consumer)))
|
||||
(lambda ()
|
||||
(display "Evaluating in current module ")
|
||||
|
|
@ -643,7 +670,8 @@ decimal IP address where the UI server is running; default is
|
|||
(newline)
|
||||
(set! value
|
||||
(call-with-values (lambda ()
|
||||
(primitive-eval x))
|
||||
(start-stack 'gds-eval-stack
|
||||
(primitive-eval x)))
|
||||
value-consumer)))))
|
||||
(output
|
||||
(with-output-to-string
|
||||
|
|
|
|||
195
emacs/gds.el
195
emacs/gds.el
|
|
@ -61,7 +61,8 @@
|
|||
(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 ()
|
||||
|
|
@ -70,7 +71,6 @@
|
|||
;; Reset variables.
|
||||
(setq gds-buffers nil)
|
||||
;; Kill the subprocess.
|
||||
(process-kill-without-query gds-process)
|
||||
(condition-case nil
|
||||
(progn
|
||||
(kill-process gds-process)
|
||||
|
|
@ -104,7 +104,13 @@
|
|||
|
||||
;; 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)))))))
|
||||
|
||||
|
||||
;;;; Focussing in and out on interaction with a particular client.
|
||||
|
|
@ -314,8 +320,38 @@ The function is called with one argument, the CLIENT in question."
|
|||
(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.
|
||||
|
||||
|
|
@ -379,7 +415,7 @@ The function is called with one argument, the CLIENT in question."
|
|||
(and buf
|
||||
(cdr buf)
|
||||
(buffer-live-p (cdr buf))
|
||||
(with-current-buffer buf
|
||||
(with-current-buffer (cdr buf)
|
||||
(symbol-value sym))))))
|
||||
|
||||
(defun gds-client-blocked ()
|
||||
|
|
@ -439,7 +475,7 @@ The function is called with one argument, the CLIENT in question."
|
|||
;; 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))
|
||||
(> (overlay-end gds-frame-source-overlay) 1))
|
||||
(let ((window (display-buffer
|
||||
(overlay-buffer gds-frame-source-overlay))))
|
||||
(set-window-point window
|
||||
|
|
@ -505,6 +541,14 @@ the following symbols.
|
|||
"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)
|
||||
|
||||
(defun gds-insert-interaction ()
|
||||
(erase-buffer)
|
||||
;; Insert stuff for interacting with a running (non-blocked) Guile
|
||||
|
|
@ -534,7 +578,18 @@ the following symbols.
|
|||
(widget-create 'editable-field
|
||||
:notify (function gds-set-exception-keys)
|
||||
gds-exception-keys)
|
||||
(widget-insert "\n"))
|
||||
(let ((evals gds-evals-in-progress))
|
||||
(if evals
|
||||
(widget-insert "\nEvaluations in progress:\n"))
|
||||
(while evals
|
||||
(let ((w (widget-create 'push-button
|
||||
:notify (function gds-interrupt-eval)
|
||||
"Interrupt")))
|
||||
(widget-put w :thread-number (caar evals))
|
||||
(widget-insert " " (cddar evals) "\n"))
|
||||
(setq evals (cdr evals))))
|
||||
(if gds-results
|
||||
(widget-insert "\n" (cdr gds-results))))
|
||||
|
||||
(defun gds-sigint (w &rest ignore)
|
||||
(interactive)
|
||||
|
|
@ -544,6 +599,11 @@ the following symbols.
|
|||
(interactive)
|
||||
(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)
|
||||
(setq gds-debug-exceptions (widget-value w))
|
||||
|
|
@ -815,6 +875,18 @@ are not readable by Emacs.")
|
|||
(interactive)
|
||||
(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.
|
||||
|
||||
|
|
@ -1107,26 +1179,45 @@ region's code."
|
|||
(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"
|
||||
(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")
|
||||
|
|
@ -1219,29 +1310,38 @@ interesting happened, `nil' if not."
|
|||
;;;; 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.
|
||||
|
|
@ -1301,7 +1401,9 @@ Used for determining the default for the next `gds-load-file'.")
|
|||
(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))
|
||||
|
|
@ -1338,6 +1440,10 @@ Used for determining the default for the next `gds-load-file'.")
|
|||
(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]
|
||||
|
|
@ -1464,6 +1570,7 @@ Used for determining the default for the next `gds-load-file'.")
|
|||
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")
|
||||
|
|
@ -1471,13 +1578,11 @@ Used for determining the default for the next `gds-load-file'.")
|
|||
|
||||
(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))))
|
||||
|
||||
|
||||
;;;; The end!
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue