ModalBox.st
changeset 8956 66f452418af2
parent 8850 aa69e3c0cc85
child 8985 b4d006b79f84
--- a/ModalBox.st	Sat Dec 21 04:27:58 2019 +0000
+++ b/ModalBox.st	Mon Dec 23 12:05:33 2019 +0100
@@ -14,7 +14,7 @@
 "{ NameSpace: Smalltalk }"
 
 StandardSystemView subclass:#ModalBox
-	instanceVariableNames:'shadowView exclusiveKeyboard escapeIsCancel'
+	instanceVariableNames:'shadowView exclusiveKeyboard escapeIsCancel closeOnOutsideButtonPress'
 	classVariableNames:'UseTransientViews DefaultExtent'
 	poolDictionaries:''
 	category:'Views-Basic'
@@ -179,26 +179,26 @@
      bring myself to the front again.
     "
     aView isPopUpView ifFalse:[
-        "
-         if I have a mainGroup,
-         only raise if it's one of my maingroup-views
-        "
-        windowGroup notNil ifTrue:[
-            mainGroup := windowGroup mainGroup.
-            mainGroup notNil ifTrue:[
-                topViews := mainGroup topViews.
-                topViews notNil ifTrue:[
-                    topViews do:[:eachTopView |
-                        aView == eachTopView ifTrue:[
-                            self raise.
-                            ^ self
-                        ]
-                    ]
-                ].
-                ^ self
-            ]
-        ].
-        self raise
+	"
+	 if I have a mainGroup,
+	 only raise if it's one of my maingroup-views
+	"
+	windowGroup notNil ifTrue:[
+	    mainGroup := windowGroup mainGroup.
+	    mainGroup notNil ifTrue:[
+		topViews := mainGroup topViews.
+		topViews notNil ifTrue:[
+		    topViews do:[:eachTopView |
+			aView == eachTopView ifTrue:[
+			    self raise.
+			    ^ self
+			]
+		    ]
+		].
+		^ self
+	    ]
+	].
+	self raise
     ]
 
     "Modified (format): / 13-02-2017 / 20:27:00 / cg"
@@ -329,55 +329,55 @@
 "/    label := 'Popup'.
 
     UseTransientViews ifFalse:[
-        (PopUpView shadowsOnDevice:device) ifTrue:[
-            shadowView := (ShadowView onDevice:device) for:self
-        ].
+	(PopUpView shadowsOnDevice:device) ifTrue:[
+	    shadowView := (ShadowView onDevice:device) for:self
+	].
 
-        form := Form width:8 height:8
-                     fromArray:#[2r00000000
-                                 2r00000000
-                                 2r00000000
-                                 2r00000001
-                                 2r00000011
-                                 2r00000111
-                                 2r00001111
-                                 2r00011111
-                                ]
-                     onDevice:device.
-        resizeButton := Button label: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 activeLevel:0; passiveLevel:0.
-        resizeButton cursor:(Cursor corner).
+	form := Form width:8 height:8
+		     fromArray:#[2r00000000
+				 2r00000000
+				 2r00000000
+				 2r00000001
+				 2r00000011
+				 2r00000111
+				 2r00001111
+				 2r00011111
+				]
+		     onDevice:device.
+	resizeButton := Button label: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 activeLevel:0; passiveLevel:0.
+	resizeButton cursor:(Cursor corner).
 
-        form := Form width:8 height:8
-                     fromArray:#[2r11111000
-                                 2r11110000
-                                 2r11100000
-                                 2r11000000
-                                 2r10000000
-                                 2r00000000
-                                 2r00000000
-                                 2r00000000
-                                ]
-                     onDevice:device.
-        moveButton := Button label: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 activeLevel:0; passiveLevel:0.
-        moveButton cursor:(Cursor origin)
+	form := Form width:8 height:8
+		     fromArray:#[2r11111000
+				 2r11110000
+				 2r11100000
+				 2r11000000
+				 2r10000000
+				 2r00000000
+				 2r00000000
+				 2r00000000
+				]
+		     onDevice:device.
+	moveButton := Button label: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 activeLevel:0; passiveLevel:0.
+	moveButton cursor:(Cursor origin)
     ].
 
     "Modified (format): / 08-02-2017 / 00:26:36 / cg"
@@ -403,7 +403,7 @@
 reinitialize
     "if I have already been reinited - return"
     self drawableId notNil ifTrue:[
-        ^ self
+	^ self
     ].
     "physically create the view & subviews"
     self recreate.
