'From Cuis 1.0 of 4 September 2009 [latest update: #290] on 17 September 2009 at 2:43:56 pm'!

!BorderedMorph methodsFor: 'testing' stamp: 'jmv 9/17/2009 10:39'!
is: aSymbol
	^ aSymbol = #BorderedMorph or: [ super is: aSymbol ]! !


!IconicButton methodsFor: 'as yet unclassified' stamp: 'jmv 9/17/2009 10:59'!
labelGraphic: aForm
	| oldLabel graphicalMorph |
	(oldLabel _ self findA: SketchMorph)
		ifNotNil: [oldLabel delete].
	graphicalMorph _ SketchMorph withForm: aForm.
	"this could use a #fitContents method, like the superclass..."
"	self extent: graphicalMorph extent + (borderWidth + 6)."
	graphicalMorph position: self center - (graphicalMorph extent // 2).
	self addMorph: graphicalMorph.
	graphicalMorph lock
! !


!PluggableTextMorph methodsFor: 'geometry' stamp: 'jmv 9/17/2009 10:19'!
extent: newExtent
	"
	Any reason for this? (jmv)
	super extent: (newExtent max: 36@16).
	"
	super extent: newExtent.
	textMorph ifNotNil:
		[textMorph extent: (self viewableWidth-6)@self height].
	self setScrollDeltas! !


!ScrollbarButton class methodsFor: 'images' stamp: 'jmv 9/17/2009 10:58'!
arrowOfDirection: aSymbol
	"answer a form with an arrow based on the parameters, of the current size"
	^Arrows at: aSymbol! !


!StringHolder methodsFor: 'initialize-release' stamp: 'jmv 9/17/2009 09:56'!
openAsMorphEditorClass: anEditorClass label: labelString inWorld: aWorld
	"Workspace new openAsMorphLabel: 'Workspace'"
	| window |
	window _ (SystemWindow labelled: labelString) model: self.

	window addMorph: (PluggableTextMorph 
			on: self 
			editorClass: anEditorClass
			text: #contents 
			accept: #acceptContents:
			readSelection: nil 
			menu: #paneMenu:shifted:editorClass:)
		frame: (0@0 corner: 1@1).

	window openInWorld: aWorld! !


!SystemWindow methodsFor: 'geometry' stamp: 'jmv 9/17/2009 10:10'!
minPaneHeightForReframe
	^Preferences scrollbarThickness + 16! !

!SystemWindow methodsFor: 'label' stamp: 'jmv 9/17/2009 09:53'!
externalName
	"Answer the name by which the receiver is known in the UI"

	^ 'SystemWindow labelled: ', labelString! !

!SystemWindow methodsFor: 'panes' stamp: 'jmv 9/17/2009 10:38'!
addMorph: aMorph fullFrame: aLayoutFrame

	super addMorph: aMorph fullFrame: aLayoutFrame.

	paneMorphs _ paneMorphs copyReplaceFrom: 1 to: 0 with: (Array with: aMorph).
	aMorph adoptPaneColor: self paneColor.
	(aMorph is: #BorderedMorph) ifTrue: [
		aMorph borderWidth: 2; borderColor: #inset; color: Color transparent ].
	"reorder panes so flop-out right-side scrollbar is visible"
	Preferences scrollBarsOnRight
		ifTrue: [ self addMorphBack: aMorph ]! !

!SystemWindow methodsFor: 'resize/collapse' stamp: 'jmv 9/17/2009 10:11'!
reframePanesAdjoining: growingPane along: side to: aDisplayBox 
	| delta newRect minDim theMin horiz |
	growingPane ifNil: [^ self].  "As from click outside"
	newRect _ aDisplayBox.
	horiz _ #(left right) includes: side.
	theMin _ horiz ifTrue: [40] ifFalse: [self minPaneHeightForReframe].

	"First check that this won't make any pane smaller than theMin screen dots"
	minDim _ (((paneMorphs select: [:pane | pane bounds bordersOn: growingPane bounds along: side])
		collect: [:pane | pane bounds adjustTo: newRect along: side]) copyWith: aDisplayBox)
			inject: 999 into:
				[:was :rect | was min: (horiz ifTrue: [rect width] ifFalse: [rect height])].
	"If so, amend newRect as required"
	minDim > theMin ifFalse:
		[delta _ minDim - theMin.
		newRect _ newRect withSide: side setTo: 
				((newRect perform: side) > (growingPane bounds perform: side)
					ifTrue: [(newRect perform: side) + delta]
					ifFalse: [(newRect perform: side) - delta])].

	"Now adjust all adjoining panes for real"
	paneMorphs do:
		[:pane | (pane bounds bordersOn: growingPane bounds along: side) ifTrue:
			[pane bounds: (pane bounds adjustTo: newRect along: side)]].
	"And adjust the growing pane itself"
	growingPane bounds: newRect.

	"Finally force a recomposition of the whole window"
	self setPaneRectsFromBounds.
	self extent: self extent! !

!SystemWindow methodsFor: 'resize/collapse' stamp: 'jmv 9/17/2009 10:10'!
spawnPaneFrameHandle: event 
	| resizer localPt side growingPane newBounds adjoiningPanes limit cursor |
	(self world firstSubmorph isKindOf: NewHandleMorph) 
		ifTrue: [^self	"Prevent multiple handles"].
	((self innerBounds withHeight: self labelHeight + 4) 
		containsPoint: event cursorPoint) 
			ifTrue: [^self	"in label or top of top pane"].
	growingPane := self paneWithLongestSide: [:s | side := s]
				near: event cursorPoint.
	growingPane ifNil: [^self].
	"don't resize pane side coincident with window side - RAA 5 jul 2000"
	(growingPane perform: side) = (self innerBounds perform: side) 
		ifTrue: [^self].
	(side == #top and: [growingPane top = self panelRect top]) ifTrue: [^self].
	adjoiningPanes := paneMorphs 
				select: [:pane | pane bounds bordersOn: growingPane bounds along: side].
	limit := adjoiningPanes isEmpty 
				ifFalse: 
					[(adjoiningPanes collect: [:pane | pane bounds perform: side]) 
						perform: ((#(#top #left) includes: side) ifTrue: [#max] ifFalse: [#min])]
				ifTrue: [self bounds perform: side].
	cursor := Cursor resizeForEdge: side.
	resizer := (NewHandleMorph new)
				sensorMode: self fastFramingOn;
				followHand: event hand
					forEachPointDo: 
						[:p | 
						localPt := self pointFromWorld: p.
						newBounds := growingPane bounds 
									withSideOrCorner: side
									setToPoint: localPt
									minExtent: 40 @ self minPaneHeightForReframe
									limit: limit.
						self fastFramingOn 
							ifTrue: 
								["For fast display, only higlight the rectangle during loop"

								Cursor currentCursor == cursor 
									ifFalse: 
										[(event hand)
											visible: false;
											refreshWorld;
											visible: true.
										cursor show].
								newBounds := growingPane bounds newRectButtonPressedDo: 
												[:f | 
												growingPane bounds 
													withSideOrCorner: side
													setToPoint: (self pointFromWorld: Sensor cursorPoint)
													minExtent: 40 @ self minPaneHeightForReframe
													limit: limit].].
								self 
									reframePanesAdjoining: growingPane
									along: side
									to: newBounds.
]
					lastPointDo: [:p | ]
					withCursor: cursor.
	event hand world addMorphInLayer: resizer.
	resizer startStepping! !

