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

macro-stepper: minor cleanups

Browse Source 
svn: r16413

original commit: 74f402c7e2d252373fa35e17c9c8befd2fe6621b
This commit is contained in:
Ryan Culpepper 2009-10-22 20:14:16 +00:00
parent 0db44906c8
commit 31dc3d55b0
4 changed files with 11 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
collects/macro-debugger/syntax-browser/display.ss
View File

@ -51,7 +51,7 @@
(base-style (standard-font text config)) (base-style (standard-font text config))
(start-position insertion-point) (start-position insertion-point)
(end-position (+ insertion-point output-length)))) (end-position (+ insertion-point output-length))))
(send text begin-edit-sequence) (send text begin-edit-sequence #f)
(define **editing (now)) (define **editing (now))
(send text insert output-length output-string insertion-point) (send text insert output-length output-string insertion-point)
(define **inserted (now)) (define **inserted (now))
@ -110,7 +110,7 @@
(define/public (refresh) (define/public (refresh)
(with-unlock text (with-unlock text
(send* text (send* text
(begin-edit-sequence) (begin-edit-sequence #f)
(change-style unhighlight-d start-position end-position)) (change-style unhighlight-d start-position end-position))
(apply-extra-styles) (apply-extra-styles)
(let ([selected-syntax (let ([selected-syntax

14
collects/macro-debugger/syntax-browser/pretty-printer.ss
View File

@ -29,13 +29,15 @@
(let-values ([(line column position) (port-next-location port)]) (let-values ([(line column position) (port-next-location port)])
(sub1 position))) (sub1 position)))
(define (pp-pre-hook obj port) (define (pp-pre-hook obj port)
(send range-builder push! obj (current-position)) (when (flat=>stx obj)
(send range-builder push! (current-position)))
(send range-builder set-start obj (current-position))) (send range-builder set-start obj (current-position)))
(define (pp-post-hook obj port) (define (pp-post-hook obj port)
(send range-builder pop! (flat=>stx obj) (current-position)) (define stx (flat=>stx obj))
(when stx
(send range-builder pop! stx (current-position)))
(let ([start (send range-builder get-start obj)] (let ([start (send range-builder get-start obj)]
[end (current-position)] [end (current-position)])
[stx (flat=>stx obj)])
(when (and start stx) (when (and start stx)
(send range-builder add-range stx (cons start end))))) (send range-builder add-range stx (cons start end)))))
(define (pp-extend-style-table identifier-list) (define (pp-extend-style-table identifier-list)
@ -132,7 +134,7 @@
(define saved-starts null) (define saved-starts null)
(define saved-subss null) (define saved-subss null)
(define/public (push! obj start) (define/public (push! start)
(set! saved-starts (cons working-start saved-starts)) (set! saved-starts (cons working-start saved-starts))
(set! saved-subss (cons working-subs saved-subss)) (set! saved-subss (cons working-subs saved-subss))
(set! working-start start) (set! working-start start)
@ -182,5 +184,3 @@
(>= (- (range-end x) (range-start x)) (>= (- (range-end x) (range-start x))
(- (range-end y) (range-start y))))))) (- (range-end y) (range-start y)))))))
)) ))

2
collects/macro-debugger/syntax-browser/properties.ss
View File

@ -43,7 +43,7 @@
(define/public (refresh) (define/public (refresh)
(send* text (send* text
(lock #f) (lock #f)
(begin-edit-sequence) (begin-edit-sequence #f)
(erase)) (erase))
(if (syntax? selected-syntax) (if (syntax? selected-syntax)
(refresh/mode mode) (refresh/mode mode)

2
collects/macro-debugger/view/stepper.ss
View File

@ -309,7 +309,7 @@
(define text (send: sbview sb:syntax-browser<%> get-text)) (define text (send: sbview sb:syntax-browser<%> get-text))
(define position-of-interest 0) (define position-of-interest 0)
(define multiple-terms? (> (length (cursor->list terms)) 1)) (define multiple-terms? (> (length (cursor->list terms)) 1))
(send text begin-edit-sequence) (send text begin-edit-sequence #f)
(send: sbview sb:syntax-browser<%> erase-all) (send: sbview sb:syntax-browser<%> erase-all)
(update:show-prefix) (update:show-prefix)