"
COPYRIGHT (c) 1990 by Claus Gittinger
All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
inclusion of the above copyright notice. This software may not
be provided or otherwise made available to, or used by, any
other person. No title to or ownership of the software is
hereby transferred.
"
StandardSystemView subclass:#ModalBox
instanceVariableNames:'haveControl shadowView exclusiveKeyboard '
classVariableNames:'PopShadow'
poolDictionaries:''
category:'Views-Basic'
!
ModalBox comment:'
COPYRIGHT (c) 1990 by Claus Gittinger
All Rights Reserved
$Header: /cvs/stx/stx/libview/ModalBox.st,v 1.10 1994-08-11 23:43:20 claus Exp $
'!
!ModalBox class methodsFor:'documentation'!
copyright
"
COPYRIGHT (c) 1990 by Claus Gittinger
All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
inclusion of the above copyright notice. This software may not
be provided or otherwise made available to, or used by, any
other person. No title to or ownership of the software is
hereby transferred.
"
!
version
"
$Header: /cvs/stx/stx/libview/ModalBox.st,v 1.10 1994-08-11 23:43:20 claus Exp $
"
!
documentation
"
this class implements modal boxes; ModalBoxes are different from
others, in that they take complete control over the display, until
all processing is done (i.e. other views will not get any events
while the box is active).
class variables:
PopShadow <Boolean> if true, modalBoxes will show a shadow
"
! !
!ModalBox class methodsFor:'initialization'!
initialize
super initialize.
Display notNil ifTrue:[
PopShadow := self classResources name:'POPUP_SHADOW' default:false
]
! !
!ModalBox methodsFor:'initialize / release'!
initialize
super initialize.
haveControl := false.
exclusiveKeyboard := false.
PopShadow ifTrue:[
shadowView := (ShadowView on:device) for:self
]
!
initStyle
super initStyle.
((style ~~ #normal) and:[style ~~ #mswindows]) ifTrue:[
borderWidth := 0.
self level:2
]
!
addToCurrentProject
"ignored here"
^ self
!
destroy
shadowView notNil ifTrue:[
shadowView destroy.
shadowView := nil
].
self leaveControl. "just to make sure"
super destroy.
!
create
super create.
PopShadow ifFalse:[
self saveUnder:true
]
!
createOnTop
^ true
! !
!ModalBox methodsFor:'accessing'!
exclusiveKeyboard:aBoolean
"set/clear exclusive locking of the keyboard;
If set, the box will take total control over the
keyboard, not allowing input to other views/boxes
while active.
Danger: only use this for very very urgent boxes, since
no interaction with any view on the screen is possible then."
exclusiveKeyboard := aBoolean
! !
!ModalBox methodsFor:'show / hide'!
mapped
"wait till visible for grabbing"
super mapped.
"take it away from any popup menu possibly still active"
ActiveGrab notNil ifTrue:[
device ungrabKeyboard.
ActiveGrab := nil.
].
"
if I am a super-modal box, take the keyboard
"
exclusiveKeyboard ifTrue:[
device grabKeyboardIn:drawableId.
].
"
get the focus
"
device setInputFocusTo:drawableId.
self enableEnterLeaveEvents
!
fixPosition:aPoint
"make sure, that the box is visible by shifting it
into the visible screen area if nescessary"
self origin:aPoint.
self makeFullyVisible
!
positionOffset
"return the delta, by which the box should be
displaced from the mouse pointer. Usually redefined in
subclasses to have some ok-button appear under
the pointer."
^ (width // 2) @ (height // 2)
!
open
"default for modalboxes is to come up modal"
^ self openModal
!
openModal
"open the box modal;
In addition to the basic (inherited) modalloop, change
the current maingroups cursors to the busy-stop cursor, show
a shadow, and raise the box."
|g|
g := WindowGroup activeGroup.
g notNil ifTrue:[
g := g mainGroup.
g notNil ifTrue:[
g showCursor:(Cursor stop)
]
].
shadowView notNil ifTrue:[shadowView realize].
self raise.
haveControl := true.
super openModal.
!
show
"make myself visible (at the last position) and take control"
self fixSize.
self openModal
!
showAt:aPoint
"make myself visible at aPoint.
Fix position to make box fully visible"
self fixSize.
self fixPosition:aPoint.
self openModal
!
showAtCenter
"make myself visible at the screen center."
self fixSize.
self showAt:(device center - (self extent / 2))
!
showAtPointer
"make myself visible at mouse pointer shifted to have
convenient button under cursor.
Fix position to make box fully visible"
self fixSize.
self showAt:(device pointerPosition - self positionOffset).
!
showAtPointerNotCovering:aView
"make myself visible at mouse pointer shifted to have
convenient button under cursor.
Fix position to make box fully visible and to make sure that
aView is not covered."
|pos newX|
pos := device pointerPosition - self positionOffset.
((Rectangle origin:pos extent:self extent)
intersects: (aView origin corner: aView corner))
ifTrue:[
"
try to the right of the untouchable view
"
newX := (aView origin x + aView width).
newX + width > device width ifTrue:[
newX := device width - width
].
pos x:newX.
((Rectangle origin:pos extent:self extent)
intersects: (aView origin corner: aView corner))
ifTrue:[
"
try to the left of the untouchable view
"
newX := aView origin x - width.
"
should look for vertical possibilities too ...
"
pos x:newX.
]
].
self showAt:pos
!
hide
"make the receiver invisible and leave control"
|p|
shadowView notNil ifTrue:[shadowView unrealize].
self unrealize.
device synchronizeOutput.
(windowGroup notNil and:[(p := windowGroup previousGroup) notNil]) ifTrue:[
"
this is a kludge for IRIS which does not provide backingstore:
when we hide a modalbox (such as a searchbox) which covered
a scrollbar, the scrollbars bitblt-method will copy from the
not-yet redrawn area - effectively clearing the scroller
"
(Delay forSeconds:0.1) wait.
p processExposeEvents
].
self leaveControl.
!
autoHideAfter:seconds with:anAction
"install a background process, which hides the box
after some time. Also, if non-nil, anAction will be
evaluated then."
[
(Delay forSeconds:seconds) wait.
self shown ifTrue:[
self hide.
anAction notNil ifTrue:[anAction value]
]
] forkAt:4.
"
|b|
b := InfoBox title:'hello there'.
b autoHideAfter:5 with:[].
b showAtCenter.
"
! !
!ModalBox methodsFor:'events'!
pointerEnter:state x:x y:y
"
mhmh: this seems to be a special X kludge;
without the following, we will not regain input focus after
pointer is reentered"
device setInputFocusTo:drawableId.
super pointerEnter:state x:x y:y
! !
!ModalBox methodsFor:'private'!
leaveControl
|g|
windowGroup notNil ifTrue:[
g := windowGroup mainGroup.
g notNil ifTrue:[
g restoreCursors
]
].
haveControl := false.
exclusiveKeyboard ifTrue:[
device ungrabKeyboard
]
! !