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

Diff of /guile/guile-core/ice-9/debugger/behaviour.scm

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

revision 1.2 by mvo, Sat Apr 5 19:06:32 2003 UTC revision 1.3 by ossau, Thu Sep 25 20:29:24 2003 UTC
# Line 88  Line 88 
88  (define (debug-if-flag-set)  (define (debug-if-flag-set)
89    (if *debug-flag*    (if *debug-flag*
90        (begin        (begin
91          (for-each display (reverse! *debug-entry-messages*))          (for-each (lambda (msg)
92                        (display msg (debugger-output-port)))
93                      (reverse! *debug-entry-messages*))
94          (set! *debug-entry-messages* '())          (set! *debug-entry-messages* '())
95          (debug-stack (make-stack *cont*) #:continuable))))          (debug-stack (make-stack *cont*) #:continuable))))
96    
# Line 99  Line 101 
101  (add-hook! after-exit-frame-hook  (add-hook! after-exit-frame-hook
102             (lambda ()             (lambda ()
103               (if *trace-retval*               (if *trace-retval*
104                   (begin                   (with-output-to-port (debugger-output-port)
105                     (let indent ((td *trace-depths*))                     (lambda ()
106                       (cond ((null? td))                       (let indent ((td *trace-depths*))
107                             (else (display "|  ")                         (cond ((null? td))
108                                   (indent (cdr td)))))                               (else (display "|  ")
109                     (display "|  ")                                     (indent (cdr td)))))
110                     (write *retval*)                       (display "|  ")
111                     (newline)                       (write *retval*)
112                     (set! *trace-retval* #f)))                       (newline)
113                         (set! *trace-retval* #f))))
114               (debug-if-flag-set)))               (debug-if-flag-set)))
115    
116  (define (frame-depth frame)  (define (frame-depth frame)
# Line 250  Line 253 
253                         (else (loop (+ frame-number 1)))))))                         (else (loop (+ frame-number 1)))))))
254          (if push-current-depth          (if push-current-depth
255              (set! *trace-depths* (cons *depth* *trace-depths*)))              (set! *trace-depths* (cons *depth* *trace-depths*)))
256          (let indent ((td *trace-depths*))          (with-output-to-port (debugger-output-port)
257            (cond ((null? td))            (lambda ()
258                  (else              (let indent ((td *trace-depths*))
259                   (display "|  ")                (cond ((null? td))
260                   (indent (cdr td)))))                      (else
261          ((if *expr*                       (display "|  ")
262               write-frame-short/expression                       (indent (cdr td)))))
263               write-frame-short/application) *frame*)              ((if *expr*
264          (newline)                   write-frame-short/expression
265                     write-frame-short/application) *frame*)
266                (newline)))
267          (if push-current-depth          (if push-current-depth
268              (at-exit (lambda ()              (at-exit (lambda ()
269                         (set! *trace-depths* (cdr *trace-depths*))                         (set! *trace-depths* (cdr *trace-depths*))

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

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