[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

[1] · 2 · 3 · 4 · See whole thread