ModalBox.st
author Claus Gittinger <cg@exept.de>
Sun, 10 Dec 1995 16:21:17 +0100
changeset 300 6a63af1fec3e
parent 296 655507429feb
child 371 cc32d8f8bc8d
permissions -rw-r--r--
passing group to avoid multiple activeGroup searches

"
 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:'shadowView exclusiveKeyboard'
	 classVariableNames:'UseTransientViews'
	 poolDictionaries:''
	 category:'Views-Basic'
!

!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.
"
!

documentation
"
    this class implements modal boxes; ModalBoxes are different from
    others, in that they take control over the current topview, until 
    all processing is done (i.e. the currently active topview and all of
    its subviews will not handle user events while the box is active).

    ModalBoxes are either implemented as transient windows
    (if UseTransientViews := true) or as override redirect views.
    Some window managers have problems with either; so you may want to
    change the default setting from your display.rc file.
"
! !

!ModalBox class methodsFor:'initialization'!

initialize
    UseTransientViews := true.
! !

!ModalBox class methodsFor:'defaults'!

defaultExtent
    "this defines the defaultExtent for instances of me;
     the value returned here is usually not correct for concrete subclasses,
     so you better redefine this method"

    ^ (Display pixelPerMillimeter * (60 @ 30)) rounded
!

useTransientViews:aBoolean 
    "change the way modalBoxes are created on the Display.
     If the argument is true, transient views are used; otherwise
     override redirect views are used. Depending on your windowmanager,
     either one may have problems. You may want to change the setting
     from your display.rc or d_xxx.rc file."

    UseTransientViews := aBoolean.

    "
     ModalBox useTransientViews:false
     ModalBox useTransientViews: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:'event handling'!

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 isPopUpView 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;
     without the following, we will not regain input focus after
     pointer is reentered."

    self getKeyboardFocus.
    super pointerEnter:state x:x y:y
!

terminate
    "this is the close from a windowmanager
     (only if UseTransientViews == true)"

    "
     if I am a dialog, make the receiver invisible and leave control.
     But, do not destroy the underlying view resources, to allow for
     another open/show to occur later.
     if I have been opened modeLess, perform the normal destroy operation.
    "
    (windowGroup isNil or:[windowGroup isModal]) ifTrue:[
	self hide
    ] ifFalse:[
	super terminate
    ]
!

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 ..."

    "the 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
"/    ]
! !

!ModalBox methodsFor:'initialize / release'!

addToCurrentProject
    "ignored here"

    ^ self
!

create
    super create.
    shadowView notNil ifTrue:[
	self saveUnder:true
    ]
!

destroy
    shadowView notNil ifTrue:[
	shadowView destroy.
	shadowView := nil
    ].
    self leaveControl. "just to make sure"
    super destroy.
!

initEvents
    super initEvents.
    self enableEvent:#visibilityChange
!