@@ -425,17 +425,17 @@
 
     maxExtent := self maxExtent.
     maxExtent notNil ifTrue:[
-        newExtent := newExtent min:maxExtent.
+	newExtent := newExtent min:maxExtent.
     ].
     newExtent ~= self extent ifTrue:[
-        (shown and:[shadowView notNil]) ifTrue:[
-            shadowView unmap.
-            self extent:newExtent.
-            shadowView realize.
-            self raise
-        ] ifFalse:[
-            self extent:newExtent.
-        ].
+	(shown and:[shadowView notNil]) ifTrue:[
+	    shadowView unmap.
+	    self extent:newExtent.
+	    shadowView realize.
+	    self raise
+	] ifFalse:[
+	    self extent:newExtent.
+	].
     ].
 
     "Modified: / 21-01-2011 / 13:50:11 / cg"
@@ -453,31 +453,31 @@
     newExtent = self extent ifTrue:[^ self].
 
     shown ifTrue:[
-        "/ new code (after 15.3.2017)
-        
-        newWidth := newExtent x.
-        newHeight := newExtent y.
-        newLeft := left.
-        newTop := top.
-        newRight := left + newWidth.
-        newBottom := top + newHeight.
-        newRight > device usableWidth ifTrue:[
-            newLeft := device usableWidth - newWidth.
-            newLeft < 0 ifTrue:[
-                newLeft := 0.
-                newRight := newWidth := device usableWidth.
-            ].    
-        ].
-        newBottom > device usableHeight ifTrue:[
-            newTop := device usableHeight - newHeight.
-            newTop < 0 ifTrue:[
-                newTop := 0.
-                newBottom := newHeight := device usableHeight.
-            ].    
-        ].
-        newExtent := newWidth @ newHeight.
+	"/ new code (after 15.3.2017)
 
-"/ old code (before 15.3.2017).        
+	newWidth := newExtent x.
+	newHeight := newExtent y.
+	newLeft := left.
+	newTop := top.
+	newRight := left + newWidth.
+	newBottom := top + newHeight.
+	newRight > device usableWidth ifTrue:[
+	    newLeft := device usableWidth - newWidth.
+	    newLeft < 0 ifTrue:[
+		newLeft := 0.
+		newRight := newWidth := device usableWidth.
+	    ].
+	].
+	newBottom > device usableHeight ifTrue:[
+	    newTop := device usableHeight - newHeight.
+	    newTop < 0 ifTrue:[
+		newTop := 0.
+		newBottom := newHeight := device usableHeight.
+	    ].
+	].
+	newExtent := newWidth @ newHeight.
+
+"/ old code (before 15.3.2017).
 "/        delta := width - newExtent x.
 "/        newLeft := left + delta.
 "/        (((newLeft @ top) extent:newExtent) containsPoint:device pointerPosition
@@ -489,16 +489,16 @@
 "/        newLeft + newExtent x > screenWidth ifTrue:[
 "/            newLeft := screenWidth - newExtent x
 "/        ].
-        shadowView notNil ifTrue:[
-            shadowView unmap.
-        ].
-        self origin:(newLeft @ newTop) extent:newExtent.
-        shadowView notNil ifTrue:[
-            shadowView realize.
-            self raise.
-        ].
+	shadowView notNil ifTrue:[
+	    shadowView unmap.
+	].
+	self origin:(newLeft @ newTop) extent:newExtent.
+	shadowView notNil ifTrue:[
+	    shadowView realize.
+	    self raise.
+	].
     ] ifFalse:[
-        self extent:newExtent.
+	self extent:newExtent.
     ].
 
     "Modified: / 06-09-1995 / 15:31:21 / claus"
@@ -517,12 +517,12 @@
 
     r := device rectangleFromUser:(self origin corner:self corner) keepExtent:true.
     shadowView notNil ifTrue:[
-        shadowView unmap
+	shadowView unmap
     ].
     self origin:r origin extent:(self extent).
     shadowView notNil ifTrue:[
-        shadowView realize.
-        self raise.
+	shadowView realize.
+	self raise.
     ].
 
     "Modified: 3.5.1996 / 23:47:38 / stefan"
@@ -538,12 +538,12 @@
 
     r := device rectangleFromUser:(self origin corner:self corner).
     shadowView notNil ifTrue:[
-        shadowView unmap
+	shadowView unmap
     ].
     self origin:r origin extent:(r extent max:(100@100)).
     shadowView notNil ifTrue:[
-        shadowView realize.
-        self raise
+	shadowView realize.
+	self raise
     ].
 
     "Modified: 3.5.1996 / 23:47:47 / stefan"
@@ -605,7 +605,7 @@
      If the size is not fixed, adjust my size."
 
     sizeFixed ifFalse:[
-        self resize.
+	self resize.
     ].
     super fixSize.
 
