--- a/ModalBox.st Mon Oct 10 03:30:48 1994 +0100
+++ b/ModalBox.st Mon Oct 10 03:34:45 1994 +0100
@@ -1,6 +1,6 @@
"
COPYRIGHT (c) 1990 by Claus Gittinger
- All Rights Reserved
+ 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
@@ -12,16 +12,16 @@
StandardSystemView subclass:#ModalBox
instanceVariableNames:'haveControl shadowView exclusiveKeyboard '
- classVariableNames:'PopShadow'
+ classVariableNames:'UseTransientViews'
poolDictionaries:''
category:'Views-Basic'
!
ModalBox comment:'
COPYRIGHT (c) 1990 by Claus Gittinger
- All Rights Reserved
+ All Rights Reserved
-$Header: /cvs/stx/stx/libview/ModalBox.st,v 1.11 1994-08-22 13:17:08 claus Exp $
+$Header: /cvs/stx/stx/libview/ModalBox.st,v 1.12 1994-10-10 02:32:40 claus Exp $
'!
!ModalBox class methodsFor:'documentation'!
@@ -29,7 +29,7 @@
copyright
"
COPYRIGHT (c) 1990 by Claus Gittinger
- All Rights Reserved
+ 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
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libview/ModalBox.st,v 1.11 1994-08-22 13:17:08 claus Exp $
+$Header: /cvs/stx/stx/libview/ModalBox.st,v 1.12 1994-10-10 02:32:40 claus Exp $
"
!
@@ -52,20 +52,13 @@
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
- ]
+ UseTransient := false.
! !
!ModalBox methodsFor:'initialize / release'!
@@ -75,20 +68,32 @@
haveControl := false.
exclusiveKeyboard := false.
+ label := ' '.
- PopShadow ifTrue:[
- shadowView := (ShadowView on:device) for:self
+ UseTransient ifFalse:[
+ (StyleSheet at:#popupShadow default:false) ifTrue:[
+ shadowView := (ShadowView on:device) for:self
+ ]
]
!
+initEvents
+ self enableEvent:#visibilityChange
+!
+
initStyle
super initStyle.
((style ~~ #normal) and:[style ~~ #mswindows]) ifTrue:[
- borderWidth := 0.
- self level:2
+ borderWidth := 0.
+ self level:2
]
!
+reinitialize
+ super reinitialize.
+ self unrealize.
+!
+
addToCurrentProject
"ignored here"
@@ -97,8 +102,8 @@
destroy
shadowView notNil ifTrue:[
- shadowView destroy.
- shadowView := nil
+ shadowView destroy.
+ shadowView := nil
].
self leaveControl. "just to make sure"
super destroy.
@@ -106,13 +111,13 @@
create
super create.
- PopShadow ifFalse:[
- self saveUnder:true
+ shadowView notNil ifTrue:[
+ self saveUnder:true
]
!
createOnTop
- ^ true
+ ^ UseTransient not
! !
!ModalBox methodsFor:'accessing'!
@@ -138,15 +143,15 @@
"take it away from any popup menu possibly still active"
ActiveGrab notNil ifTrue:[
- device ungrabKeyboard.
- ActiveGrab := nil.
+ device ungrabKeyboard.
+ ActiveGrab := nil.
].
"
if I am a super-modal box, take the keyboard
"
exclusiveKeyboard ifTrue:[
- device grabKeyboardIn:drawableId.
+ device grabKeyboardIn:drawableId.
].
"
@@ -157,8 +162,9 @@
!
fixPosition:aPoint
- "make sure, that the box is visible by shifting it
- into the visible screen area if nescessary"
+ "set origin to aPoint, but make sure, that the box is fully visible
+ by shifting it into the visible screen area if nescessary.
+ This prevents invisible modalBoxes (which you could never close)."
self origin:aPoint.
self makeFullyVisible
@@ -166,45 +172,96 @@
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."
+ displaced from the mouse pointer.
+ Usually redefined in subclasses to have the most convenient
+ ok-button appear under the pointer."
^ (width // 2) @ (height // 2)
!
open
- "default for modalboxes is to come up modal"
+ "default for modalboxes is to come up modal at the pointer position"
- ^ self openModal
+ ^ self showAtPointer
!
-openModal
+openModal:aBlock
"open the box modal;
In addition to the basic (inherited) modalloop, change
- the current maingroups cursors to the busy-stop cursor, show
+ the current active windowgroups cursors to the busy-stop cursor, show
a shadow, and raise the box."
- |g|
+ |mainGroup mainView useTransient|
+
+ useTransient := UseTransient.
+
+ "
+ show a stop-cursor in the current group
+ "
+ mainGroup := WindowGroup activeGroup.
+ mainGroup notNil ifTrue:[
+ mainGroup := mainGroup mainGroup.
+ mainGroup notNil ifTrue:[
+ mainGroup showCursor:(Cursor stop).
+ ]
+ ].
+
+ mainGroup isNil ifTrue:[
+ useTransient := false
+ ].
+
+ useTransient ifTrue:[
+ mainGroup topViews notNil ifTrue:[
+ mainView := mainGroup topViews first.
+ ].
+ mainView isNil ifTrue:[
+ useTransient := false.
+ ]
+ ].
- g := WindowGroup activeGroup.
- g notNil ifTrue:[
- g := g mainGroup.
- g notNil ifTrue:[
- g showCursor:(Cursor stop)
- ]
+ useTransient ifTrue:[
+ shadowView := nil.
+ ] ifFalse:[
+ shadowView notNil ifTrue:[shadowView realize].
].
- shadowView notNil ifTrue:[shadowView realize].
self raise.
+
haveControl := true.
- super openModal.
+ mainGroup notNil ifTrue:[
+ "
+ flush pending key & mouse events.
+ this avoids pre-characters
+ to be put into the view ...
+ "
+"/ mainGroup sensor flushUserEvents.
+ ].
+
+ useTransient ifTrue:[
+ device setTransient:drawableId for:(mainView id).
+ ].
+ super openModal:aBlock.
+ mainGroup notNil ifTrue:[
+ "
+ flush any key & mouse events which arrived
+ while the box was open (avoids stray input).
+ "
+ mainGroup sensor flushUserEvents.
+ ].
!
show
- "make myself visible (at the last position) and take control"
+ "make myself visible (at the last or default position) and take control"
self fixSize.
+ self makeFullyVisible.
self openModal
+
+ "
+ |b|
+
+ b := InfoBox title:'hello'.
+ b show.
+ "
!
showAt:aPoint
@@ -214,14 +271,90 @@
self fixSize.
self fixPosition:aPoint.
self openModal
+
+ "
+ |b|
+
+ b := InfoBox title:'hello'.
+ b showAt:(0 @ 0).
+ b showAt:(400 @ 400).
+ "
+!
+
+showAt:aPoint center:center
+ "make myself visible at aPoint. center specifies
+ if the view should show up centered around aPoint."
+
+ self showAt:aPoint centerX:center centerY:center
+
+ "
+ |b|
+
+ b := InfoBox title:'hello'.
+ b showAt:(100 @ 100) center:true.
+ b showAt:(100 @ 100) center:false.
+ "
+!
+
+showAt:aPoint centerX:centerX centerY:centerY
+ "make myself visible at aPoint. centerX/centerY specify
+ if the view should show up centered around aPoint.
+ Fix position to make box fully visible"
+
+ |dx dy|
+
+ self fixSize.
+ centerX ifTrue:[
+ dx := self width // 2.
+ ] ifFalse:[
+ dx := 0
+ ].
+ centerY ifTrue:[
+ dy := self height // 2.
+ ] ifFalse:[
+ dy := 0
+ ].
+ self origin:(aPoint - (dx @ dy)).
+ self makeFullyVisible.
+ self openModal
+
+ "
+ |b|
+
+ b := InfoBox title:'hello'.
+ b showAt:(100 @ 100).
+ b showAt:(100 @ 100) centerX:true centerY:false.
+ "
!
showAtCenter
"make myself visible at the screen center."
- self fixSize.
- self fixPosition:(device center - (self extent / 2)).
- self openModal
+ self showAt:(device center) center:true
+
+ "
+ |b|
+
+ b := InfoBox title:'hello'.
+ b showAtCenter.
+ "
+!
+
+showCenteredIn:aView
+ "make myself visible at the screen center."
+
+ |top|
+
+ top := aView topView.
+ top raise.
+ self showAt:(top center + (aView originRelativeTo:top)) center:true
+
+ "
+ |b|
+
+ b := InfoBox title:'hello'.
+ b showCenteredIn:Transcript.
+ "
!
showAtPointer
@@ -233,6 +366,13 @@
self fixSize.
self fixPosition:(device pointerPosition - self positionOffset).
self openModal
+
+ "
+ |b|
+
+ b := InfoBox title:'hello'.
+ b showAtPointer.
+ "
!
showAtPointerNotCovering:aView
@@ -246,30 +386,30 @@
pos := device pointerPosition - self positionOffset.
((Rectangle origin:pos extent:self extent)
- intersects: (aView origin corner: aView corner))
+ 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.
+ "
+ 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.
- ]
+ ((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
@@ -285,14 +425,16 @@
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
+ "
+ 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.
+ We need a short delay here, since at this sime, the expose event has
+ not yet arrived.
+ "
+ (Delay forSeconds:0.1) wait.
+ p processExposeEvents
].
self leaveControl.
!
@@ -300,14 +442,17 @@
autoHideAfter:seconds with:anAction
"install a background process, which hides the box
after some time. Also, if non-nil, anAction will be
- evaluated then."
+ evaluated then. The action will not be evaluated if
+ the box is closed by the user pressing a button."
+ "the implementation is simple: just fork of a process
+ to hide me."
[
- (Delay forSeconds:seconds) wait.
- self shown ifTrue:[
- self hide.
- anAction notNil ifTrue:[anAction value]
- ]
+ (Delay forSeconds:seconds) wait.
+ self shown ifTrue:[
+ self hide.
+ anAction notNil ifTrue:[anAction value]
+ ]
] forkAt:4.
"
@@ -321,6 +466,55 @@
!ModalBox methodsFor:'events'!
+visibilityChange:how
+ "raise when covered - this should not be needed, since we
+ have been created as override-redirect window (which should
+ stay on top - but some window managers (fvwm) seem to ignore
+ this ..."
+
+ "code below is not good, since it will lead to
+ oscillating raises when two modalBoxes are going to cover
+ each other - see coveredBy:-handling ..."
+
+"/ how ~~ #fullyVisible ifTrue:[
+"/ self raise
+"/ ]
+!
+
+coveredBy:aView
+ "the receiver has been covered by another view.
+ If the other view is a non-modal one, raise"
+
+ |mainGroup topViews|
+
+ "
+ if the other view is not a modal- (or shadow-, or popup-) -view,
+ bring myself to the front again.
+ "
+ aView createOnTop ifFalse:[
+ "
+ if I have a mainGroup,
+ only raise if its one of my maingroup-views
+ "
+ windowGroup notNil ifTrue:[
+ mainGroup := windowGroup mainGroup.
+ mainGroup notNil ifTrue:[
+ topViews := mainGroup topViews.
+ topViews notNil ifTrue:[
+ topViews do:[:aTopView |
+ aView == aTopView ifTrue:[
+ self raise.
+ ^ self
+ ]
+ ]
+ ].
+ ^ self
+ ]
+ ].
+ self raise
+ ]
+!
+
pointerEnter:state x:x y:y
"
mhmh: this seems to be a special X kludge;
@@ -337,13 +531,13 @@
|g|
windowGroup notNil ifTrue:[
- g := windowGroup mainGroup.
- g notNil ifTrue:[
- g restoreCursors
- ]
+ g := windowGroup mainGroup.
+ g notNil ifTrue:[
+ g restoreCursors
+ ]
].
haveControl := false.
exclusiveKeyboard ifTrue:[
- device ungrabKeyboard
+ device ungrabKeyboard
]
! !