hg/stx-libview: comparison View.st

equal deleted inserted replaced

-:8f9c629a4245
+:ea2bf46eb669
 classVariableNames:   'Grey CentPoint
 			      ViewSpacing
 			      DefaultStyle StyleSheet
 			      DefaultViewBackgroundColor DefaultBorderColor
 			      DefaultLightColor DefaultShadowColor
-			      DefaultBorderWidth DefaultFont'
+			      DefaultBorderWidth DefaultFont
+			      DefaultFocusColor DefaultFocusBorderWidth'
 poolDictionaries:     ''
 category:'Views-Basic'
 !
 View class instanceVariableNames:'ClassResources'!
 View comment:'
 COPYRIGHT (c) 1989 by Claus Gittinger
 	      All Rights Reserved
-$Header: /cvs/stx/stx/libview/View.st,v 1.25 1994-12-21 19:19:18 claus Exp $
+$Header: /cvs/stx/stx/libview/View.st,v 1.26 1995-02-06 00:38:04 claus Exp $
 '!
 "this flag controls (globally) how views look - it will vanish"
 Smalltalk at:#View3D put:false!
 "
 !
 version
 "
-$Header: /cvs/stx/stx/libview/View.st,v 1.25 1994-12-21 19:19:18 claus Exp $
+$Header: /cvs/stx/stx/libview/View.st,v 1.26 1995-02-06 00:38:04 claus Exp $
 "
 !
 documentation
 "
 ! !
 !View class methodsFor:'initialization'!
 initialize
-"Workstation initialize."
 super initialize.
 Form initialize.
 Color initialize.
+"/    self updateStyleCache
 ! !
 !View class methodsFor:'defaults'!
 defaultExtent
 DefaultBorderWidth := StyleSheet at:'borderWidth' default:0.
 DefaultBorderColor := StyleSheet colorAt:'borderColor' default:Black.
 DefaultViewBackgroundColor := StyleSheet colorAt:'viewBackground' default:bgGrey.
 DefaultShadowColor := StyleSheet colorAt:'shadowColor'.
 DefaultLightColor := StyleSheet colorAt:'lightColor'.
+DefaultFocusColor := StyleSheet colorAt:'focusColor' default:Color red.
+DefaultFocusBorderWidth := StyleSheet at:'focusBorderWidth' default:2.
 DefaultFont := StyleSheet at:'font'.
 DefaultFont isNil ifTrue:[
 	DefaultFont := Font family:'courier' face:'medium' style:'roman' size:12.
 ].
 and the style specific setup in initStyle. Each view should be prepared
 for a stylechange by being sent another initStyle with a new style value.
 (in this case, it should set all of its style-dependent things, but
 leave the state and contents as-is)"
-|ext|
+|ext controllerClass|
 super initialize.
 font := DefaultFont.
 viewOrigin := 0@0.
 originChanged := extentChanged := false.
 bitGravity := nil.
 viewGravity := nil.
-"
+controllerClass := self defaultController.
-controller := self defaultController new.
+controllerClass notNil ifTrue:[
-controller view:self.
+	controller := controllerClass new.
-"
+	controller view:self.
+	model notNil ifTrue:[
+	    controller model:model
+	]
+].
 !
 defaultController
-^ Controller
+^ nil "/ Controller
 !
 initStyle
 "this method sets up all style dependent things"
 controller:aController
 "set the controller"
 controller := aController.
-controller view:self.
+controller notNil ifTrue:[
-controller model:model
+	controller view:self.
+	controller model:model
+]
 !
 model
 "return the model, for non-MVC views,
 this is usually the receiver"
 change:changeMsg
 "ST-80 style change notification. If a views changeSymbol is nonNil,
 it will send it to its model when something changes."
 changeSymbol := changeMsg
+!
+changeSymbol
+"Return the symbol sent to the model if nonNil when something changes."
+^ changeSymbol
 !
 menu:menuMsg
 "ST-80 style menus. If a views menuSymbol is nonNil, it
 will send it to its model when the middleButton is pressed.
 That method should return nil or the menu to be shown.
 This is useful for very dynamic menus, where it does not
 make sense to define an initial menu."
 menuSymbol := menuMsg
+!
+menuSymbol
+"Return the symbol sent to the model to aquire the menu"
+^ menuSymbol
 ! !
 !View methodsFor:'accessing-dimensions'!
 left:aNumber
 "set the views extent; extent may be:
 a point where integer fields mean pixel-values
 and float values mean relative-to-superview;
 or a block returning a point"