@@ -621,28 +621,28 @@
 
     shadowView notNil ifTrue:[shadowView unmap].
     windowGroup notNil ifTrue:[
-        windowGroup focusView:nil.
-        masterGroup := windowGroup previousGroup.
+	windowGroup focusView:nil.
+	masterGroup := windowGroup previousGroup.
     ].
 
     exclusiveKeyboard ifTrue:[
-        self forceUngrabKeyboard
+	self forceUngrabKeyboard
     ].
 
     self unmap.
 
     masterGroup notNil ifTrue:[
-        "
-         this is a kludge for IRIS and others which do 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.
-        "
-        device sync.     "/ that's a round trip, to ensure that all expose events are present..."
-        Delay waitForSeconds:0.05.
-        masterGroup processExposeEvents
+	"
+	 this is a kludge for IRIS and others which do 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.
+	"
+	device sync.     "/ that's a round trip, to ensure that all expose events are present..."
+	Delay waitForSeconds:0.05.
+	masterGroup processExposeEvents
     ].
 
     "Modified: 3.5.1996 / 23:47:57 / stefan"
@@ -785,14 +785,14 @@
 
     self fixSize.
     centerX ifTrue:[
-        dx := self width // 2.
+	dx := self width // 2.
     ] ifFalse:[
-        dx := 0
+	dx := 0
     ].
     centerY ifTrue:[
-        dy := self height // 2.
+	dy := self height // 2.
     ] ifFalse:[
-        dy := 0
+	dy := 0
     ].
     self origin:(aPoint - (dx @ dy)).
     self makeFullyVisible.
@@ -824,8 +824,8 @@
 
 showAtPointer
     "make myself visible at mouse pointer shifted to have
-     convenient button under cursor. 
-     self positionOffset should return that offset 
+     convenient button under cursor.
+     self positionOffset should return that offset
      (usually redefined, since we don't know here, which button should be under cursor)."
 
     |first pointerPosition positionOffset pos monitorBounds alignedPos|
@@ -838,8 +838,8 @@
     pos := alignedPos := pointerPosition - positionOffset.
 
     UserPreferences current forceWindowsIntoMonitorBounds ifTrue:[
-        monitorBounds := device monitorBoundsAt:pointerPosition.
-        alignedPos := (pos x max:monitorBounds left) @ (pos y max:monitorBounds top).
+	monitorBounds := device monitorBoundsAt:pointerPosition.
+	alignedPos := (pos x max:monitorBounds left) @ (pos y max:monitorBounds top).
     ].
 
     positionOffset := pointerPosition - alignedPos.
@@ -848,29 +848,29 @@
     pos := self origin.
 
     "We have got a problem here:
-        X11 adds some window decoration. The size of the decoration is only known
-        after the view is visible!!
+	X11 adds some window decoration. The size of the decoration is only known
+	after the view is visible!!
 
-        So there is a (hopefully) small offset from the pointer to the requested
-        position. The only way to resolve this, is to move the pointer to
-        the requested position after the view is visible"
+	So there is a (hopefully) small offset from the pointer to the requested
+	position. The only way to resolve this, is to move the pointer to
+	the requested position after the view is visible"
 
     first := true.
     self openModal:[
-        (first and:[shown]) ifTrue:[
-            first := false.
-            false ifTrue:[
-                "/ cg: no longer move the mouse to the OK button!!
-                "/ the mouse will fall down the desk if we do that too often... ;-)
+	(first and:[shown]) ifTrue:[
+	    first := false.
+	    false ifTrue:[
+		"/ cg: no longer move the mouse to the OK button!!
+		"/ the mouse will fall down the desk if we do that too often... ;-)
 
-                "in Linux - SuSe Tumbleweed 2016-01 the Delay is required, otherwise the pointer
-                 is shown relative to the root window. No idea why this is needed. 
-                 Maybe the window manager (kwin) does something."
-                Delay waitForMilliseconds:10.
-                self setPointerPosition:positionOffset.
-            ].
-        ].
-        true
+		"in Linux - SuSe Tumbleweed 2016-01 the Delay is required, otherwise the pointer
+		 is shown relative to the root window. No idea why this is needed.
+		 Maybe the window manager (kwin) does something."
+		Delay waitForMilliseconds:10.
+		self setPointerPosition:positionOffset.
+	    ].
+	].
+	true
     ].
 
     "/ cannot use:
@@ -900,30 +900,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 usableWidth ifTrue:[
-            newX := device usableWidth - width
-        ].
-        pos x:newX.
+	"
+	 try to the right of the untouchable view
+	"
+	newX := (aView origin x + aView width).
+	newX + width > device usableWidth ifTrue:[
+	    newX := device usableWidth - 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