'From Squeak2.9alpha of 13 June 2000 [latest update: #3193] on 15 January 2001 at 12:56:27 pm'!

!BorderedMorph methodsFor: 'drawing' stamp: 'dew 12/21/2000 01:39'!
drawOn: aCanvas 
	"Draw a rectangle with a solid, inset, or raised border.
	Note: the raised border color is generated from the receiver's own color,
	while the inset border color is generated from the color of its owner.
	This behavior is visually more consistent. Thanks to Hans-Martin Mosner."

	| insetColor |
	borderWidth = 0 ifTrue: [  "no border"
		"Note: This is the hook for border styles.
			When converting to the new borders we'll just put 0 into the borderWidth"
		super drawOn: aCanvas.
		^ self].

	borderColor == #raised ifTrue: [
		"Use a hack for now"
		aCanvas fillRectangle: self bounds fillStyle: self fillStyle.
		^ aCanvas frameAndFillRectangle: bounds
			fillColor: Color transparent
			borderWidth: borderWidth
			topLeftColor: (borderWidth = 1 ifTrue: [color paler]
										ifFalse: [color lighter])
			bottomRightColor: (borderWidth = 1 ifTrue: [color deeper]
										ifFalse: [color darker])].

	borderColor == #inset ifTrue: [
		insetColor _ owner ifNil: [Color black] ifNotNil: [owner colorForInsets].
		aCanvas fillRectangle: self bounds fillStyle: self fillStyle.
		^ aCanvas frameAndFillRectangle: bounds
			fillColor: Color transparent
			borderWidth: borderWidth
			topLeftColor: (borderWidth = 1 ifTrue: [insetColor deeper]
										ifFalse: [insetColor darker])
			bottomRightColor: (borderWidth = 1 ifTrue: [insetColor paler]
										ifFalse: [insetColor lighter])].

	"solid color border"
	aCanvas fillRectangle: (self bounds insetBy: borderWidth) fillStyle: self fillStyle.
	aCanvas frameAndFillRectangle: bounds
		fillColor: Color transparent
		borderWidth: borderWidth
		borderColor: borderColor.! !


!Browser methodsFor: 'initialize-release' stamp: 'dew 1/13/2001 18:50'!
addAListPane: aListPane to: window at: nominalFractions plus: verticalOffset

	| row switchHeight |

	row _ AlignmentMorph newColumn
		hResizing: #spaceFill;
		vResizing: #spaceFill;
		layoutInset: 0;
		borderWidth: 0;
		layoutPolicy: ProportionalLayout new.
	switchHeight _ 25.
	row 
		addMorph: aListPane
		fullFrame: (
			LayoutFrame 
				fractions: (0@0 corner: 1@1) 
				offsets: (0@0 corner: 0@switchHeight negated)
		).	
	aListPane color: window paneColor.

	self 
		addMorphicSwitchesTo: row 
		at: (
			LayoutFrame 
				fractions: (0@1 corner: 1@1) 
				offsets: (0@switchHeight negated  corner: 0@0)
		).

	window 
		addMorph: row
		fullFrame: (
			LayoutFrame 
				fractions: nominalFractions 
				offsets: (0@verticalOffset corner: 0@0)
		).	
	row borderWidth: 0.
	row on: #mouseEnter send: #paneTransition: to: window.
	row on: #mouseLeave send: #paneTransition: to: window.
! !

!Browser methodsFor: 'initialize-release' stamp: 'dew 1/13/2001 19:00'!
addLowerPanesTo: window at: nominalFractions with: editString

	| verticalOffset row innerFractions |

	row _ AlignmentMorph newColumn
		hResizing: #spaceFill;
		vResizing: #spaceFill;
		layoutInset: 0;
		borderWidth: 1;
		borderColor: #raised;
		layoutPolicy: ProportionalLayout new.

	verticalOffset _ 0.
	innerFractions _ 0@0 corner: 1@0.
	verticalOffset _ self addOptionalAnnotationsTo: row at: innerFractions plus: verticalOffset.
	verticalOffset _ self addOptionalButtonsTo: row  at: innerFractions plus: verticalOffset.

	row 
		addMorph: ((self buildMorphicCodePaneWith: editString) borderWidth: 0)
		fullFrame: (
			LayoutFrame 
				fractions: (innerFractions withBottom: 1) 
				offsets: (0@verticalOffset corner: 0@0)
		).
	window 
		addMorph: row
		frame: nominalFractions.
	"row borderWidth: 0."
	row on: #mouseEnter send: #paneTransition: to: window.
	row on: #mouseLeave send: #paneTransition: to: window.
! !

