/[guile]/guile/guile-core/ice-9/debugger/ui-client.scm
ViewVC logotype

Diff of /guile/guile-core/ice-9/debugger/ui-client.scm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.3 by ossau, Mon Oct 6 20:33:02 2003 UTC revision 1.4 by ossau, Thu Oct 16 11:53:58 2003 UTC
# Line 40  Line 40 
40  ;; Once connected, the TCP socket port to the UI server.  ;; Once connected, the TCP socket port to the UI server.
41  (define ui-port #f)  (define ui-port #f)
42    
43  (define* (ui-connect name #:optional host)  (define* (ui-connect name debug #:optional host)
44    "Connect to the debug UI server as @var{name}, a string that should    "Connect to the debug UI server as @var{name}, a string that should
45  be sufficient to describe the calling application to the debug UI  be sufficient to describe the calling application to the debug UI
46  user.  The optional @var{host} arg specifies the hostname or dotted  user.  The optional @var{host} arg specifies the hostname or dotted
# Line 68  decimal IP address where the UI server i Line 68  decimal IP address where the UI server i
68    ;; Write initial context to debug server.    ;; Write initial context to debug server.
69    (write-form (list 'name name))    (write-form (list 'name name))
70    (write-form (cons 'modules (map module-name (loaded-modules))))    (write-form (cons 'modules (map module-name (loaded-modules))))
71    (debug-stack (make-stack #t ui-connect) #:continuable)    ;; If `debug' is true, debug immediately.
72      (if debug
73          (debug-stack (make-stack #t ui-connect) #:continuable))
74  ;  (ui-command-loop #f)  ;  (ui-command-loop #f)
75    )    )
76    
# Line 286  decimal IP address where the UI server i Line 288  decimal IP address where the UI server i
288                 (with-output-to-string (lambda () (write value))))                 (with-output-to-string (lambda () (write value))))
289               values)))               values)))
290    (let ((value #f))    (let ((value #f))
291      (let ((output      (let* ((do-eval (if m
292             (with-output-to-string                          (lambda ()
293              (lambda ()                            (display "Evaluating in module ")
294                (if m                            (write (module-name m))
295                    (begin                            (newline)
296                      (display "Evaluating in module ")                            (set! value
297                      (write (module-name m))                                  (call-with-values (lambda ()
298                      (newline)                                                      (eval x m))
299                      (set! value                                    value-consumer)))
300                            (call-with-values (lambda () (eval x m))                          (lambda ()
301                              value-consumer)))                            (display "Evaluating in current module ")
302                    (begin                            (write (module-name (current-module)))
303                      (display "Evaluating in current module ")                            (newline)
304                      (write (module-name (current-module)))                            (set! value
305                      (newline)                                  (call-with-values (lambda ()
306                      (set! value                                                      (primitive-eval x))
307                            (call-with-values (lambda () (primitive-eval x))                                    value-consumer)))))
308                              value-consumer))))))))             (output
309                (with-output-to-string
310                 (lambda ()
311                   (catch #t
312                          do-eval
313                          (lambda (key . args)
314                            (case key
315                              ((misc-error signal unbound-variable
316                                numerical-overflow)
317                               (apply display-error #f
318                                      (current-output-port) args)
319                               (set! value '("error-in-evaluation")))
320                              (else
321                               (display "EXCEPTION: ")
322                               (display key)
323                               (display " ")
324                               (write args)
325                               (newline)
326                               (set! value
327                                     '("unhandled-exception-in-evaluation"))))))))))
328        (list output value))))        (list output value))))
329    
330  (define (write-status status)  (define (write-status status)

Legend:
Removed from v.1.3  
changed lines
  Added in v.1.4

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26