-|w h pixelExtent|
+|w h pixelExtent e|
 extent isBlock ifTrue:[
 	extentRule := extent.
 	drawableId notNil ifTrue:[
 	    pixelExtent := extent value
 	    extentChanged := true
 	]
 ] ifFalse:[
 	w := extent x.
 	h := extent y.
+	w isNil ifTrue:[w := width].
+	h isNil ifTrue:[h := height].
+	e := w@h.
 	((w isMemberOf:Float) or:[h isMemberOf:Float]) ifTrue:[
-	    relativeExtent := extent.
+	    relativeExtent := e.
 	    pixelExtent := self extentFromRelativeExtent.
 	    pixelExtent isNil ifTrue:[
 		extentChanged := true
 	    ]
 	] ifFalse:[
-	    pixelExtent := extent
+	    pixelExtent := e
 	]
 ].
 pixelExtent notNil ifTrue:[
 	self pixelExtent:pixelExtent
 ]
 "set the views origin; origin may be:
 a point where integer fields mean pixel-values
 and float values mean relative-to-superview;
 or a block returning a point"
-|newLeft newTop pixelOrigin|
+|newLeft newTop pixelOrigin o|
 origin isBlock ifTrue:[
 	originRule := origin.
 	drawableId notNil ifTrue:[
 	    pixelOrigin := origin value
 	] ifFalse:[
 	    originChanged := true
 	]
 ] ifFalse:[
+	o := origin.
 	newLeft := origin x.
 	newTop := origin y.
+	newLeft isNil ifTrue:[newLeft := left].
+	newTop isNil ifTrue:[newTop := top].
+	o := newLeft @ newTop.
 	((newLeft isMemberOf:Float) or:[newTop isMemberOf:Float]) ifTrue:[
-	    relativeOrigin := origin.
+	    relativeOrigin := o.
 	    pixelOrigin := self originFromRelativeOrigin.
 	    pixelOrigin isNil ifTrue:[
 		originChanged := true
 	    ]
 	] ifFalse:[
-	    pixelOrigin := origin
+	    pixelOrigin := o
 	]
 ].
 pixelOrigin notNil ifTrue:[
 	self pixelOrigin:pixelOrigin
 ].
 "set the views  corner;  corner may be:
 a point where integer fields mean pixel-values
 and float values mean relative-to-superview;
 or a block returning a point"
