made yellow/black REPL warning go before output, rather than after

svn: r958
This commit is contained in:
Robby Findler 2005-10-03 15:55:08 +00:00
parent 2a34ce7c2b
commit c9e81b63fa
2 changed files with 21 additions and 9 deletions

View File

@ -501,6 +501,7 @@ TODO
get-value-port
in-edit-sequence?
insert
insert-before
insert-between
invalidate-bitmap-cache
is-frozen?
@ -812,12 +813,12 @@ TODO
(define/private (insert-warning)
(begin-edit-sequence)
(insert-between "\n")
(let ([start (get-unread-start-point)])
(insert-between
(let ([start (get-insertion-point)])
(insert-before
(string-constant interactions-out-of-sync))
(let ([end (get-unread-start-point)])
(let ([end (get-insertion-point)])
(change-style warning-style-delta start end)))
(insert-before "\n")
(end-edit-sequence))
(field (already-warned? #f))

View File

@ -884,6 +884,7 @@ WARNING: printf is rebound in the body of the unit to always
set-allow-edits
get-allow-edits
insert-between
insert-before
submit-to-port?
on-submit
send-eof-to-in-port
@ -988,11 +989,21 @@ WARNING: printf is rebound in the body of the unit to always
(define/public-final (insert-between str/snp)
(insert str/snp unread-start-point unread-start-point)
(set! unread-start-point (+ unread-start-point
(cond
[(string? str/snp) (string-length str/snp)]
[(is-a? str/snp snip%)
(send str/snp get-count)]))))
(amt-of-space str/snp))))
;; insert-before : string/snp -> void
;; inserts something before both the insertion point and the unread region
(define/public-final (insert-before str/snp)
(insert str/snp insertion-point insertion-point)
(let ([amt (amt-of-space str/snp)])
(set! insertion-point (+ insertion-point amt))
(set! unread-start-point (+ unread-start-point amt))))
(define/private (amt-of-space str/snp)
(cond
[(string? str/snp) (string-length str/snp)]
[(is-a? str/snp snip%)
(send str/snp get-count)]))
(define/public-final (get-insertion-point) insertion-point)
(define/public-final (set-insertion-point ip) (set! insertion-point ip))