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

fixed a bug in IO where port-next-location went into a busy loop before any io had happened

Browse Source 
svn: r1526

original commit: 4f8054f125e7c0bf83d43fb5b3a5fdede5707730
This commit is contained in:
Robby Findler 2005-12-05 15:45:26 +00:00
parent cb45b35553
commit eb7f38102f
2 changed files with 9 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -1655,9 +1655,7 @@ WARNING: printf is rebound in the body of the unit to always
[resp-chan (cdr pr)])
(set! positioners (cons pr positioners))
(loop))))
(if position
(apply choice-evt (map service-positioner positioners))
never-evt)
(apply choice-evt (map service-positioner positioners))
(handle-evt
read-chan
(λ (ent)
@ -1748,7 +1746,11 @@ WARNING: printf is rebound in the body of the unit to always
[resp-evt (cdr pr)])
(handle-evt
(choice-evt nack-evt
(channel-put-evt resp-evt position))
(channel-put-evt resp-evt (or position
;; a bogus position for when
;; nothing has happened yet.
(list 1 0 1))))
(let ([sent-position position])
(λ (_)
(set! positioners (remq pr positioners))

4
collects/framework/test.ss
View File

@ -905,7 +905,9 @@
(if (method-in-interface? 'on-event (object-interface window))
(send window on-event event)
(error mouse-tag "focused window does not have on-event"))]
[(send (car l) on-subwindow-event window event) #f]
[(and (is-a? (car l) window<%>)
(send (car l) on-subwindow-event window event))
#f]
[else (loop (cdr l))]))))
;;