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

.

Browse Source 
original commit: e9bc2fa142f173c3dcfd493b86443c66bbde88cd
This commit is contained in:
Robby Findler 2004-07-01 19:11:07 +00:00
parent 5be1cf9854
commit ec974dc97a
1 changed files with 19 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
collects/framework/private/text.ss
View File

@ -818,6 +818,7 @@ WARNING: printf is rebound in the body of the unit to always
(define ports<%>
(interface ()
delete/io
get-insertion-point
set-insertion-point
get-unread-start-point
@ -846,6 +847,7 @@ WARNING: printf is rebound in the body of the unit to always
(mixin ((class->interface text%) #;scheme:text<%>) (ports<%>)
(inherit begin-edit-sequence
end-edit-sequence
delete
insert
change-style
split-snip
@ -861,6 +863,7 @@ WARNING: printf is rebound in the body of the unit to always
(define eventspace (current-eventspace))
;; insertion-point : number
;; the place where the output ports insert data
;; only updated in `eventspace' (above)'s main thread
(define insertion-point 0)
@ -909,6 +912,22 @@ WARNING: printf is rebound in the body of the unit to always
(channel-put clear-output-chan (void))
(init-output-ports))
;; delete/io: number number -> void
(define/public-final (delete/io start end)
(unless (<= start end insertion-point)
(error 'delete/io "expected start (~a) <= end (~a) <= insertion-point (~a)"
start end insertion-point))
(let ([before-allowed? allow-edits?])
(set! allow-edits? #t)
(printf "deleting ~s to ~s\n" start end)
(delete start end #f)
(printf "before ip ~s usp ~s\n" insertion-point unread-start-point)
(let ([dist (- end start)])
(set! insertion-point (- insertion-point dist))
(set! unread-start-point (- unread-start-point dist)))
(printf "after ip ~s usp ~s\n" insertion-point unread-start-point)
(set! allow-edits? before-allowed?)))
(define/public-final (get-in-port)
(unless in-port (error 'get-in-port "not ready"))
in-port)