Here is the most recent and probably best functioning  change set for
the SystemWindow and SimpleButtonMorph enhancements I've done.
Warning !! The enhancement to the SystemWindow is not backwards
compatible.

The enhancement to SimpleButtonMorph is a way to send update info to
submorphs
while the button is pressed in the way of #actWhilePressed. Probably not
the best name
but it does the job :-)


Karl
-------------- next part --------------
'From Squeak2.8alpha of 19 February 2000 [latest update: #2052] on 30 April 2000 at 3:14:35 pm'!
RectangleMorph subclass: #SimpleButtonMorph
	instanceVariableNames: 'target actionSelector arguments actWhen actWhilePressed oldColor '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Morphic-Widgets'!
MorphicModel subclass: #SystemWindow
	instanceVariableNames: 'labelString stripes label closeBox collapseBox activeOnlyOnTop paneMorphs paneRects collapsedFrame fullFrame isCollapsed menuBox mustNotClose labelWidgetAllowance updatablePanes allowReframeHandles collapseBoxSubMorph '
	classVariableNames: 'TopWindow '
	poolDictionaries: ''
	category: 'Morphic-Windows'!

!SimpleButtonMorph methodsFor: 'initialization' stamp: 'kfr 4/29/2000 17:04'!
initialize

	super initialize.
	self borderWidth: 1.
	self cornerStyle: #rounded.
	self color: (Color r: 0.4 g: 0.8 b: 0.6).
	self borderColor: self color darker.
	target _ nil.
	actionSelector _ #flash.
	arguments _ EmptyArray.
	actWhen _ #buttonUp.
	actWhilePressed _ nil.
	self setDefaultLabel
! !

!SimpleButtonMorph methodsFor: 'accessing' stamp: 'kfr 4/29/2000 17:03'!
actWhilePressed

	^ actWhilePressed 
! !

!SimpleButtonMorph methodsFor: 'accessing' stamp: 'kfr 4/29/2000 17:03'!
actWhilePressed: aSymbolOrString

	(nil = aSymbolOrString or:
	 ['nil' = aSymbolOrString or:
	 [aSymbolOrString isEmpty]])
		ifTrue: [^ actWhilePressed _ nil].

	actWhilePressed _ aSymbolOrString asSymbol. 
! !