-|x y pixelCorner|
+|x y pixelCorner c|
 corner isBlock ifTrue:[
 	cornerRule := corner.
 	drawableId notNil ifTrue:[
 	    pixelCorner := corner value
 	    extentChanged := true
 	]
 ] ifFalse:[
 	x := corner x.
 	y := corner y.
+	x isNil ifTrue:[x := self corner x].
+	y isNil ifTrue:[y := self corner y].
+	c := x @ y.
 	((x isMemberOf:Float) or:[y isMemberOf:Float]) ifTrue:[
-	    relativeCorner := corner.
+	    relativeCorner := c.
 	    pixelCorner := self cornerFromRelativeCorner.
 	    pixelCorner isNil ifTrue:[
 		extentChanged := true
 	    ]
 	] ifFalse:[
-	    pixelCorner := corner
+	    pixelCorner := c
 	]
 ].
 pixelCorner notNil ifTrue:[
 	self pixelCorner:pixelCorner
 !
 viewport:aRectangle
 "define my extend in my superviews coordinate-system."
-|relW relH relX relY winW winH|
+"/    |relW relH relX relY winW winH|
 viewport := aRectangle.
 self dimensionFromViewport
-"
+"/
-superView notNil ifTrue:[
+"/    superView notNil ifTrue:[
-	superView window isNil ifTrue:[
+"/        superView window isNil ifTrue:[
-	    winW := 1.
+"/            winW := 1.
-	    winH := 1
+"/            winH := 1
-	] ifFalse:[
+"/        ] ifFalse:[
-	    winW := superView window width.
+"/            winW := superView window width.
-	    winH := superView window height
+"/            winH := superView window height
-	].
+"/        ].
-	relW := (aRectangle width / winW) asFloat.
+"/        relW := (aRectangle width / winW) asFloat.
-	relH := (aRectangle height / winH) asFloat.
+"/        relH := (aRectangle height / winH) asFloat.
-	relX := (aRectangle left / winW) asFloat.
+"/        relX := (aRectangle left / winW) asFloat.
-	relY := (aRectangle top / winH) asFloat.
+"/        relY := (aRectangle top / winH) asFloat.
-	self origin:(relX @ relY) extent:(relW @ relH)
+"/        self origin:(relX @ relY) extent:(relW @ relH)
-]
+"/    ]
-"
+"/
 !
 window:aRectangle viewport:vRect
 window := aRectangle.
 self viewport:vRect.
 subViews notNil ifTrue:[
 	subViews do:[:s |
 	    s superViewChangedSize
 	]
 ]
+!
+scale
+"return the scale factor (as point) of the transformation"
+transformation isNil ifTrue:[^ 1].
+^ transformation scale
+!
+scale:aPoint
+"set the scale factor of the transformation"
+transformation isNil ifTrue:[
+	aPoint = 1 ifTrue:[^ self].
+	transformation := WindowingTransformation scale:aPoint translation:0
+].
+transformation scale:aPoint.
+self computeInnerClip
 !
 transformation
 "return the transformation"
 viewOrigin
 "return the viewOrigin; thats the coordinate of the contents
 which is shown topLeft in the view
 (i.e. the origin of the visible part of the contents)."
-^ viewOrigin
+transformation isNil ifTrue:[
+	^ 0@0
+].
+^ transformation translation negated
 !
 setViewOrigin:aPoint
 "set the viewOrigin - i.e. virtually scroll without redrawing"
-viewOrigin := aPoint
+|p|
+p := aPoint negated.
+transformation isNil ifTrue:[
+	transformation := WindowingTransformation scale:1 translation:p
+] ifFalse:[
+	transformation translation:p
+].
+clipRect notNil ifTrue:[
+	self setInnerClip.
+].
 !
 xOriginOfContents
-"return the x coordinate of the viewOrigin;
+"return the x coordinate of the viewOrigin in pixels;
 used by scrollBars to compute thumb position within the document."
 ^ self viewOrigin x
 !
 yOriginOfContents
-"return the y coordinate of the viewOrigin;
+"return the y coordinate of the viewOrigin in pixels;
 used by scrollBars to compute thumb position within the document."
 ^ self viewOrigin y
 !
 heightOfContents
-"return the height of the contents in pixels
+"return the height of the contents in logical units
 - defaults to views visible area here.
 This method MUST be redefined in all view classess which are
 going to be scrolled AND show data which has different size than
 the view. For example, a view showing A4-size documents should return
 the number of vertical pixels such a document has on this device.
 A view showing a bitmap of height 1000 should return 1000.
 If not redefined, scrollbars have no way of knowing the actual size
 of the contents being shown. This is called by scrollBars to compute
-the relative height of the document vs. the views actual size."
+the relative height of the document vs. the views actual size.
+The value returned here must be based on a scale of 1, since users
+of this will scale as appropriate."
 ^ self innerHeight
 !
 widthOfContents
-"return the width of the contents in pixels
+"return the width of the contents in logical units
 - defaults to views visible area here.
 This method MUST be redefined in all view classess which are
 going to be scrolled AND show data which has different size than
 the view. For example, a view showing A4-size documents should return
 the number of horizontal pixels such a document has on this device.
 A view showing a bitmap of width 700 should return 700.
 If not redefined, scrollbars have no way of knowing the actual size
 of the contents being shown. This is called by scrollBars to compute
-the relative width of the document vs. the views actual size."
+the relative width of the document vs. the views actual size.
+The value returned here must be based on a scale of 1, since users
+of this will scale as appropriate."
 ^ self innerWidth
 ! !
 !View methodsFor:'accessing-hierarchy'!
 tell dependents about the change (i.e. scrollers)."
 self changed:#sizeOfContents
 ! !
+!View methodsFor:'scrolling-basic'!
+scrollDown:nPixels
+"change origin to scroll down some pixels"
+|count "{ Class:SmallInteger }"
+m2    "{ Class:SmallInteger }"
+w     "{ Class:SmallInteger }"
+h     "{ Class:SmallInteger }"
+hCont
+ih    "{ Class:SmallInteger }"
+orgX orgY|
+hCont := self heightOfContents.
+transformation isNil ifTrue:[
+	orgY := orgX := 0
+] ifFalse:[
+	hCont := (transformation applyScaleY:hCont) rounded.
+	orgY := transformation translation y negated.
+	orgX := transformation translation x negated.
+].
+count := nPixels.
+ih := self innerHeight.
+((orgY + nPixels + ih) > hCont) ifTrue:[
+	count := hCont - orgY - ih
+].
+(count <= 0) ifTrue:[^ self].
+self originWillChange.
+self setViewOrigin:(orgX @ (orgY + count)).
+m2 := margin * 2.
+(count >= ih) ifTrue:[
+	self redrawDeviceX:margin y:margin
+		     width:(width - m2)
+		    height:(height - m2).
+] ifFalse:[
+	h := height - m2 - count.
+	w := self width.
+	self catchExpose.
+	self copyFrom:self x:margin y:(count + margin)
+			 toX:margin y:margin
+		       width:w
+		      height:h.
+	self setInnerClip.
+	self redrawDeviceX:margin y:(h + margin)
+		     width:(width - m2) height:count.
+	self waitForExpose.
+].
+self originChanged:(0 @ count).
+!
+scrollUp:nPixels
+"change origin to scroll up (towards the origin) by some pixels"
+|count "{ Class:SmallInteger }"
+m2    "{ Class:SmallInteger }"
+w     "{ Class:SmallInteger }"
+h     "{ Class:SmallInteger }"
+orgX
+orgY  "{ Class:SmallInteger }"|
+transformation isNil ifTrue:[
+	orgY := orgX := 0
+] ifFalse:[
+	orgY := transformation translation y negated.
+	orgX := transformation translation x negated
+].
+count := nPixels.
+(count > orgY) ifTrue:[
+	count := orgY
+].
+(count <= 0) ifTrue:[^ self].
+self originWillChange.
+self setViewOrigin:(orgX @ (orgY - count)).
+m2 := margin * 2. "top & bottom margins"
+(count >= self innerHeight) ifTrue:[
+	self redrawDeviceX:margin y:margin
+		     width:(width - m2)
+		    height:(height - m2).
+] ifFalse:[
+	h := height - m2 - count.
+	w := width.
+	self catchExpose.
+	self copyFrom:self x:margin y:margin
+			 toX:margin y:(count + margin)
+		       width:w height:h.
+	self setInnerClip.
+	self redrawDeviceX:margin y:margin
+		     width:(width - m2)
+		    height:count.
+	self waitForExpose.
+].
+self originChanged:(0 @ count negated).
+!
+scrollLeft:nPixels
+"change origin to scroll left some pixels"
+|count "{ Class:SmallInteger }"
+m2    "{ Class:SmallInteger }"
+h     "{ Class:SmallInteger }"
+orgX orgY|
+transformation isNil ifTrue:[
+	orgY := orgX := 0
+] ifFalse:[
+	orgY := transformation translation y negated.
+	orgX := transformation translation x negated.
+].
+count := nPixels.
+(count > orgX) ifTrue:[
+	count := orgX
+].
+(count <= 0) ifTrue:[^ self].
+self originWillChange.
+self setViewOrigin:(orgX - count) @ orgY.
+m2 := margin * 2.
+(count >= self innerWidth) ifTrue:[
+	self redrawDeviceX:margin y:margin
+		     width:(width - m2)
+		    height:(height - m2).
+] ifFalse:[
+	h := (height - m2).
+	self catchExpose.
+	self copyFrom:self x:margin y:margin
+			 toX:(count + margin) y:margin
+		       width:(width - m2 - count)
+		      height:h.
+	self setInnerClip.
+	self redrawDeviceX:margin y:margin
+		     width:count height:(height - m2).
+	self waitForExpose.
+].
+self originChanged:(count negated @ 0).
+!
+scrollRight:nPixels
+"change origin to scroll right some pixels"
+|count "{ Class:SmallInteger }"
+m2    "{ Class:SmallInteger }"
+h     "{ Class:SmallInteger }"
+wCont
+iw    "{ Class:SmallInteger }"
+orgX orgY|
+wCont := self widthOfContents.
+transformation isNil ifTrue:[
+	orgY := orgX := 0
+] ifFalse:[
+	wCont := (transformation applyScaleX:wCont) rounded.
+	orgY := transformation translation y negated.
+	orgX := transformation translation x negated.
+].
+count := nPixels.
+iw := self innerWidth.
+((orgX + nPixels + iw) > wCont) ifTrue:[
+	count := wCont - orgX - iw
+].
+(count <= 0) ifTrue:[^ self].
+self originWillChange.
+self setViewOrigin:(orgX + count) @ orgY.
+m2 := margin * 2.
+(count >= iw) ifTrue:[
+	self redrawDeviceX:margin y:margin
+		     width:(width - m2)
+		    height:(height - m2).
+] ifFalse:[
+	m2 := margin * 2.
+	h := (height - m2).
+	self catchExpose.
+	self copyFrom:self x:(count + margin) y:margin
+			 toX:margin y:margin
+		       width:(width - m2 - count)
+		      height:h.
+	self setInnerClip.
+	self redrawDeviceX:(width - margin - count) y:margin
+		     width:count height:(height - m2).
+	self waitForExpose.
+].
+self originChanged:(count @ 0).
+! !
 !View methodsFor:'scrolling'!
 widthForScrollBetween:yStart and:yEnd
 "return the width in pixels for a scroll between yStart and yEnd
 - return full width here since we do not know how wide contents is.
 !
 scrollVerticalToPercent:percent
 "scroll to a position given in percent of total"
+|hCont|
+hCont := self heightOfContents.
+transformation notNil ifTrue:[
+	hCont := transformation applyScaleY:hCont.
+].
 self scrollVerticalTo:
-	    ((((self heightOfContents * percent) / 100.0) + 0.5) asInteger)
+	    ((((hCont * percent) / 100.0) + 0.5) asInteger)
 !
 scrollVerticalTo:aPixelOffset
 "change origin to make aPixelOffset be the top line"
 !
 scrollHorizontalToPercent:percent
 "scroll to a position given in percent of total"
+|wCont|
+wCont := self widthOfContents.
+transformation notNil ifTrue:[
+	wCont := transformation applyScaleX:wCont.
+].
 self scrollHorizontalTo:
-	    ((((self widthOfContents * percent) / 100.0) + 0.5) asInteger)
+	    ((((wCont * percent) / 100.0) + 0.5) asInteger)
 !
 scrollHorizontalTo:aPixelOffset
 "change origin to make aPixelOffset be the left col"
 scrollToTopLeft
 "move viewOrigin to top/left"
 self scrollVerticalTo:0.
 self scrollHorizontalTo:0
-!
-scrollUp:nPixels
-"change origin to scroll up (towards the origin) by some pixels"
-|count "{ Class:SmallInteger }"
-m2    "{ Class:SmallInteger }"
-w     "{ Class:SmallInteger }"
-h     "{ Class:SmallInteger }"
-viewOrigin
-orgY  "{ Class:SmallInteger }"|
-viewOrigin := self viewOrigin.
-orgY := viewOrigin y.
-count := nPixels.
-(count > orgY) ifTrue:[
-	count := orgY
-].
-(count <= 0) ifTrue:[^ self].
-self originWillChange.
-self setViewOrigin:(viewOrigin x @ (orgY - count)).
-(count >= self innerHeight) ifTrue:[
-	self redraw.
-] ifFalse:[
-	m2 := margin * 2. "top & bottom margins"
-	h := height - m2 - count.
-	w := self widthForScrollBetween:orgY and:(orgY + h).
-	w := w min:(width - m2).
-	self catchExpose.
-	self copyFrom:self x:margin y:margin
-			 toX:margin y:(count + margin)
-		       width:w height:h.
-	self redrawDeviceX:margin y:margin
-		     width:(width - m2)
-		    height:count.
-	self waitForExpose.
-].
-self originChanged:(0 @ count negated).
 !
 scrollUp
 "scroll up by some amount; this is called when the scrollbars
 scroll-step up button is pressed."
 self scrollUp:(self verticalScrollStep)
 !
-scrollDown:nPixels
-"change origin to scroll down some pixels"
-|count "{ Class:SmallInteger }"
-m2    "{ Class:SmallInteger }"
-w     "{ Class:SmallInteger }"
-h     "{ Class:SmallInteger }"
-hCont "{ Class:SmallInteger }"
-ih    "{ Class:SmallInteger }"
-viewOrigin orgY|
-viewOrigin := self viewOrigin.
-orgY := viewOrigin y.
-count := nPixels.
-hCont := self heightOfContents.
-ih := self innerHeight.
-((orgY + nPixels + ih) > hCont) ifTrue:[
-	count := hCont - orgY - ih
-].
-(count <= 0) ifTrue:[^ self].
-self originWillChange.
-viewOrigin := viewOrigin x @ (orgY + count).
-self setViewOrigin:viewOrigin.
-(count >= ih) ifTrue:[
-	self redraw.
-] ifFalse:[
-	m2 := margin * 2.
-	h := height - m2 - count.
-	w := self widthForScrollBetween:orgY and:(orgY + h).
-	w := w min:(width - m2).
-	self catchExpose.
-	self copyFrom:self x:margin y:(count + margin)
-			 toX:margin y:margin
-		       width:w
-		      height:h.
-	self redrawDeviceX:margin y:(h + margin)
-		     width:(width - m2) height:count.
-	self waitForExpose.
-].
-self originChanged:(0 @ count).
-!
 scrollDown
 "scroll down by some amount; this is called when the scrollbars
 scroll-step down button is pressed."
 self scrollDown:(self verticalScrollStep)
 !
-scrollLeft:nPixels
-"change origin to scroll left some pixels"
-|count "{ Class:SmallInteger }"
-m2    "{ Class:SmallInteger }"
-h     "{ Class:SmallInteger }"
-viewOrigin orgX|
-viewOrigin := self viewOrigin.
-orgX := viewOrigin x.
-count := nPixels.
-(count > orgX) ifTrue:[
-	count := orgX
-].
-(count <= 0) ifTrue:[^ self].
-self originWillChange.
-viewOrigin := (orgX - count) @ viewOrigin y.
-self setViewOrigin:viewOrigin.
-(count >= self innerWidth) ifTrue:[
-	self redraw.
-] ifFalse:[
-	m2 := margin * 2.
-	h := (height - m2).
-	self catchExpose.
-	self copyFrom:self x:margin y:margin
-			 toX:(count + margin) y:margin
-		       width:(width - m2 - count)
-		      height:h.
-	self redrawDeviceX:margin y:margin
-		     width:count height:(height - m2).
-	self waitForExpose.
-].
-self originChanged:(count negated @ 0).
-!
 scrollLeft
 "scroll left by some amount; this is called when the scrollbars
 scroll-step left button is pressed."
 self scrollLeft:(self horizontalScrollStep)
-!
-scrollRight:nPixels
-"change origin to scroll right some pixels"
-|count "{ Class:SmallInteger }"
-m2    "{ Class:SmallInteger }"
-h     "{ Class:SmallInteger }"
-wCont "{ Class:SmallInteger }"
-iw    "{ Class:SmallInteger }"
-viewOrigin orgX|
-viewOrigin := self viewOrigin.
-orgX := viewOrigin x.
-count := nPixels.
-wCont := self widthOfContents.
-iw := self innerWidth.
-((orgX + nPixels + iw) > wCont) ifTrue:[
-	count := wCont - orgX - iw
-].
-(count <= 0) ifTrue:[^ self].
-self originWillChange.
-viewOrigin := (orgX + count) @ viewOrigin y.
-self setViewOrigin:viewOrigin.
-(count >= iw) ifTrue:[
-	self redraw.
-] ifFalse:[
-	m2 := margin * 2.
-	h := (height - m2).
-	self catchExpose.
-	self copyFrom:self x:(count + margin) y:margin
-			 toX:margin y:margin
-		       width:(width - m2 - count)
-		      height:h.
-	self redrawDeviceX:(width - margin - count) y:margin
-		     width:count height:(height - m2).
-	self waitForExpose.
-].
-self originChanged:(count @ 0).
 !
 scrollRight
 "scroll right by some amount; this is called when the scrollbars
 scroll-step right button is pressed."
 ^ self
 !
 fixSize
-"adjust size of window according to either relative/abs or
+"This is called right before the view is made visible.
-block extent; also set origin"
+Adjust the size of the view according to either relative/abs or
+block extent; also set origin. Also, subclasses may redefine this
+method to adjust the size based on some extent (for example, PopUpMenus
+do so to take care of changed number of menu entries)."
 window notNil ifTrue:[
 	^ self superViewChangedSize
 ].
 !
 realizeInGroup
 "special realize - leave windowgroup as is; for special applications"
-|superGroup groupChange|
 drawableId isNil ifTrue:[
 	self create.
 ].
 hidden ifTrue:[
 	device synchronizeOutput.
 "
 ].
 model notNil ifTrue:[
-	model removeDependent:self
+	model removeDependent:self.
-].
+	model := nil.
-controller := nil.
+].
+controller notNil ifTrue:[
+	controller release.
+	controller := nil.
+].
 subs := subViews.
 subs notNil ifTrue:[
 	"stupid: destroy removes itself from the subview list
 	 - therefore we have to loop over a copy here"
 self openModal:[true]
 !
 openModal:aBlock
-"create a new windowgroup, but start processing in the current process
+"create a new windowgroup, but start processing in the current process -
 actually suspending event processing for the currently active group.
 Stay in this modal loop while aBlock evaluates to true AND the receiver is
 visible.
 This makes any interaction with the current window impossible -
-however, other views (in their groups) still work."
+however, other views (in other windowgroups) still work."
+|activeGroup tops|
 Processor activeProcessIsSystemProcess ifTrue:[
 	self realize
 ] ifFalse:[
+	activeGroup := WindowGroup activeGroup.
 	"
 	 create a new window group and put myself into it
 	"
 	windowGroup := WindowGroup new.
 	windowGroup addTopView:self.
 	"
 	Object abortSignal handle:[:ex |
 	    self hide.
 	    ex return.
 	] do:[
-	    windowGroup startupModal:[realized and:aBlock]
+	    [
-	].
+		windowGroup startupModal:[realized and:aBlock]
+	    ] valueOnUnwindDo:[
+		self hide.
+	    ]
+	].
+	"
+	 return input focus to previously active groups top.
+	 This helps with windowmanagers which need an explicit click
+	 on the view for the focus.
+	"
+	activeGroup notNil ifTrue:[
+	    tops := activeGroup topViews.
+	    (tops notNil and:[tops notEmpty]) ifTrue:[
+		tops first getKeyboardFocus
+	    ]
+	]
 ]
 !
 openAutonomous
 "create and schedule a new windowgroup for me and open the view.
 		     halfLight:nil
 		     style:nil.
 !
 drawLeftEdgeLevel:level shadow:shadowColor light:lightColor halfShadow:halfShadowColor halfLight:halfLightColor style:edgeStyle