initStyle
    |style|

    super initStyle.
    style := styleSheet name.
    ((style ~~ #normal) and:[style ~~ #mswindows]) ifTrue:[
	borderWidth := 0.
	UseTransientViews ifFalse:[
	    self level:2
	]
    ]
!

initialize
    |form resizeButton moveButton|

    super initialize.

    type := #dialog. 
    exclusiveKeyboard := false.
    label := ' '.

    label := 'Popup'.

    UseTransientViews ifFalse:[
	PopUpView shadows ifTrue:[
	    shadowView := (ShadowView onDevice:device) for:self
	].

	form := Form width:8 height:8 
		     fromArray:#[2r00000000
				 2r00000000 
				 2r00000000 
				 2r00000001
				 2r00000011
				 2r00000111 
				 2r00001111
				 2r00011111 
				]
		     on:device.
	resizeButton := Button form:form in:self.
	resizeButton origin:1.0 @ 1.0 corner:1.0@1.0.
	resizeButton activeForegroundColor:(resizeButton foregroundColor).
	resizeButton activeBackgroundColor:(resizeButton backgroundColor).
	resizeButton enteredBackgroundColor:(resizeButton backgroundColor).
	resizeButton leftInset:-8; topInset:-8.
	resizeButton releaseAction:[].
	resizeButton pressAction:[resizeButton turnOff; redraw. self doResize].
	resizeButton borderWidth:0.
	resizeButton onLevel:0; offLevel:0.
	resizeButton cursor:(Cursor corner).

	form := Form width:8 height:8 
		     fromArray:#[2r11111000
				 2r11110000 
				 2r11100000 
				 2r11000000
				 2r10000000
				 2r00000000 
				 2r00000000
				 2r00000000 
				]
		     on:device.
	moveButton := Button form:form in:self.
	moveButton origin:0.0 @ 0.0 corner:0.0@0.0.
	moveButton activeForegroundColor:(moveButton foregroundColor).
	moveButton activeBackgroundColor:(moveButton backgroundColor).
	moveButton enteredBackgroundColor:(moveButton backgroundColor).
	moveButton rightInset:-8; bottomInset:-8.
	moveButton releaseAction:[].
	moveButton pressAction:[moveButton turnOff; redraw. self doMove].
	moveButton borderWidth:0.
	moveButton onLevel:0; offLevel:0.
	moveButton cursor:(Cursor origin)
    ].

!

isPopUpView
    ^ UseTransientViews not
!

reinitialize
   super reinitialize.
   self unrealize.
!

resize
    "resize myself to make everything visible"

    |newExtent|

    newExtent := self preferredExtent.
    newExtent = self extent ifTrue:[^ self].

    (shown and:[shadowView notNil]) ifTrue:[
	shadowView unrealize.
	self extent:newExtent.
	shadowView realize.
	self raise
    ] ifFalse:[
	self extent:newExtent.
    ].
!

resizeUnderPointer
    "resize myself to make everything visible, AND possibly change the origin
     to have the mouse pointer stay within my bounds.
     This is used for self-resizing enterBoxes, to avoid moving
     the box away from the cursor."

    |newExtent newLeft delta|

    newExtent := self preferredExtent.
    newExtent = self extent ifTrue:[^ self].

    shown ifTrue:[
	delta := width - newExtent x.
	newLeft := left + delta.
	(((newLeft @ top) extent:newExtent) 
	    containsPoint:device pointerPosition)
	ifFalse:[newLeft := left].
	newLeft < 0 ifTrue:[newLeft := 0].
	newLeft + newExtent x > device width ifTrue:[
	    newLeft := device width - newExtent x
	].
	shadowView notNil ifTrue:[
	    shadowView unrealize.
	].
	self origin:(newLeft @ top) extent:newExtent.
	shadowView notNil ifTrue:[
	    shadowView realize.
	    self raise.
	].
    ] ifFalse:[
	self extent:newExtent.
    ].

    "Modified: 6.9.1995 / 15:31:21 / claus"
! !

!ModalBox methodsFor:'move & resize'!

doMove
    "the move button was pressed"

    |r|

    r := device rectangleFromUser:(self origin corner:self corner).
    shadowView notNil ifTrue:[
	shadowView unrealize
    ].
    self origin:r origin extent:(r extent max:(100@100)).
    shadowView notNil ifTrue:[
	shadowView realize.
	self raise
    ].
!

doResize
    "the resize button was pressed"

    |r|

    r := device rectangleFromUser:(self origin corner:self corner).
    shadowView notNil ifTrue:[
	shadowView unrealize
    ].
    self origin:r origin extent:(r extent max:(100@100)).
    shadowView notNil ifTrue:[
	shadowView realize.
	self raise
    ].
! !

!ModalBox methodsFor:'private'!

leaveControl
    exclusiveKeyboard ifTrue:[
	device ungrabKeyboard
    ]
! !

!ModalBox methodsFor:'queries'!

preferredExtent
    "return the extent required to make all components
     visible in myself. This should be redefined in
     subclasses."

    ^ self class defaultExtent
! !