!SimpleButtonMorph methodsFor: 'events' stamp: 'kfr 4/29/2000 17:04'!
mouseMove: evt
	actWhen == #buttonDown ifTrue: [^ self].
	(self containsPoint: evt cursorPoint)
		ifTrue: [oldColor ifNotNil: [self color: (oldColor mixed: 1/2 with: Color white)].
				(actWhilePressed ~~ nil)
					ifTrue: [target perform: actWhilePressed ].
				(actWhen == #whilePressed and: [evt anyButtonPressed])
					 ifTrue: [self doButtonAction.
							evt hand noteSignificantEvent: evt]]
		ifFalse: [oldColor ifNotNil: [self color: oldColor].
				(actWhilePressed ~~ nil)
					ifTrue: [target perform: actWhilePressed ]]
! !


!SystemWindow methodsFor: 'initialization' stamp: 'kfr 4/30/2000 15:10'!
addCloseBox
	self addMorph: (closeBox _ SimpleButtonMorph new borderWidth: 1;borderColor: Color black;
			cornerStyle: #square;
			label: '' font: Preferences standardButtonFont; color: Color transparent;
			actionSelector: #delete; target: self; extent: 10 at 10).
	closeBox addMorph: (StringMorph new contents: 'x'; font:(StrikeFont familyName: #ComicBold size: 16); position: 2 @-5; color: Color black)! !

!SystemWindow methodsFor: 'initialization' stamp: 'kfr 4/29/2000 17:06'!
addCollapseBox

	self addMorph: (collapseBox _ SimpleButtonMorph new borderWidth: 0;
			label: '' font: Preferences standardButtonFont;
			cornerStyle: #square;
			 color: Color transparent ;actWhilePressed: #subMorphAction;
			actionSelector: #collapseOrExpand; target: self; extent: 10 at 10).
	
	
	collapseBox addMorph:(RectangleMorph new extent: 6 @ 6; position: 0 @ 0; 
	borderWidth: 1; borderColor: Color black;  color: Color transparent).

	collapseBox addMorph:( RectangleMorph new extent: 7 @ 7;position: 3 @ 3; borderWidth: 1; borderColor: Color black; color: Color transparent).
	
	

! !

!SystemWindow methodsFor: 'initialization' stamp: 'kfr 4/29/2000 16:54'!
initialize
	
	super initialize.
	allowReframeHandles := true.
	labelString ifNil: [labelString _ 'Untitled Window'].
	isCollapsed _ false.
	activeOnlyOnTop _ true.
	paneMorphs _ Array new.
	paneRects _ Array new.
	borderColor _ #raised.
	borderWidth _ 1.
	color _ Color black.
	
	stripes _ Array with: (RectangleMorph newBounds: bounds)  "see extent:"
				with: (RectangleMorph newBounds: bounds).
	self addMorph: (stripes first borderWidth: 1).
	self addMorph: (stripes second borderWidth: 2).
	self addMorph: (label _ StringMorph new contents: labelString;
			font: Preferences windowTitleFont emphasis: 1).
	self setLabelWidgetAllowance.
	self addCloseBox.
	self addMenuControl.
	self addCollapseBox.
	
	Preferences noviceMode ifTrue:
		[closeBox ifNotNil: [closeBox setBalloonText: 'close window'].
		menuBox ifNotNil: [menuBox setBalloonText: 'window menu'].
		collapseBox ifNotNil: [collapseBox setBalloonText: 'collapse/expand window']].
	self on: #mouseEnter send: #spawnReframeHandle: to: self.
	self on: #mouseLeave send: #spawnReframeHandle: to: self.
	label on: #mouseDown send: #relabelEvent: to: self.
	self extent: 300 at 200.
	mustNotClose _ false.
	updatablePanes _ Array new.! !

!SystemWindow methodsFor: 'geometry' stamp: 'kfr 4/29/2000 17:06'!
extent: newExtent
	| inner labelRect |
	isCollapsed
		ifTrue: [super extent: newExtent x @ (self labelHeight + 2)]
		ifFalse: [super extent: newExtent].
	inner _ self innerBounds.
	labelRect _ self labelRect.

	stripes first bounds: (labelRect insetBy: 1).
	stripes second bounds: (labelRect insetBy: 3).
	self setStripeColorsFrom: self paneColorToUse.
	closeBox ifNotNil:
		[closeBox align: closeBox topLeft with: inner topLeft + (4 at 3)].
	
	menuBox ifNotNil:
		[menuBox align: menuBox topLeft with: (inner topLeft + (19 at 1))].
	collapseBox align: collapseBox topRight with: inner topRight - (4 at 3 negated).
	collapseBox submorphs first color: self paneColor.
	collapseBox submorphs second color: self paneColor.
		
	label fitContents; setWidth: (label width min: bounds width - self labelWidgetAllowance).
	label align: label bounds topCenter with: inner topCenter.
	isCollapsed ifFalse: [self setBoundsOfPaneMorphs].
! !

!SystemWindow methodsFor: 'resize/collapse' stamp: 'kfr 4/29/2000 16:45'!
subMorphAction
	(collapseBox containsPoint: self cursorPoint)
	ifTrue:[
	collapseBox submorphs first color: Color gray.
	collapseBox submorphs second color: Color gray.
	collapseBox color: Color transparent]
	ifFalse:[
	collapseBox submorphs first color: self paneColor.
	collapseBox submorphs second color: self paneColor]
	
	! !

MorphicModel subclass: #SystemWindow
	instanceVariableNames: 'labelString stripes label closeBox collapseBox activeOnlyOnTop paneMorphs paneRects collapsedFrame fullFrame isCollapsed menuBox mustNotClose labelWidgetAllowance updatablePanes allowReframeHandles '
	classVariableNames: 'TopWindow '
	poolDictionaries: ''
	category: 'Morphic-Windows'!