!Browser methodsFor: 'initialize-release' stamp: 'dew 1/13/2001 18:13'!
buildMorphicSwitches

	| instanceSwitch commentSwitch classSwitch row aColor |

	instanceSwitch _ PluggableButtonMorph
		on: self
		getState: #instanceMessagesIndicated
		action: #indicateInstanceMessages.
	instanceSwitch
		label: 'instance';
		askBeforeChanging: true.
	commentSwitch _ PluggableButtonMorph
		on: self
		getState: #classCommentIndicated
		action: #plusButtonHit.
	commentSwitch
		label: '?' asText allBold;
		askBeforeChanging: true;
		setBalloonText: 'class comment'.
	classSwitch _ PluggableButtonMorph
		on: self
		getState: #classMessagesIndicated
		action: #indicateClassMessages.
	classSwitch
		label: 'class';
		askBeforeChanging: true.
	row _ AlignmentMorph newRow
		hResizing: #spaceFill;
		vResizing: #spaceFill;
		layoutInset: 0;
		borderWidth: 0;
		addMorphBack: instanceSwitch;
		addMorphBack: commentSwitch;
		addMorphBack: classSwitch.

	aColor _ Color colorFrom: self defaultBackgroundColor.
	row submorphs do:
		[:m | m color: aColor.
		m onColor: aColor darker offColor: aColor.
		m borderColor: #raised].

	^ row
! !

!Browser methodsFor: 'initialize-release' stamp: 'dew 1/13/2001 18:25'!
optionalButtonRow
	"Answer a row of control buttons"

	| aRow aButton |
	aRow _ AlignmentMorph newRow.
	aRow setNameTo: 'buttonPane'.
	aRow beSticky.
	aRow hResizing: #spaceFill.
	aRow wrapCentering: #center; cellPositioning: #leftCenter.
	aRow clipSubmorphs: true.
	aRow addTransparentSpacerOfSize: (5@0).
	aRow borderColor: #raised.
	self optionalButtonPairs  do:
			[:tuple |
				aButton _ PluggableButtonMorph
					on: self
					getState: nil
					action: tuple second.
				aButton useRoundedCorners;
					label: tuple first asString;
					onColor: Color transparent offColor: Color transparent.
				tuple size > 2 ifTrue: [aButton setBalloonText: tuple third].
				aRow addMorphBack: aButton.
				aRow addTransparentSpacerOfSize: (3 @ 0)].
	aRow addMorphBack: self diffButton.
	Preferences sourceCommentToggleInBrowsers ifTrue: [aRow addMorphBack: self sourceOrInfoButton].
	^ aRow! !


!Color methodsFor: 'transformations' stamp: 'dew 1/2/2001 16:43'!
deeper
	"Answer a deeper shade of this color."
	| saturation |
	saturation _ self saturation.
	^ Color
		h: self hue
		s: (saturation < 0.01 ifTrue: [0.0] ifFalse: [saturation + 0.15 min: 1.0])
		v: (self brightness - 0.15 max: 0.0)

! !

!Color methodsFor: 'transformations' stamp: 'dew 1/2/2001 16:44'!
paler
	"Answer a paler shade of this color."
	^ Color
		h: self hue
		s: (self saturation - 0.15 max: 0.0)
		v: (self brightness + 0.15 min: 1.0)

! !


!Debugger methodsFor: 'initialize' stamp: 'dew 1/13/2001 18:29'!
optionalButtonRow
	"Answer a button pane affording the user one-touch access to certain functions; the pane is given the formal name 'buttonPane' by which it can be retrieved by code wishing to send messages to widgets residing on the pane"

	| aRow aButton |
	aRow _ AlignmentMorph newRow beSticky.
	aRow setNameTo: 'buttonPane'.
	aRow clipSubmorphs: true.
	aButton _ SimpleButtonMorph new target: self.
	aButton color: Color lightRed; borderWidth: 1; borderColor: Color red darker.
	aRow addTransparentSpacerOfSize: (5@0).
	aRow borderColor: #raised.
	self optionalButtonPairs do:
		[:pair |
				aButton _ PluggableButtonMorph
					on: self
					getState: nil
					action: pair second.
				aButton useRoundedCorners;
					label: pair first asString;
					askBeforeChanging: true;
					onColor: Color transparent offColor: Color transparent.
				aRow addMorphBack: aButton.
				aRow addTransparentSpacerOfSize: (3 @ 0)].
	^ aRow! !


!FileList methodsFor: 'initialization' stamp: 'dew 1/3/2001 00:59'!
optionalButtonRow
	| aRow aButton |
	aRow _ AlignmentMorph newRow beSticky.
	aRow clipSubmorphs: true.
	aRow addTransparentSpacerOfSize: (5@0).
	aRow borderColor: #raised.
	self optionalButtonSpecs do:
			[:spec |
				aButton _ PluggableButtonMorph
					on: self
					getState: nil
					action: spec second.
				aButton useRoundedCorners;
					label: spec first asString;
					askBeforeChanging: true;
					onColor: Color transparent offColor: Color transparent.
				aRow addMorphBack: aButton.
				aRow addTransparentSpacerOfSize: (3 @ 0).
				aButton setBalloonText: spec fourth.
				aRow addTransparentSpacerOfSize: (3 @ 0).

				(spec second == #sortBySize)
					ifTrue:
						[aRow addTransparentSpacerOfSize: (4@0)]].
	^ aRow! !


!PolygonMorph methodsFor: 'drawing' stamp: 'dew 1/9/2001 01:12'!
drawBorderOn: aCanvas usingEnds: anArray 
	"Display my border on the canvas."
	"NOTE: Much of this code is also copied in drawDashedBorderOn:  
	(should be factored)"
	| lineColor bevel topLeftColor bottomRightColor bigClipRect brush p1i p2i beveledSegments octant |
	borderDashSpec
		ifNotNil: [^ self drawDashedBorderOn: aCanvas usingEnds: anArray].
	(borderColor == nil
			or: [borderColor isColor
					and: [borderColor isTransparent]])
		ifTrue: [^ self].
	lineColor _ borderColor.
	bevel _ false.
	"Border colors for bevelled effects depend on CW ordering of  
	vertices"
	borderColor == #raised
		ifTrue: [topLeftColor _ color paler.
			bottomRightColor _ color deeper.
			bevel _ true].
	borderColor == #inset
		ifTrue: [topLeftColor _ owner colorForInsets deeper.
			bottomRightColor _ owner colorForInsets paler.
			bevel _ true].
	beveledSegments _ OrderedCollection new.
	bigClipRect _ aCanvas clipRect expandBy: self borderWidth + 1 // 2.
	brush _ nil.
	self lineSegments reversed
		do: [:segment | 
			| p1 p2 | 
			p1 _ segment first.
			p2 _ segment second.
			p1i _ p1 asIntegerPoint.
			p2i _ p2 asIntegerPoint.
			(arrows ~= #none
					and: [closed not])
				ifTrue: ["Shorten line ends so as not to interfere with tip  
					of arrow."
					((arrows == #back
								or: [arrows == #both])
							and: [p1 = vertices first])
						ifTrue: [p1i _ anArray first asIntegerPoint].
					((arrows == #forward
								or: [arrows == #both])
							and: [p2 = vertices last])
						ifTrue: [p2i _ anArray last asIntegerPoint]].
			(closed
					or: ["bigClipRect intersects: (p1i rect: p2i) optimized:"
						((p1i min: p2i)
							max: bigClipRect origin)
							<= ((p1i max: p2i)
									min: bigClipRect corner)])
				ifTrue: [bevel
						ifTrue: [octant _ p1i octantOf: p2i.
								(octant < 2 or: [octant > 5])
								ifTrue: [beveledSegments addLast: {p1i. p2i. topLeftColor}]
								ifFalse: [beveledSegments addFirst: {p1i. p2i. bottomRightColor}]].
					(borderWidth > 3
							and: [borderColor isColor])
						ifTrue: [brush == nil
								ifTrue: [brush _ (ColorForm dotOfSize: borderWidth)
												colors: (Array with: Color transparent with: borderColor)].
							aCanvas
								line: p1i
								to: p2i
								brushForm: brush]
						ifFalse: [bevel
								ifFalse: [aCanvas
										line: p1i
										to: p2i
										width: borderWidth
										color: lineColor]]]].

	"If bevelled, the highlighted segments are displayed last so their endpoints aren't obscured."
	bevel ifTrue:
		[beveledSegments do:
			[:segment | aCanvas
							line: segment first
							to: segment second
							width: borderWidth
							color: segment third]].
! !


!ScrollPane methodsFor: 'initialization' stamp: 'dew 12/20/2000 21:46'!
initialize
	retractableScrollBar _ (Preferences valueOfFlag: #inboardScrollbars) not.
	scrollBarOnLeft _ (Preferences valueOfFlag: #scrollBarsOnRight) not.
	super initialize.
	hasFocus _ false.
	borderWidth _ 2.
	borderColor _ #raised.

	scrollBar := ScrollBar new model: self slotName: 'scrollBar'.
	scrollBar borderWidth: 1; borderColor: #raised.

	scroller := TransformMorph new color: Color transparent.
	scroller offset: -3@0.
	self addMorph: scroller.

	retractableScrollBar ifFalse: [self addMorph: scrollBar].

	self on: #mouseEnter send: #mouseEnter: to: self.
	self on: #mouseLeave send: #mouseLeave: to: self.
	self extent: 150@120! !


!SystemWindow methodsFor: 'initialization' stamp: 'dew 1/13/2001 16:49'!
addCloseBox
	| frame polygon |
	closeBox _ SimpleButtonMorph new borderWidth: 0;
			label: '' font: nil; color: Color transparent;
			actionSelector: #closeBoxHit; target: self; extent: 14@14.
	polygon _ PolygonMorph
				vertices: {1@3. 3@1. 6@4. 9@1. 11@3. 8@6. 11@9.
							9@11. 6@8. 3@11. 1@9. 4@6}
				color: Color paleGreen deeper
				borderWidth: 1
				borderColor: #raised.
	closeBox addMorph: polygon.

	frame _ LayoutFrame new.
	frame leftFraction: 0; leftOffset: 4; topFraction: 0; topOffset: 1.
	closeBox layoutFrame: frame.
	self addMorph: closeBox.! !

!SystemWindow methodsFor: 'initialization' stamp: 'dew 1/13/2001 23:23'!
addMenuControl
	"NB: for the moment, we always supply balloon help for this control, until people get used to it; eventually, we mays switch to showing this balloon help only in novice mode, as we do for the other standard window controls."
	| frame polygon |
	menuBox _ SimpleButtonMorph new borderWidth: 0;
			label: ' ' font: Preferences standardButtonFont;
			color: Color transparent; actionSelector: #offerWindowMenu;
			target: self; extent: 14@14; setBalloonText: 'window menu'.
	"Would prefer a RectangleMorph, but the colors are different in 8-bit mode"
	polygon _ PolygonMorph vertices: {3@10. 3@2. 10@2. 10@10} color: Color paleGreen deeper borderWidth: 1 borderColor: #raised.
	menuBox addMorph: polygon.

	frame _ LayoutFrame new.
	frame leftFraction: 0; leftOffset: 19; topFraction: 0; topOffset: 1.
	menuBox layoutFrame: frame.
	self addMorph: menuBox.

! !

!SystemWindow methodsFor: 'initialization' stamp: 'dew 1/13/2001 23:09'!
initialize
	| titleBar polygon |
	super initialize.
	allowReframeHandles := true.
	labelString ifNil: [labelString _ 'Untitled Window'].
	isCollapsed _ false.
	activeOnlyOnTop _ true.
	paneMorphs _ Array new.
	color _ Color gray.
	borderColor _ #raised.
	borderWidth _ 1.
	self layoutPolicy: ProportionalLayout new.

	label _ StringMorph new contents: labelString;
			font: Preferences windowTitleFont emphasis: 1.

	"Add collapse box so #labelHeight will work"
	collapseBox _ SimpleButtonMorph new borderWidth: 0;
			label: ' ' font: nil; color: Color transparent;
			actionSelector: #collapseOrExpand; target: self; extent: 14@14.
	polygon _ PolygonMorph
				vertices: {3@5. 5@3. 8@3. 10@5. 10@8. 8@10. 5@10. 3@8}
				color: Color paleGreen deeper
				borderWidth: 1
				borderColor: #raised.
	collapseBox addMorph: polygon.

	titleBar _ (RectangleMorph newBounds: bounds) borderColor: #raised.
	stripes _ Array with: titleBar with: titleBar. "temporary, until stripes refs are cleaned up"

	self setFramesForLabelArea.

	self addMorph: (stripes first borderWidth: 1).
	self setLabelWidgetAllowance.
	self addCloseBox.
	self addMenuControl.
	self addMorph: label.
	self addMorph: collapseBox.
	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@200.
	mustNotClose _ false.
	updatablePanes _ Array new.
! !

!SystemWindow methodsFor: 'initialization' stamp: 'dew 1/13/2001 23:11'!
setFramesForLabelArea
	"an aid to converting old instances, but then I found convertAlignment"

	| frame |

	frame _ LayoutFrame new.
	frame leftFraction: 0.5; topFraction: 0; leftOffset: label width negated // 2.
	label layoutFrame: frame.

	frame _ LayoutFrame new.
	frame rightFraction: 1; topFraction: 0; rightOffset: 1; topOffset: 1.
	collapseBox layoutFrame: frame.

	frame _ LayoutFrame new.
	frame leftFraction: 0; topFraction: 0; rightFraction: 1;
			leftOffset: 0; topOffset: 0; rightOffset: 0.
	stripes first layoutFrame: frame.
	stripes first height: self labelHeight.
	stripes first hResizing: #spaceFill.
! !

!SystemWindow methodsFor: 'label' stamp: 'dew 1/15/2001 12:53'!
setStripeColorsFrom: paneColor
	| buttonColor |
	self isActive
		ifTrue:
			[stripes first color: paneColor deeper slightlyDarker.
			buttonColor _ paneColor darker deeper.]
		ifFalse:
			[stripes first color: paneColor.
			buttonColor _ paneColor deeper lighter.].

	closeBox submorphs first color: buttonColor.
	collapseBox submorphs first color: buttonColor.
	menuBox submorphs first color: buttonColor.

! !