!ModalBox methodsFor:'show / hide'!

autoHideAfter:seconds with:anAction
    "install a background process, which hides the box
     after some time. Also, if non-nil, anAction will be
     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]
	]
    ] forkAt:4.

    "
     |b|

     b := InfoBox title:'hello there'.
     b autoHideAfter:5 with:[].
     b showAtCenter.
    "
!

fixPosition:aPoint
    "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
!

fixSize
    "this is sent right before the modalBox is made visible;
     If the size is not fixed, adjust my size."

    sizeFixed == true ifFalse:[
	self resize.
    ].
    super fixSize.
!

hide
    "make the receiver invisible and leave control"

    |p|

    shadowView notNil ifTrue:[shadowView unrealize].
    windowGroup notNil ifTrue:[windowGroup focusView:nil].
    self leaveControl.
    self unrealize.
    device flush. 

    (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.
	 We need a short delay here, since at this time, the expose event has
	 not yet arrived.
	"
	(Delay forSeconds:0.1) wait.
	p processExposeEvents   
    ].
!

mapped
    "wait till visible for grabbing"

    super mapped.

    "take it away from any popup menu possibly still active"

    device ungrabKeyboard.
    device ungrabPointer.

    "
     if I am a super-modal box, take the keyboard
    "
    exclusiveKeyboard ifTrue:[
	device grabKeyboardInView:self.
    ].

"/    UseTransientViews ifFalse:[
	"
	 get the focus
	"
	self getKeyboardFocus.
	self enableEnterLeaveEvents
"/    ]
!

open
    "default for modalboxes is to come up modal at the pointer position"

    ^ self showAtPointer
!

openModal:aBlock
    "open the box modal;
     In addition to the basic (inherited) modalloop, change
     the current active windowgroups cursors to the busy-stop cursor, show
     a shadow, and raise the box."

    |mainGroup mainView useTransient|

    useTransient := UseTransientViews.

    "
     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.
        ]
    ].

    useTransient ifTrue:[
        shadowView := nil.
    ] ifFalse:[
        shadowView notNil ifTrue:[shadowView realize].
    ].
    self raise.

    useTransient ifTrue:[
        device setTransient:drawableId for:(mainView id).
    ].

    [
        super openModal:aBlock inGroup:mainGroup.
    ] valueNowOrOnUnwindDo:[
        "
         restore cursors in the main group
        "
        mainGroup notNil ifTrue:[
            mainGroup restoreCursors.
            mainGroup sensor flushUserEvents.
        ]
    ].

"/    mainGroup notNil ifTrue:[
"/        "
"/         flush any key & mouse events which arrived
"/         while the box was open (avoids stray input).
"/        "
"/        mainGroup sensor flushUserEvents.
"/    ].

    "Created: 10.12.1995 / 14:07:01 / cg"
    "Modified: 10.12.1995 / 14:08:41 / cg"
!

positionOffset
    "return the delta, by which the box should be
     displaced from the mouse pointer. 
     Usually redefined in subclasses to have the most convenient
     ok-button appear under the pointer."

    ^ (width // 2) @ (height // 2)
!

show
    "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
    "make myself visible at aPoint.
     Fix position to make box fully visible"

    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 showAt:(device center) center:true

    "
     |b|

     b := InfoBox title:'hello'.
     b showAtCenter.
    "
!

showAtPointer
    "make myself visible at mouse pointer shifted to have
     convenient button under cursor. self positionOffset should
     return that offset (usually redefined, since we dont know here,
     which button should be under cursor)."

    self fixSize.
    self fixPosition:(device pointerPosition - self positionOffset).
    self openModal

    "
     |b|

     b := InfoBox title:'hello'.
     b showAtPointer.
    "
!

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
!

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.
    "
! !

!ModalBox class methodsFor:'documentation'!

version
    ^ '$Header: /cvs/stx/stx/libview/ModalBox.st,v 1.33 1995-12-10 15:21:17 cg Exp $'
! !
ModalBox initialize!