[REBOL] bug fix for popup system
From: rotenca::telvia::it at: 28-Dec-2002 16:06
Hi all,
My last try to have a bug-free popup system. Now it seems to me really
bug-free.
system/view/wake-event: func[
"Patched by Romano Paolo Tenca"
port /local event no-btn p-f
] bind [
event: pick port 1
if none? event [
if debug [print "Event port awoke, but no event was present."]
return false
]
;*** patch - use p-f instead of pop-face
either not p-f: pop-face [
do event
empty? screen-face/pane
] [
either all [
event/type = 'key
event/key = escape
] [hide-popup] [
either any [
p-f = event/face
all [
;*** patch - some event have none! in the face field
event/face
;*** patch - check that the window is the same for show-popup/window
(find-window p-f) = find-window event/face
within? event/offset win-offset? p-f p-f/size
]
][
no-btn: false
if block? get in p-f 'pane [
no-btn: foreach item p-f/pane [if get in item 'action [break/return
false] true]
]
if any [all [event/type = 'up no-btn] event/type = 'close] [hide-popup]
do event
] [
;*** patch - events which do not hide when the /away refinement is used
all [p-f/action not find [move time inactive] event/type hide-popup]
;*** patch - permit only these events outside the popup
if find [resize offset time] event/type [do event]
]
;*** patch - search for the right pop-face
none? find pop-list p-f
]
]
] in system/view 'self
win-offset?: func [
{Given any face, returns its window offset. Patched by Romano Paolo Tenca}
face [object!]
/local xy
][
xy: 0x0
if face/parent-face [
xy: face/offset
while [face: face/parent-face] [
if face/parent-face [
xy: xy + face/offset + either face/edge [face/edge/size] [0]
]
]
]
xy
]
---
Merry Christmas!
Romano