suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

merged mztake 205:206 from /plt/branches/gmarceau/mztake

Browse Source 
svn: r207
This commit is contained in:
Guillaume Marceau 2005-06-17 01:27:58 +00:00
parent 357ee29e7f
commit 4e9be63437
2 changed files with 22 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

29
collects/mztake/debug-tool.ss
View File

@ -15,7 +15,8 @@
(lib "annotator.ss" "mztake") (lib "annotator.ss" "mztake")
(lib "load-annotator.ss" "mztake" "private") (lib "load-annotator.ss" "mztake" "private")
;(lib "framework.ss" "framework") ;(lib "framework.ss" "framework")
#;(lib "string-constant.ss" "string-constants")) #;(lib "string-constant.ss" "string-constants")
)
(provide tool@) (provide tool@)
@ -203,7 +204,8 @@
(let* ([frames (send parent get-stack-frames)] (let* ([frames (send parent get-stack-frames)]
[pos-vec (send parent get-pos-vec)] [pos-vec (send parent get-pos-vec)]
[id (vector-ref pos-vec pos)] [id (vector-ref pos-vec pos)]
#;[_ (printf "frames = ~a~npos-vec = ~a~nid = ~a~n" #;
[_ (printf "frames = ~a~npos-vec = ~a~nid = ~a~n"
frames pos-vec id)]) frames pos-vec id)])
(send parent (send parent
set-mouse-over-msg set-mouse-over-msg
@ -215,7 +217,8 @@
(lambda (id2) (module-identifier=? id id2)) (lambda (id2) (module-identifier=? id id2))
frames (lambda () frames (lambda ()
(k #f (k #f
#;(format "~a = ~a" id-sym #;
(format "~a = ~a" id-sym
(namespace-variable-value (namespace-variable-value
id-sym id-sym
#f #f
@ -289,7 +292,8 @@
(let* ([frames (send parent get-stack-frames)] (let* ([frames (send parent get-stack-frames)]
[pos-vec (send parent get-pos-vec)] [pos-vec (send parent get-pos-vec)]
[id (vector-ref pos-vec pos)] [id (vector-ref pos-vec pos)]
#;[_ (printf "frames = ~a~npos-vec = ~a~nid = ~a~n" #;
[_ (printf "frames = ~a~npos-vec = ~a~nid = ~a~n"
frames pos-vec id)]) frames pos-vec id)])
(unless (and (unless (and
id frames id frames
@ -349,7 +353,8 @@
(send dc set-brush bp-tmp-brush)]) (send dc set-brush bp-tmp-brush)])
;(drscheme:arrow:draw-arrow dc xl yl xr yr dx dy) ;(drscheme:arrow:draw-arrow dc xl yl xr yr dx dy)
(send dc draw-ellipse (+ xl dx) (+ yl dy yoff) diameter diameter) (send dc draw-ellipse (+ xl dx) (+ yl dy yoff) diameter diameter)
#;(send dc draw-polygon stop-sign #;
(send dc draw-polygon stop-sign
(+ xl dx) (+ xl dx)
(+ yl dy 2)) (+ yl dy 2))
(send dc set-pen op) (send dc set-pen op)
@ -368,7 +373,8 @@
[else (send dc set-pen pc-pen) [else (send dc set-pen pc-pen)
(send dc set-brush pc-brush)])) (send dc set-brush pc-brush)]))
(drscheme:arrow:draw-arrow dc xl ym xr ym dx dy)) (drscheme:arrow:draw-arrow dc xl ym xr ym dx dy))
#;(let loop ([end-pos pos] #;
(let loop ([end-pos pos]
[marks (send parent get-stack-frames)]) [marks (send parent get-stack-frames)])
(when (cons? marks) (when (cons? marks)
(let*-values ([(start-pos) (syntax-position (mark-source (first marks)))] (let*-values ([(start-pos) (syntax-position (mark-source (first marks)))]
@ -510,8 +516,7 @@
get-definitions-text get-definitions-text
get-interactions-text get-interactions-text
get-menu-bar get-menu-bar
;; break-callback TODO get-current-tab
;; reset-offer-kill
get-top-level-window) get-top-level-window)
(define breakpoints (make-hash-table)) (define breakpoints (make-hash-table))
@ -639,7 +644,8 @@
(alignment '(center center)) (alignment '(center center))
(style '(border)))) (style '(border))))
(send debug-parent-panel change-children (lambda (l) null)) (send debug-parent-panel change-children (lambda (l) null))
#;(instantiate button% () #;
(instantiate button% ()
(label "Hide") (label "Hide")
(parent debug-panel) (parent debug-panel)
(callback (lambda (x y) (hide-debug))) (callback (lambda (x y) (hide-debug)))
@ -684,9 +690,8 @@
(bell) (bell)
(begin (begin
(set! want-suspend-on-break? #t) (set! want-suspend-on-break? #t)
;; (break-callback) (send (get-current-tab) break-callback)
;; (reset-offer-kill) (send (get-current-tab) reset-offer-kill))))]
)))]
[enabled #t])) [enabled #t]))
(define resume-button (define resume-button

10
collects/mztake/info.ss
View File

@ -1,7 +1,7 @@
(module info (lib "infotab.ss" "setup") (module info (lib "infotab.ss" "setup")
(define name "Debugger") (define name "MzTake Debugger")
#;(define tools '(#;("mztake-lang.ss") ("debug-tool.ss"))) (define tools '(("debug-tool.ss")))
(define blurb '("MzTake is a scripted debugger for PLT Scheme." "A debugging tool for DrScheme")) (define blurb '("MzTake is a scripted debugger for PLT Scheme."))
#;(define tool-names '(#;"MzTake Debugger" "Skipper")) (define tool-names '("MzTake Debugger"))
#;(define tool-icons '(#;("emblem-ohno.png" "mztake" "icons") ("icon-big.png" "mztake" "icons"))) (define tool-icons '(("emblem-ohno.png" "mztake" "icons")))
) )