-|leftFg leftHalfFg paint
+|leftFg leftHalfFg paint b
 count "{ Class: SmallInteger }" |
 count := level.
 count == 0 ifTrue:[^ self].
 ].
 leftHalfFg isNil ifTrue:[
 	leftHalfFg := leftFg
 ].
-super lineWidth:0.
 ((edgeStyle == #soft) and:[level > 0]) ifTrue:[
 	paint := leftHalfFg
 ] ifFalse:[
 	paint := leftFg
 ].
 super paint:paint.
+super lineWidth:0.
+b := height - 1.
 0 to:(count - 1) do:[:i |
-	super displayDeviceLineFromX:i y:i toX:i y:(height - 1 - i)
+	super displayDeviceLineFromX:i y:i toX:i y:(b - i)
 ].
 ((edgeStyle == #soft) and:[level > 2]) ifTrue:[
 	super paint:Black.
-	super displayDeviceLineFromX:0 y:0 toX:0 y:height-1.
+	super displayDeviceLineFromX:0 y:0 toX:0 y:b.
 ]
 !
 drawRightEdge
 "draw right 3D edge into window frame"
 !
 drawRightEdgeLevel:level shadow:shadowColor light:lightColor halfShadow:halfShadowColor halfLight:halfLightColor style:edgeStyle
 |rightFg
 count "{ Class: SmallInteger }"
-r|
+r b|
 count := level.
 count == 0 ifTrue:[^ self].
 (count < 0) ifTrue:[
 	    rightFg := halfShadowColor
 	] ifFalse:[
 	    rightFg := shadowColor
 	].
 ].
+super paint:rightFg.
 super lineWidth:0.
-super paint:rightFg.
+b := height - 1.
 0 to:(count - 1) do:[:i |
 	r := width - 1 - i.
-	super displayDeviceLineFromX:r y:i toX:r y:(height - 1 - i)
+	super displayDeviceLineFromX:r y:i toX:r y:(b - i)
 ].
 ((edgeStyle == #soft) and:[level > 1]) ifTrue:[
+	r := width - 1.
 	super paint:shadowColor.
-	super displayDeviceLineFromX:width-1 y:1 toX:width-1 y:height-1.
+	super displayDeviceLineFromX:r y:1 toX:r y:b.
 ]
 !
 drawTopEdge
 "draw top 3D edge into window frame"
 		    halfLight:nil
 		    style:nil.
 !
 drawTopEdgeLevel:level shadow:shadowColor light:lightColor halfShadow:halfShadowColor halfLight:halfLightColor style:edgeStyle
-|topFg topHalfFg
+|topFg topHalfFg paint r
 count "{ Class: SmallInteger }" |
 count := level.
 count == 0 ifTrue:[^ self].
 ].
 topHalfFg isNil ifTrue:[
 	topHalfFg := topFg
 ].
+((edgeStyle == #soft) and:[level > 0]) ifTrue:[
+	paint := topHalfFg
+] ifFalse:[
+	paint := topFg
+].
+super paint:paint.
 super lineWidth:0.
-((edgeStyle == #soft) and:[level > 0]) ifTrue:[
-	super paint:topHalfFg
+r := width - 1.
-] ifFalse:[
-	super paint:topFg
-].
 0 to:(count - 1) do:[:i |
-	super displayDeviceLineFromX:i y:i toX:(width - 1 - i) y:i
+	super displayDeviceLineFromX:i y:i toX:(r - i) y:i
 ].
 ((edgeStyle == #soft) and:[level > 2]) ifTrue:[
 	super paint:Black.
-	super displayDeviceLineFromX:0 y:0 toX:width-1 y:0.
+	super displayDeviceLineFromX:0 y:0 toX:r y:0.
 ]
 !
 drawBottomEdge
 "draw bottom 3D edge into window frame"
 !
 drawBottomEdgeLevel:level shadow:shadowColor light:lightColor halfShadow:halfShadowColor halfLight:halfLightColor style:edgeStyle
 |botFg
 count "{ Class: SmallInteger }"
-b|
+b r|
 count := level.
 count == 0 ifTrue:[^ self].
 (count < 0) ifTrue:[
 	    botFg := halfShadowColor
 	] ifFalse:[
 	    botFg := shadowColor
 	].
 ].
+super paint:botFg.
 super lineWidth:0.
-super paint:botFg.
+r := width - 1.
 0 to:(count - 1) do:[:i |
 	b := height - 1 - i.
-	super displayDeviceLineFromX:i y:b toX:(width "- 1" - i) y:b
+	super displayDeviceLineFromX:i y:b toX:(r - i) y:b
 ].
 ((edgeStyle == #soft) and:[level > 1]) ifTrue:[
+	b := height - 1.
 	super paint:shadowColor.
-	super displayDeviceLineFromX:1 y:height-1 toX:width-1 y:height-1.
+	super displayDeviceLineFromX:1 y:b toX:r y:b.
 ]
 !
 redrawEdges
 "redraw my edges (if any)"
 	ly := transformation applyInverseToY:ly.
 	lw := transformation applyInverseScaleX:lw.
 	lh := transformation applyInverseScaleY:lh.
 ].
 self redrawX:lx y:ly width:lw height:lh
+!
+showFocus
+"highlight myself somehow to tell user that I have the focus"
+|delta|
+drawableId notNil ifTrue:[
+	delta := DefaultFocusBorderWidth - borderWidth.
+	delta ~~ 0 ifTrue:[
+	    device moveWindow:drawableId x:left-delta y:top-delta
+	].
+	device setWindowBorderWidth:DefaultFocusBorderWidth in:drawableId.
+	device setWindowBorderColor:(DefaultFocusColor on:device) colorId in:drawableId.
+]
+!
+showNoFocus
+"undo the effect of showFocus"
+|delta|
+drawableId notNil ifTrue:[
+	delta := DefaultFocusBorderWidth - borderWidth.
+	delta ~~ 0 ifTrue:[
+	    device moveWindow:drawableId x:left+delta y:top+delta
+	].
+	device setWindowBorderWidth:borderWidth in:drawableId.
+	self setBorderColor.
+]
 ! !
 !View methodsFor:'event handling'!
 destroyed
 nothing done here"
 ^ self
 !
+focusIn
+"got keyboard focus"
+self showFocus
+!
+focusOut
+"lost keyboard focus"
+self showNoFocus
+!
 exposeX:x y:y width:w height:h
 "a low level redraw event from device
 - let subclass handle the redraw and take care of edges here"
-|leftEdge topEdge rightEdge botEdge anyEdge nx ny nw nh|
+|leftEdge topEdge rightEdge botEdge anyEdge nx ny nw nh old|
 nw := w.
 nh := h.
 nx := x.
 ny := y.
 anyEdge := false.
 "
-check if there is a need to draw an edge
+check if there is a need to draw an edge (i.e. if margin is hit)
 "
 (margin ~~ 0) ifTrue:[
 	leftEdge := false.
 	topEdge := false.
 	rightEdge := false.
 	    nx := transformation applyToX:nx.
 	    ny := transformation applyToY:ny.
 	    nw := transformation applyScaleX:nw.
 	    nh := transformation applyScaleY:nh.
 	].
+	"
+	 adjust expose rectangle, to exclude the margin.
+	 Care for rounding errors ...
+	"
 	(nx isMemberOf:SmallInteger) ifFalse:[
-	    nw := nw + (nx - nx truncated).
+	    old := nx.
 	    nx := nx truncated.
+	    nw := nw + (nx - old).
 	].
 	(ny isMemberOf:SmallInteger) ifFalse:[
-	    nh := nh + (ny - ny truncated).
+	    old := ny.
 	    ny := ny truncated.
+	    nh := nh + (ny - old).
 	].
 	(nw isMemberOf:SmallInteger) ifFalse:[
 	    nw := nw truncated + 1
 	].
 	(nh isMemberOf:SmallInteger) ifFalse:[
 	    nh := nh truncated + 1
 	].
-	(x < margin) ifTrue:[
+	(nx < margin) ifTrue:[
+	    old := nx.
 	    nx := margin.
-	    nw := nw - (nx - x).
+	    nw := nw - (nx - old).
 	    leftEdge := anyEdge := true.
 	].
-	((x + w - 1) >= (width - margin)) ifTrue:[
+	((nx + nw - 1) >= (width - margin)) ifTrue:[
 	    nw := (width - margin - nx).
 	    rightEdge := anyEdge := true.
 	].
-	(y < margin) ifTrue:[
+	(ny < margin) ifTrue:[
+	    old := ny.
 	    ny := margin.
-	    nh := nh - (ny - y).
+	    nh := nh - (ny - old).
 	    topEdge := anyEdge := true.
 	].
-	((y + h - 1) >= (height - margin)) ifTrue:[
+	((ny + nh - 1) >= (height - margin)) ifTrue:[
 	    nh := (height - margin - ny).
 	    botEdge := anyEdge := true.
 	].
 	transformation notNil ifTrue:[
 	    "
 	    nw := transformation applyInverseScaleX:nw.
 	    nh := transformation applyInverseScaleY:nh.
 	].
 ].
-"redraw inside area"
+"
+redraw inside area
+"
 self redrawX:nx y:ny width:nw height:nh.
-"redraw edge(s)"
+"
+redraw edge(s)
+"
 anyEdge ifTrue:[
 	self clipRect:nil.
 	(topEdge and:[leftEdge and:[botEdge and:[rightEdge]]]) ifTrue:[
 	    self drawEdges
 	] ifFalse:[

changeset 89	ea2bf46eb669
parent 87	b64ce99ebeaa
child 94	8931597dfa3c