'From Cuis 1.0 of 2 April 2009 [latest update: #166] on 6 April 2009 at 9:05:39 am'!
!classDefinition: #ScrollBar category: #'Morphic-OldWindows'!
MorphWithModel subclass: #ScrollBar
	instanceVariableNames: 'menuButton upButton downButton pagingArea scrollDelta pageDelta interval menuSelector timeOfMouseDown timeOfLastScroll nextPageDirection currentScrollDelay scrollBarAction setValueSelector sliderShadow sliderColor slider value '
	classVariableNames: 'ArrowImagesCache BoxesImagesCache UpArrow UpArrow8Bit '
	poolDictionaries: ''
	category: 'Morphic-OldWindows'!
!classDefinition: #ScrollPane category: #'Morphic-OldWindows'!
MorphWithModel subclass: #ScrollPane
	instanceVariableNames: 'scrollBar scroller retractableScrollBar getMenuSelector getMenuTitleSelector hasFocus hScrollBar hideScrollBars scrollBarOnLeft '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Morphic-OldWindows'!
!classDefinition: #ScrollbarButton category: #'Morphic-OldWindows'!
RectangleMorph subclass: #ScrollbarButton
	instanceVariableNames: 'image'
	classVariableNames: 'Arrows Box CurrentSize'
	poolDictionaries: ''
	category: 'Morphic-OldWindows'!

!ScrollbarButton commentStamp: '<historical>' prior: 0!
A very simple button to be used in ScrollBars!


!Morph methodsFor: 'private' stamp: 'jmv 4/5/2009 14:53'!
privateMoveBy: delta 
	"Private!! Use 'position:' instead."
	| fill |
	bounds _ bounds translateBy: delta.
	fullBounds
		ifNotNil: [fullBounds _ fullBounds translateBy: delta].
	fill _ self fillStyle.
	fill isOrientedFill
		ifTrue: [fill origin: fill origin + delta]! !


!ImageMorph methodsFor: 'drawing' stamp: 'jmv 4/4/2009 18:00'!
drawOn: aCanvas
	| style |
	(style _ self borderStyle) ifNotNil:[
		style frameRectangle: bounds on: aCanvas.
	].
	self isOpaque
		ifTrue:[aCanvas drawImage: image at: self innerBounds origin]
		ifFalse:[aCanvas translucentImage: image at: self innerBounds origin]! !


!Preferences class methodsFor: 'misc' stamp: 'jmv 4/3/2009 17:13'!
defaultValueTableForCurrentRelease
	"Answer a table defining default values for all the preferences in the release.  Returns a list of (pref-symbol, boolean-symbol) pairs"

	^  #(
		(abbreviatedBrowserButtons false)
		(alternativeBrowseIt false)
		(alternativeWindowLook true)
		(annotationPanes false)
		(automaticFlapLayout true)
		(automaticPlatformSettings true)
		(balloonHelpEnabled true)
		(browseWithPrettyPrint false)
		(browserShowsPackagePane false)
		(canRecordWhilePlaying false)
		(caseSensitiveFinds false)
		(changeSetVersionNumbers true)
		(checkForSlips true)
		(classicNewMorphMenu false)
		(cmdDotEnabled true)
		(collapseWindowsInPlace false)
		(colorWhenPrettyPrinting false)
		(confirmFirstUseOfStyle true)
		(conversionMethodsAtFileOut false)
		(cpuWatcherEnabled false)
		(debugHaloHandle true)
		(debugPrintSpaceLog false)
		(debugShowDamage false)
		(decorateBrowserButtons true)
		(diffsInChangeList true)
		(diffsWithPrettyPrint false)
		(dismissAllOnOptionClose false)
		(fastDragWindowForMorphic true)
		(fullScreenLeavesDeskMargins true)
		(hiddenScrollBars false)
		(higherPerformance false)
		(honorDesktopCmdKeys true)
		(ignoreStyleIfOnlyBold true)
		(inboardScrollbars true)
		(logDebuggerStackToFile true)
		(menuButtonInToolPane false)
		(menuColorFromWorld false)
		(menuKeyboardControl false)  
		(modalColorPickers true)
		(noviceMode false)
		(optionalButtons true)
		(personalizedWorldMenu true)
		(projectsSentToDisk false)
		(propertySheetFromHalo false)
		(restartAlsoProceeds false)
		(reverseWindowStagger true)
		(scrollBarsNarrow false)
		(scrollBarsWithoutMenuButton false)
		(selectiveHalos false)
		(showBoundsInHalo false)
		(simpleMenus false)
		(smartUpdating true)
		(soundQuickStart false)
		(soundStopWhenDone false)
		(soundsEnabled true)
		(systemWindowEmbedOK false)
		(thoroughSenders true)
		(twentyFourHourFileStamps true)
		(uniqueNamesInHalos false)
		(warnIfNoChangesFile true)
		(warnIfNoSourcesFile true))


"
Preferences defaultValueTableForCurrentRelease do:
	[:pair | (Preferences preferenceAt: pair first ifAbsent: [nil]) ifNotNilDo:
			[:pref | pref defaultValue: (pair last == #true)]].
Preferences chooseInitialSettings.
"! !

!Preferences class methodsFor: 'scrollbar parameters' stamp: 'jmv 4/5/2009 15:40'!
inboardScrollbars
	^ self
		valueOfFlag: #inboardScrollbars
		ifAbsent: [false]! !

!Preferences class methodsFor: 'scrollbar parameters' stamp: 'jmv 4/5/2009 15:39'!
scrollBarsNarrow
	^ self
		valueOfFlag: #scrollBarsNarrow
		ifAbsent: [false]! !

!Preferences class methodsFor: 'scrollbar parameters' stamp: 'jmv 4/6/2009 09:03'!
scrollBarsOnRight
	^ self
		valueOfFlag: #scrollBarsOnRight
		ifAbsent: [true]! !

!Preferences class methodsFor: 'scrollbar parameters' stamp: 'jmv 4/5/2009 15:41'!
scrollbarThickness
	"Includes border"
	| result |
	result _ self scrollBarsNarrow
		ifTrue: [11]
		ifFalse: [14].

	self inboardScrollbars
		ifFalse: [ result _ result + 2 ].
	
	^ result! !

!Preferences class methodsFor: 'themes' stamp: 'jmv 4/3/2009 17:13'!
brightSqueak
	"The classic bright Squeak look.  Windows have saturated colors and relatively low contrast; scroll-bars are of the flop-out variety and are on the left.  Many power-user features are enabled."

	self setPreferencesFrom:
	#(
		(alternativeWindowLook false)
		(annotationPanes true)
		(automaticFlapLayout true)
		(balloonHelpEnabled true)
		(browseWithPrettyPrint false)
		(browserShowsPackagePane false)
		(classicNewMorphMenu false)
		(cmdDotEnabled true)
		(collapseWindowsInPlace false)
		(colorWhenPrettyPrinting false)
		(debugHaloHandle true)
		(debugPrintSpaceLog false)
		(debugShowDamage false)
		(decorateBrowserButtons true)
		(diffsInChangeList true)
		(diffsWithPrettyPrint false)
		(fastDragWindowForMorphic true)
		(fullScreenLeavesDeskMargins true)
		(hiddenScrollBars false)
		(ignoreStyleIfOnlyBold true)
		(inboardScrollbars false)
		(logDebuggerStackToFile true)
		(menuButtonInToolPane false)
		(menuColorFromWorld false)
		(menuKeyboardControl true)
		(noviceMode false)
		(optionalButtons true)
		(personalizedWorldMenu true)
		(propertySheetFromHalo false)
		(restartAlsoProceeds false)
		(reverseWindowStagger true)
		(scrollBarsNarrow false)
		(scrollBarsWithoutMenuButton false)
		(selectiveHalos false)
		(simpleMenus false)
		(smartUpdating true)
		(systemWindowEmbedOK false)
		(thoroughSenders true)
		(warnIfNoChangesFile true)
		(warnIfNoSourcesFile true))! !

!Preferences class methodsFor: 'themes' stamp: 'jmv 4/3/2009 17:13'!
juans

	self setPreferencesFrom:

	#(
		(alternativeWindowLook true)
		(alternativeWindowBoxesLook true)
		(annotationPanes true)
		(balloonHelpEnabled false)
		(browseWithPrettyPrint false)
		(browserShowsPackagePane false)
		(caseSensitiveFinds true)
		(checkForSlips true)
		(cmdDotEnabled true)
		(collapseWindowsInPlace false)
		(colorWhenPrettyPrinting false)
		(diffsInChangeList true)
		(diffsWithPrettyPrint false)
		(fastDragWindowForMorphic true)
		(honorDesktopCmdKeys false)
		(ignoreStyleIfOnlyBold true)
		(inboardScrollbars true)
		(menuColorFromWorld false)
		(menuKeyboardControl true)
		(noviceMode false)
		(optionalButtons true)
		(personalizedWorldMenu false)
		(restartAlsoProceeds false)
		(scrollBarsNarrow true)
		(scrollBarsWithoutMenuButton false)
		(simpleMenus false)
		(smartUpdating true)
		(subPixelRenderFonts true)
		(thoroughSenders true)
	)! !

!Preferences class methodsFor: 'themes' stamp: 'jmv 4/3/2009 17:13'!
magdeburg
	"Alternative window & scroll-bar looks, no desktop command keys, no keyboard menu control, no annotation panes..."

	self setPreferencesFrom: #(
		(alternativeWindowLook true)
		(annotationPanes false)
		(canRecordWhilePlaying false)
		(conversionMethodsAtFileOut true)
		(honorDesktopCmdKeys false)
		(menuKeyboardControl false)  
		(scrollBarsWithoutMenuButton true))! !

!Preferences class methodsFor: 'themes' stamp: 'jmv 4/3/2009 17:13'!
paloAlto
	"Similar to the brightSqueak theme, but with a number of idiosyncratic personal settings.   Note that caseSensitiveFinds is true"


	self setPreferencesFrom:
	#(
		(abbreviatedBrowserButtons false)
		(accessOnlineModuleRepositories noOpinion)
		(alternativeBrowseIt noOpinion)
		(alternativeWindowLook false)
		(annotationPanes true)
		(automaticFlapLayout true)
		(automaticPlatformSettings noOpinion)
		(balloonHelpEnabled true)
		(browseWithPrettyPrint false)
		(browserShowsPackagePane false)
		(canRecordWhilePlaying noOpinion)
		(caseSensitiveFinds true)
		(changeSetVersionNumbers true)
		(checkForSlips true)
		(classicNewMorphMenu false)
		(cmdDotEnabled true)
		(collapseWindowsInPlace false)
		(colorWhenPrettyPrinting false)
		(confirmFirstUseOfStyle true)
		(conservativeModuleDeActivation noOpinion)
		(conversionMethodsAtFileOut true)
		(cpuWatcherEnabled noOpinion)
		(debugHaloHandle true)
		(debugPrintSpaceLog true)
		(debugShowDamage false)
		(decorateBrowserButtons true)
		(diffsInChangeList true)
		(diffsWithPrettyPrint false)
		(dismissAllOnOptionClose true)
		(duplicateControlAndAltKeys false)
		(extraDebuggerButtons true)
		(fastDragWindowForMorphic true)
		(fullScreenLeavesDeskMargins true)
		(hiddenScrollBars false)
		(higherPerformance noOpinion)
		(honorDesktopCmdKeys true)
		(ignoreStyleIfOnlyBold true)
		(inboardScrollbars false)
		(lenientScopeForGlobals noOpinion)
		(logDebuggerStackToFile true)
		(menuButtonInToolPane false)
		(menuColorFromWorld false)
		(menuKeyboardControl true)  
		(modalColorPickers true)
		(modularClassDefinitions noOpinion)
		(noviceMode false)
		(optionalButtons true)
		(personalizedWorldMenu true)
		(projectsSentToDisk noOpinion)
		(propertySheetFromHalo false)
		(restartAlsoProceeds false)
		(reverseWindowStagger true)
		(scrollBarsNarrow false)
		(scrollBarsWithoutMenuButton false)
		(selectiveHalos false)
		(showBoundsInHalo false)
		(simpleMenus false)
		(smartUpdating true)
		(soundQuickStart noOpinion)
		(soundsEnabled true)
		(soundStopWhenDone noOpinion)
		(strongModules noOpinion)
		(swapControlAndAltKeys noOpinion)
		(swapMouseButtons  noOpinion)
		(systemWindowEmbedOK false)
		(thoroughSenders true)
		(twentyFourHourFileStamps false)
		(uniqueNamesInHalos false)
		(warnIfNoChangesFile true)
		(warnIfNoSourcesFile true))! !

!Preferences class methodsFor: 'themes' stamp: 'jmv 4/3/2009 17:14'!
slowMachine

	self setPreferencesFrom:

	#(
		(alternativeWindowLook false)
		(alternativeWindowBoxesLook false)
		(annotationPanes false)
		(balloonHelpEnabled false)
		(browseWithPrettyPrint false)
		(browserShowsPackagePane false)
		(caseSensitiveFinds true)
		(checkForSlips false)
		(cmdDotEnabled true)
		(collapseWindowsInPlace false)
		(colorWhenPrettyPrinting false)
		(diffsInChangeList false)
		(diffsWithPrettyPrint false)
		(fastDragWindowForMorphic true)
		(honorDesktopCmdKeys false)
		(ignoreStyleIfOnlyBold true)
		(inboardScrollbars true)
		(menuColorFromWorld false)
		(menuKeyboardControl false)
		(noviceMode false)
		(optionalButtons false)
		(personalizedWorldMenu false)
		(restartAlsoProceeds false)
		(scrollBarsNarrow false)
		(scrollBarsWithoutMenuButton false)
		(simpleMenus false)
		(smartUpdating false)
		(subPixelRenderFonts false)
		(thoroughSenders false)
	)! !

!Preferences class methodsFor: 'themes' stamp: 'jmv 4/3/2009 17:14'!
smalltalk80
	"A traditional monochrome Smalltalk-80 look and feel, clean and austere, and lacking many features added to Squeak in recent years. Caution: this theme removes the standard Squeak flaps, turns off the 'smartUpdating' feature that keeps multiple browsers in synch, and much more."

	self setPreferencesFrom:

	#(
		(alternativeWindowLook false)
		(annotationPanes false)
		(balloonHelpEnabled false)
		(browseWithPrettyPrint false)
		(browserShowsPackagePane false)
		(caseSensitiveFinds true)
		(checkForSlips false)
		(cmdDotEnabled true)
		(collapseWindowsInPlace false)
		(colorWhenPrettyPrinting false)
		(diffsInChangeList false)
		(diffsWithPrettyPrint false)
		(fastDragWindowForMorphic true)
		(honorDesktopCmdKeys false)
		(ignoreStyleIfOnlyBold true)
		(inboardScrollbars false)
		(menuColorFromWorld false)
		(menuKeyboardControl false)
		(noviceMode false)
		(optionalButtons false)
		(personalizedWorldMenu false)
		(restartAlsoProceeds false)
		(scrollBarsNarrow false)
		(scrollBarsWithoutMenuButton false)
		(simpleMenus false)
		(smartUpdating false)
		(thoroughSenders false)
	)! !

!Preferences class methodsFor: 'themes' stamp: 'jmv 4/3/2009 17:14'!
westwood
	"Settings generally similar to those found in a standard browser-plug-in-based Squeak image"

	self setPreferencesFrom: #(
		(alternativeWindowLook true)
		(honorDesktopCmdKeys false)
		(menuKeyboardControl false)
		(propertySheetFromHalo true)
		)! !


!ScrollBar methodsFor: 'access' stamp: 'jmv 4/5/2009 20:15'!
sliderColor
	"color scheme for the whole slider widget"
	sliderColor ifNil: [^ (color alphaMixed: 0.7 with: Color white) slightlyLighter].
	^ sliderColor! !

!ScrollBar methodsFor: 'access' stamp: 'jmv 4/5/2009 20:15'!
sliderColor: aColor 
	"Change the color of the scrollbar to go with aColor."
	| buttonColor |
	sliderColor _ aColor.
	slider ifNotNil: [slider color: sliderColor].
	buttonColor := self thumbColor.
	menuButton
		ifNotNil: [menuButton color: buttonColor].
	upButton color: buttonColor.
	downButton color: buttonColor.
	slider color: buttonColor slightlyLighter.
	pagingArea color: (aColor alphaMixed: 0.3 with: Color white).
	self borderWidth: 0! !

!ScrollBar methodsFor: 'access' stamp: 'jmv 4/5/2009 20:15'!
sliderShadowColor
	^ self sliderColor alphaMixed: 0.2 with: self pagingArea color! !

!ScrollBar methodsFor: 'access' stamp: 'jmv 4/3/2009 17:10'!
thumbColor
	"Problem: Part of the ScrollBar/Slider code uses 'slider' to mean the entire scrollbar/slider widget, and part of it uses 'slider' to mean only the draggable 'thumb'.  This should be cleaned up so that 'thumb' is used instead of 'slider' where appropriate.  For now, the meaning of thumbColor is clear, at least."

	^ self sliderColor alphaMixed: 0.7 with: (Color gray: 0.95)! !

!ScrollBar methodsFor: 'access' stamp: 'jmv 4/5/2009 20:16'!
value
	^ value! !

!ScrollBar methodsFor: 'access' stamp: 'jmv 4/5/2009 20:16'!
wantsSlot
	"For now do it the old way, until we sort this out"
	^ true! !

!ScrollBar methodsFor: 'accessing' stamp: 'jmv 4/3/2009 17:10'!
adoptPaneColor: aColor
	"Adopt the given pane color"
	aColor ifNil:[^self].
	self sliderColor: aColor.! !

!ScrollBar methodsFor: 'geometry' stamp: 'jmv 4/5/2009 16:23'!
buttonExtent
	^Preferences scrollbarThickness! !

!ScrollBar methodsFor: 'geometry' stamp: 'jmv 4/5/2009 20:16'!
computeSlider
	| r |
	r _ self roomToMove.
	slider position: (bounds isWide
		ifTrue: [r topLeft + ((r width * value) asInteger @ 0)]
		ifFalse: [r topLeft + (0 @ (r height * value)  asInteger)]).
	slider extent: self sliderExtent! !

!ScrollBar methodsFor: 'geometry' stamp: 'jmv 4/5/2009 20:18'!
expandSlider
	"Compute the new size of the slider (use the old sliderThickness as a minimum)."
	| r |
	r _ self totalSliderArea.
	slider extent: (bounds isWide
		ifTrue: [((r width * interval) asInteger max: 7) @ slider height]
		ifFalse: [slider width @ ((r height * interval) asInteger max: 7)])! !

!ScrollBar methodsFor: 'geometry' stamp: 'jmv 4/5/2009 20:18'!
extent: p
        | newExtent |
	newExtent _ p x > p y
                ifTrue: [(p max: 42@8)]
                ifFalse: [(p max: 8@42)].
	newExtent = bounds extent ifTrue: [^ self].
	bounds isWide
		ifTrue: [super extent: (newExtent x max: 14) @ newExtent y]
		ifFalse: [super extent: newExtent x @ (newExtent y max: 14)].
		
	self flag: #jmv.
	"Most times it is not necessary to recreate the buttons"
	self removeAllMorphs.
	self
		initializeMenuButton;
		initializeUpButton;
		initializeDownButton;
		initializePagingArea.
	self initializeSlider! !

!ScrollBar methodsFor: 'geometry' stamp: 'jmv 4/5/2009 20:17'!
roomToMove
	^ self totalSliderArea insetBy: (0@0 extent: self sliderExtent)! !

!ScrollBar methodsFor: 'initialize' stamp: 'jmv 4/5/2009 16:13'!
initialize
	super initialize.
	value _ 0.0.
	self
		initializeMenuButton;
		initializeUpButton;
		initializeDownButton;
		initializePagingArea.
	self initializeSlider.
	scrollDelta _ 0.02.
	pageDelta _ 0.2! !

!ScrollBar methodsFor: 'initialize' stamp: 'jmv 4/5/2009 19:23'!
initializeDownButton
	"initialize the receiver's downButton"

	| e |
	e _ self buttonExtent.
	downButton _ ScrollbarButton 
				newBounds: (self innerBounds bottomRight - e extent: e)
				color: self thumbColor.
	downButton 
		on: #mouseDown
		send: #scrollDownInit
		to: self.
	downButton 
		on: #mouseUp
		send: #finishedScrolling
		to: self.
	bounds isWide
		ifTrue: [ downButton updateRightButtonImage ]
		ifFalse: [ downButton updateDownButtonImage ].
	self addMorph: downButton! !

!ScrollBar methodsFor: 'initialize' stamp: 'jmv 4/5/2009 19:07'!
initializeMenuButton
	"initialize the receiver's menuButton"

	(Preferences valueOfFlag: #scrollBarsWithoutMenuButton) ifTrue: [^self].
	menuButton _ ScrollbarButton 
						newBounds: (self innerBounds topLeft extent: self buttonExtent)
						color: self thumbColor.
	menuButton 
		on: #mouseEnter
		send: #menuButtonMouseEnter:
		to: self.
	menuButton 
		on: #mouseDown
		send: #menuButtonMouseDown:
		to: self.
	menuButton 
		on: #mouseLeave
		send: #menuButtonMouseLeave:
		to: self.
	menuButton updateMenuButtonImage.
	self addMorph: menuButton! !

!ScrollBar methodsFor: 'initialize' stamp: 'jmv 4/5/2009 16:13'!
initializeSlider
	"initialize the receiver's slider"
		
	slider _ RectangleMorph newBounds: self totalSliderArea color: self thumbColor.
	sliderShadow := RectangleMorph newBounds: self totalSliderArea
						color: self pagingArea color.
	slider on: #mouseMove send: #scrollAbsolute: to: self.
	slider on: #mouseDown send: #mouseDownInSlider: to: self.
	slider on: #mouseUp send: #mouseUpInSlider: to: self.
	slider setBorderWidth: 1 borderColor: #raised.
	sliderShadow setBorderWidth: 1 borderColor: #inset.
	"(the shadow must have the pagingArea as its owner to highlight properly)"
	self pagingArea addMorph: sliderShadow.
	sliderShadow hide.
	self addMorph: slider.
	self computeSlider.
	
	
	self sliderColor: self sliderColor! !

!ScrollBar methodsFor: 'initialize' stamp: 'jmv 4/5/2009 19:24'!
initializeUpButton
	"initialize the receiver's upButton"

	upButton := ScrollbarButton 
						newBounds: ((menuButton ifNil: [self innerBounds topLeft]
								ifNotNil: 
									[bounds isWide 
										ifTrue: [menuButton bounds topRight]
										ifFalse: [menuButton bounds bottomLeft]]) 
									extent: self buttonExtent).
	upButton color: self thumbColor.
	upButton 
		on: #mouseDown
		send: #scrollUpInit
		to: self.
	upButton 
		on: #mouseUp
		send: #finishedScrolling
		to: self.
	bounds isWide
		ifTrue: [ upButton updateLeftButtonImage ]
		ifFalse: [ upButton updateUpButtonImage ].
	self addMorph: upButton! !

!ScrollBar methodsFor: 'model access' stamp: 'jmv 4/5/2009 20:19'!
setValue: newValue
	"Called internally for propagation to model"
	"Using roundTo: instead of truncateTo: ensures that scrollUp will scroll the same distance as scrollDown."
	self value: (newValue roundTo: scrollDelta).
	self use: setValueSelector orMakeModelSelectorFor: 'Value:'
		in: [:sel | setValueSelector _ sel.  model perform: sel with: value]! !

!ScrollBar methodsFor: 'model access' stamp: 'jmv 4/5/2009 20:20'!
value: newValue
	"Drive the slider position externally..."
	value _ newValue min: 1.0 max: 0.0.
	self computeSlider! !

!ScrollBar methodsFor: 'other events' stamp: 'jmv 4/5/2009 20:21'!
mouseDownInSlider: event
	interval = 1.0 ifTrue: [
		"make the entire scrollable area visible if a full scrollbar is clicked on"
		self setValue: 0.
		self model hideOrShowScrollBars.].

	slider borderStyle style == #raised
		ifTrue: [slider borderColor: #inset].
	
	sliderShadow color: self sliderShadowColor.
	sliderShadow bounds: slider bounds.
	sliderShadow show! !

!ScrollBar methodsFor: 'other events' stamp: 'jmv 4/5/2009 20:21'!
mouseUpInSlider: event 

	slider borderStyle style == #inset
		ifTrue: [slider borderColor: #raised].
	
	sliderShadow hide! !

!ScrollBar methodsFor: 'scrolling' stamp: 'jmv 4/5/2009 20:21'!
scrollAbsolute: event
	| r p |
	r _ self roomToMove.
	bounds isWide
		ifTrue: [r width = 0 ifTrue: [^ self]]
		ifFalse: [r height = 0 ifTrue: [^ self]].
	p _ event targetPoint adhereTo: r.
	self setValue: (bounds isWide 
		ifTrue: [(p x - r left) asFloat / r width]
		ifFalse: [(p y - r top) asFloat / r height])! !

!ScrollBar methodsFor: 'scrolling' stamp: 'jmv 4/3/2009 17:24'!
scrollBarAction
	^scrollBarAction! !

!ScrollBar methodsFor: 'scrolling' stamp: 'jmv 4/3/2009 17:24'!
scrollBarAction: aSymbol
	scrollBarAction _ aSymbol! !

!ScrollBar methodsFor: 'initialization' stamp: 'jmv 4/5/2009 20:23'!
defaultBorderColor
	"answer the default border color/fill style for the receiver"
	^ #inset! !

!ScrollBar methodsFor: 'initialization' stamp: 'jmv 4/5/2009 20:23'!
defaultBorderWidth
	"answer the default border width for the receiver"
	^ 1! !

!ScrollBar methodsFor: 'initialization' stamp: 'jmv 4/5/2009 20:23'!
defaultBounds
"answer the default bounds for the receiver"
	^ 0 @ 0 extent: Preferences scrollbarThickness @ 100! !

!ScrollBar methodsFor: 'initialization' stamp: 'jmv 4/5/2009 20:23'!
defaultColor
	"answer the default color/fill style for the receiver"
	^ Color lightGray! !


!ScrollPane methodsFor: 'access options' stamp: 'jmv 4/3/2009 17:48'!
hideScrollBarsIndefinitely

	hideScrollBars _ true.
	self vHideScrollBar.
	self hHideScrollBar.! !

!ScrollPane methodsFor: 'event handling' stamp: 'jmv 4/3/2009 10:48'!
keyStroke: evt
	"If pane is not full, pass the event to the last submorph,
	assuming it is the most appropriate recipient (!!)"

	(evt commandKeyPressed and: [ self focusKeyboardFor: evt ])
		ifTrue: [ ^ self ].
	(self scrollByKeyboard: evt) ifTrue: [^self].
	scroller submorphs last keyStroke: evt! !

!ScrollPane methodsFor: 'event handling' stamp: 'jmv 4/5/2009 14:47'!
mouseLeave: event
	hasFocus _ false.
	retractableScrollBar ifTrue: [
		self
			vHideScrollBar;
			hHideScrollBar].
	(owner isSystemWindow) ifTrue: [owner paneTransition: event]
! !

!ScrollPane methodsFor: 'geometry' stamp: 'jmv 4/5/2009 15:42'!
extent: newExtent
	
	| oldW oldH wasHShowing wasVShowing minH minW |
	
	oldW _ self width.
	oldH _ self height.
	wasHShowing _ self hIsScrollbarShowing.
	wasVShowing _ self vIsScrollbarShowing.

	"Figure out the minimum width and height for this pane so that scrollbars will appear"
	hideScrollBars 
		ifTrue: [ 
			minH _ 1.
			minW _ 1 ]
		ifFalse: [
			minH _ Preferences scrollbarThickness + 16.
			minW _ minH + 4].
	super extent: (newExtent max: (minW@minH)).

	"Now reset widget sizes"
	self resizeScroller; hideOrShowScrollBars.
	
	"Now resetScrollDeltas where appropriate, first the vScrollBar..."
	((self height ~= oldH) or: [ wasHShowing ~~ self hIsScrollbarShowing]) ifTrue:
		[(retractableScrollBar or: [ self vIsScrollbarShowing ]) ifTrue:
			[ self vSetScrollDelta ]].
			
	"...then the hScrollBar"
	((self width ~= oldW) or: [wasVShowing ~~ self vIsScrollbarShowing]) ifTrue:
		[(retractableScrollBar or: [ self hIsScrollbarShowing ]) ifTrue:
			[ self hSetScrollDelta ]].

! !

!ScrollPane methodsFor: 'geometry' stamp: 'jmv 4/5/2009 15:42'!
hLeftoverScrollRange
	"Return the entire scrolling range minus the currently viewed area."
	| w |
	scroller hasSubmorphs ifFalse:[^0].
	w _  bounds width.
	self vIsScrollbarShowing ifTrue:[ w _ w - Preferences scrollbarThickness ].
	^ (self hTotalScrollRange - w roundTo: self scrollDeltaHeight) max: 0
! !

!ScrollPane methodsFor: 'geometry' stamp: 'jmv 4/5/2009 23:11'!
hScrollBarWidth
"Return the width of the horizontal scrollbar"

	| w |	
	w _ bounds width - (2 * borderWidth).
	
	(retractableScrollBar not and: [self vIsScrollbarNeeded])
		ifTrue: [w _ w - Preferences scrollbarThickness ].
		
	^w! !

!ScrollPane methodsFor: 'geometry' stamp: 'jmv 4/5/2009 14:37'!
hSetScrollDelta
	"Set the ScrollBar deltas, value and interval, based on the current scroll pane size, offset and range."
	| range delta w |

	scroller hasSubmorphs ifFalse:[scrollBar interval: 1.0. ^self].
	
	delta _ self scrollDeltaWidth.
	range _ self hLeftoverScrollRange.
	range = 0 ifTrue: [ hScrollBar scrollDelta: 0.02 pageDelta: 0.2; interval: 1.0; setValue: 0. ^self].

	"Set up for one line (for arrow scrolling), or a full pane less one line (for paging)."
	w _ self scrollingWidth.
	hScrollBar scrollDelta: (delta / range) asFloat pageDelta: (w - delta / range) asFloat.
	hScrollBar interval: (w / self hTotalScrollRange) asFloat.
	hScrollBar setValue: ((scroller offset x / range) min: 1.0) asFloat.
! !

!ScrollPane methodsFor: 'geometry' stamp: 'jmv 4/6/2009 09:00'!
layoutChanged
	| t topLeft |
	super layoutChanged.
	
	hideScrollBars ifTrue: [^self].
	
	t _ Preferences scrollbarThickness.

	scrollBarOnLeft ifTrue: [
		topLeft _ bounds topLeft - (t @ 0)]
	ifFalse: [
		retractableScrollBar 
			ifTrue: [topLeft _ bounds topRight - (borderWidth @ 0)]
			ifFalse: [topLeft _ bounds topRight - ((t + borderWidth) @ (0 - borderWidth))]].
	scrollBar 
		bounds: (topLeft extent: t @ self vScrollBarHeight).

	topLeft _ retractableScrollBar
				ifTrue: [bounds bottomLeft + (borderWidth @ borderWidth negated)]
				ifFalse: [bounds bottomLeft + (borderWidth @ (t + borderWidth) negated)].
	hScrollBar bounds: (topLeft extent: self hScrollBarWidth@ t)! !

!ScrollPane methodsFor: 'geometry' stamp: 'jmv 4/5/2009 14:29'!
resizeScroller

	scroller bounds: self innerBounds! !

!ScrollPane methodsFor: 'geometry' stamp: 'jmv 4/5/2009 15:43'!
scrollingHeight
	"Height using for scrolling.
	Leave room for horizontal scrollbar unless outboard"
	| answer |
	answer _ self bounds height - (self borderWidth * 2).
	retractableScrollBar ifFalse: [
		answer _ answer - Preferences scrollbarThickness ].
	^answer! !

!ScrollPane methodsFor: 'geometry' stamp: 'jmv 4/5/2009 15:43'!
scrollingWidth
	"Width using for scrolling.
	Leave room for vertical scrollbar unless outboard"
	| answer |
	answer _ self bounds width - (self borderWidth * 2).
	retractableScrollBar ifFalse: [
		answer _ answer - Preferences scrollbarThickness ].
	^answer! !

!ScrollPane methodsFor: 'geometry' stamp: 'jmv 4/3/2009 17:18'!
vScrollBarHeight
	^bounds height - (2 * borderWidth)! !

!ScrollPane methodsFor: 'geometry' stamp: 'jmv 4/5/2009 14:37'!
vSetScrollDelta
	"Set the ScrollBar deltas, value and interval, based on the current scroll pane size, offset and range."
	| range delta h |

	scroller hasSubmorphs ifFalse:[scrollBar interval: 1.0. ^self].
	
	delta _ self scrollDeltaHeight.
	range _ self vLeftoverScrollRange.
	range = 0 ifTrue: [^ scrollBar scrollDelta: 0.02 pageDelta: 0.2; interval: 1.0; setValue: 0].

	"Set up for one line (for arrow scrolling), or a full pane less one line (for paging)."
	h _ self scrollingHeight.
	scrollBar scrollDelta: (delta / range) asFloat pageDelta: (h - delta / range) asFloat.
	scrollBar interval: (h / self vTotalScrollRange) asFloat.
	scrollBar setValue: (scroller offset y / range min: 1.0) asFloat.
! !

!ScrollPane methodsFor: 'geometry' stamp: 'jmv 4/5/2009 23:15'!
viewableHeight
	"Viewable height.
	Leave room for horizontal scrollbar if present"
	| answer |
	answer _ self bounds height - (self borderWidth * 2).
	(retractableScrollBar not and: [ self hIsScrollbarShowing ]) ifTrue: [
		answer _ answer - Preferences scrollbarThickness ].
	^answer! !

!ScrollPane methodsFor: 'geometry testing' stamp: 'jmv 4/3/2009 11:48'!
containsPoint: aPoint

	(super containsPoint: aPoint) ifTrue: [^ true].
	
	"Also include v scrollbar when it is extended..."
	((retractableScrollBar and: [ self vIsScrollbarShowing ]) and:
		[scrollBar containsPoint: aPoint])
			ifTrue:[ ^true ].
		
	"Also include hScrollbar when it is extended..."
	^(retractableScrollBar and: [self hIsScrollbarShowing]) and:
		[hScrollBar containsPoint: aPoint]
! !

!ScrollPane methodsFor: 'geometry testing' stamp: 'jmv 4/3/2009 11:49'!
hIsScrollbarShowing
	"Return true if a horz scroll bar is currently showing"

	"^submorphs includes: hScrollBar"
	^hScrollBar owner == self! !

!ScrollPane methodsFor: 'geometry testing' stamp: 'jmv 4/3/2009 11:48'!
scrollBarFills: aRectangle
	"Return true if a flop-out scrollbar fills the rectangle"

	retractableScrollBar ifFalse:[^false].
	
	(self vIsScrollbarShowing and: [scrollBar bounds containsRect: aRectangle])
				ifTrue:[ ^true ].
	^(self hIsScrollbarShowing and: [hScrollBar bounds containsRect: aRectangle])
! !

!ScrollPane methodsFor: 'geometry testing' stamp: 'jmv 4/3/2009 11:49'!
vIsScrollbarShowing
	"Return true if a retractable scroll bar is currently showing"

	"^submorphs includes: scrollBar"
	^scrollBar owner == self! !

!ScrollPane methodsFor: 'initialization' stamp: 'jmv 4/5/2009 15:09'!
defaultBorderColor
	"answer the default border color/fill style for the receiver"
	^ Color black! !

!ScrollPane methodsFor: 'initialization' stamp: 'jmv 4/6/2009 09:03'!
initialize
	
	"initialize the state of the receiver"
	super initialize.
	hideScrollBars _ false.
	retractableScrollBar _ Preferences inboardScrollbars not.
	scrollBarOnLeft _ Preferences scrollBarsOnRight not.
	hasFocus _ false.
	self initializeScrollBars.
	self extent: 150 @ 120


! !

!ScrollPane methodsFor: 'initialization' stamp: 'jmv 4/5/2009 14:46'!
initializeScrollBars
	"initialize the receiver's scrollBars"

	(scrollBar := ScrollBar new model: self slotName: 'vScrollBar')
		borderWidth: 1;
		borderColor: Color black.
	(hScrollBar := ScrollBar new model: self slotName: 'hScrollBar')
		borderWidth: 1;
		borderColor: Color black.

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

!ScrollPane methodsFor: 'menu' stamp: 'jmv 4/6/2009 08:23'!
addCustomMenuItems: aCustomMenu hand: aHandMorph
	super addCustomMenuItems: aCustomMenu hand: aHandMorph.
	retractableScrollBar
		ifTrue: [aCustomMenu add: 'make scrollbar inboard' translated action: #retractableOrNot]
		ifFalse: [aCustomMenu add: 'make scrollbar retractable' translated action: #retractableOrNot].
	scrollBarOnLeft
		ifTrue: [aCustomMenu add: 'scroll bar on right' translated action: #leftOrRight]
		ifFalse: [aCustomMenu add: 'scroll bar on left' translated action: #leftOrRight]! !

!ScrollPane methodsFor: 'menu' stamp: 'jmv 4/6/2009 08:59'!
leftOrRight
	"Change scroll bar operation"

	scrollBarOnLeft _ scrollBarOnLeft not.
	scrollBarOnLeft ifTrue: [
		retractableScrollBar _ true.
		self removeMorph: scrollBar ].
	self layoutChanged
! !

!ScrollPane methodsFor: 'menu' stamp: 'jmv 4/6/2009 08:59'!
retractableOrNot
	"Change scroll bar operation"

	retractableScrollBar _ retractableScrollBar not.
	retractableScrollBar ifFalse: [
		scrollBarOnLeft _ false ].
	retractableScrollBar
		ifTrue: [ self removeMorph: scrollBar]
		ifFalse: [ self vIsScrollbarShowing
					ifFalse: 
						[self privateAddMorph: scrollBar atIndex: 1.
						self privateAddMorph: hScrollBar atIndex: 1]].
	self layoutChanged
! !

!ScrollPane methodsFor: 'scroll bar events' stamp: 'jmv 4/4/2009 17:03'!
hScrollBarMenuButtonPressed: event
	^ self scrollBarMenuButtonPressed: event
! !

!ScrollPane methodsFor: 'scrolling' stamp: 'jmv 4/5/2009 14:38'!
hHideScrollBar
	self hIsScrollbarShowing ifFalse: [^scroller offset: (self hMargin negated@scroller offset y)].
	self removeMorph: hScrollBar.
	scroller offset: (self hMargin negated@scroller offset y).
	retractableScrollBar ifFalse: [self resetExtent].

! !

!ScrollPane methodsFor: 'scrolling' stamp: 'jmv 4/3/2009 17:48'!
hIsScrollbarNeeded
"Return whether the horz scrollbar is needed"

	"Don't do anything with the retractable scrollbar unless we have focus"
	retractableScrollBar & hasFocus not ifTrue: [^false].
	
	"Don't show it if we were told not to."
	hideScrollBars ifTrue: [^false].

	^self hIsScrollable
! !

!ScrollPane methodsFor: 'scrolling' stamp: 'jmv 4/3/2009 10:53'!
hScrollBarValue: scrollValue

	| x |
	self hIsScrollbarShowing ifFalse: 
		[^scroller offset: (0 - self hMargin)@scroller offset y].
	((x _ self hLeftoverScrollRange * scrollValue) <= 0)
		ifTrue:[x _ 0 - self hMargin].
	scroller offset: (x@scroller offset y)
! !

!ScrollPane methodsFor: 'scrolling' stamp: 'jmv 4/5/2009 15:08'!
hShowScrollBar

	self hIsScrollbarShowing ifTrue: [^self].
	self privateAddMorph: hScrollBar atIndex: 1.
	retractableScrollBar ifFalse: [
		self resetExtent ].
! !

!ScrollPane methodsFor: 'scrolling' stamp: 'jmv 4/4/2009 16:39'!
hideOrShowScrollBars

	| wasHShowing wasVShowing |

	wasVShowing _ self vIsScrollbarShowing.
	wasHShowing _ self hIsScrollbarShowing.

	self 
		vHideOrShowScrollBar; 
		hHideOrShowScrollBar.

	(wasVShowing and: [self vIsScrollbarShowing not]) ifTrue:
		["Make sure the delta is 0"
		(scroller offset y = 0) 
				ifFalse:[ scroller offset: (scroller offset x@0) ]].
			
	(wasHShowing and: [self hIsScrollbarShowing not]) ifTrue:
		[(scroller offset x <= 0)
				ifFalse:[ scroller offset: (self hMargin negated@scroller offset y)]].
! !

!ScrollPane methodsFor: 'scrolling' stamp: 'jmv 4/5/2009 23:15'!
scrollToShow: aRectangle
	"scroll to include as much of aRectangle as possible, where aRectangle is in the scroller's local space"
	| range |
	((aRectangle top - scroller offset y) >= 0 and: [
		(aRectangle bottom - scroller offset y) <= self viewableHeight ])
		ifTrue: [
			"already visible"
			^self ].

	range _ self vLeftoverScrollRange.
	scrollBar value: (range > 0
		ifTrue: [((aRectangle top) / self vLeftoverScrollRange)
							truncateTo: scrollBar scrollDelta]
		ifFalse: [0]).
	scroller offset: -3 @ (range * scrollBar value).! !

!ScrollPane methodsFor: 'scrolling' stamp: 'jmv 4/5/2009 14:39'!
vHideScrollBar
	self vIsScrollbarShowing ifFalse: [^self].
	self removeMorph: scrollBar.
	retractableScrollBar ifFalse: [self resetExtent].
	
! !

!ScrollPane methodsFor: 'scrolling' stamp: 'jmv 4/3/2009 17:53'!
vIsScrollbarNeeded
"Return whether the vertical scrollbar is needed"

	"Don't do anything with the retractable scrollbar unless we have focus"
	retractableScrollBar & hasFocus not ifTrue: [^false].
	
	"Don't show it if we were told not to."
	hideScrollBars ifTrue: [^false].
	
	^self vIsScrollable
! !

!ScrollPane methodsFor: 'scrolling' stamp: 'jmv 4/5/2009 15:08'!
vShowScrollBar

	self vIsScrollbarShowing ifTrue: [^ self].
	self privateAddMorph: scrollBar atIndex: 1.
	retractableScrollBar ifFalse: [
		self resetExtent ]
! !


!PluggableListMorph methodsFor: 'selection' stamp: 'jmv 4/5/2009 23:23'!
numSelectionsInView
	^ self viewableHeight // self listItemHeight! !

!PluggableListMorph methodsFor: 'selection' stamp: 'jmv 4/5/2009 22:53'!
scrollSelectionIntoView
	"make sure that the current selection is visible"
	| row |
	row := self getCurrentSelectionIndex.
	row = 0 ifTrue: [ ^ self ].
	self scrollToShow: (self listMorph drawBoundsForRow: row)! !


!ScrollbarButton methodsFor: 'initialization' stamp: 'jmv 4/5/2009 19:09'!
initialize
	super initialize.
	self setBorderWidth: 1 borderColor: #raised.! !

!ScrollbarButton methodsFor: 'initialization' stamp: 'jmv 4/5/2009 19:25'!
updateDownButtonImage
	"update the receiver's as a downButton.  put a new image inside"

	image _ self class arrowOfDirection: #bottom size: self extent.
	self changed! !

!ScrollbarButton methodsFor: 'initialization' stamp: 'jmv 4/5/2009 19:26'!
updateLeftButtonImage
	"update the receiver's as a downButton.  put a new image inside"

	image _ self class arrowOfDirection: #left size: self extent.
	self changed! !

!ScrollbarButton methodsFor: 'initialization' stamp: 'jmv 4/5/2009 19:26'!
updateMenuButtonImage
	"update the receiver's as a menuButton. put a new image inside"

	image _ self class boxOfSize: self extent.
	self changed! !

!ScrollbarButton methodsFor: 'initialization' stamp: 'jmv 4/5/2009 19:26'!
updateRightButtonImage
	"update the receiver's as a downButton.  put a new image inside"

	image _ self class arrowOfDirection: #right size: self extent.
	self changed! !

!ScrollbarButton methodsFor: 'initialization' stamp: 'jmv 4/5/2009 19:26'!
updateUpButtonImage
	"update the receiver's as a upButton. put a new image inside"

	image _ self class arrowOfDirection: #top size: self extent.
	self changed! !

!ScrollbarButton methodsFor: 'drawing' stamp: 'jmv 4/5/2009 19:41'!
drawOn: aCanvas

	super drawOn: aCanvas.
	aCanvas translucentImage: image at: self position! !


!ScrollbarButton class methodsFor: 'images' stamp: 'jmv 4/5/2009 18:58'!
arrowOfDirection: aSymbol size: finalSizeInteger
	"answer a form with an arrow based on the parameters"
	CurrentSize = finalSizeInteger ifFalse: [
		self initializeArrowsAndBox: finalSizeInteger ].
	^Arrows at: aSymbol! !

!ScrollbarButton class methodsFor: 'images' stamp: 'jmv 4/5/2009 18:57'!
boxOfSize: finalSizeInteger
	"answer a form with an box based on the parameters"
	CurrentSize = finalSizeInteger ifFalse: [
		self initializeArrowsAndBox: finalSizeInteger ].
	^Box! !

!ScrollbarButton class methodsFor: 'images' stamp: 'jmv 4/5/2009 18:58'!
createArrowIn: aRectangle 
	"PRIVATE - create an arrow bounded in aRectangle"
	"
	(self createArrowOfDirection: #up in: (0@0 extent: 20@20)) openInWorld
	"

	| arrow vertices |
	vertices := self verticesForSimpleArrow: aRectangle.
	arrow := PolygonMorph 
				vertices: vertices
				color: Color darkGray
				borderWidth: 0
				borderColor: Color black.
	arrow bounds: (arrow bounds insetBy: (aRectangle width / 6) rounded).
	^arrow! !

!ScrollbarButton class methodsFor: 'images' stamp: 'jmv 4/5/2009 19:41'!
createArrowOfDirection: aSymbolDirection size: finalSizeInteger
	"PRIVATE - create an arrow with aSymbolDirectionDirection,  
	finalSizeInteger and aColor  
	 
	aSymbolDirectionDirection = #top, #bottom. #left or #right  
	 (self createArrowOfDirection: #up size: 120) display
	"

	| resizeFactor outerBox arrowMorph resizedForm |
	resizeFactor := 4.
	outerBox := RectangleMorph new.
	outerBox
		extent: finalSizeInteger asPoint * resizeFactor;
		borderWidth: 0;
		color: Color transparent.
	
	arrowMorph := self createArrowIn: outerBox bounds.
	outerBox addMorphCentered: arrowMorph.
	
	resizedForm := outerBox imageForm 
				magnify: outerBox imageForm boundingBox
				by: 1 / resizeFactor
				smoothing: 4.

	aSymbolDirection == #right
		ifTrue: [resizedForm _ resizedForm rotateBy: 90].
	aSymbolDirection == #bottom
		ifTrue: [resizedForm _ resizedForm rotateBy:  180].
	aSymbolDirection == #left
		ifTrue: [resizedForm _ resizedForm rotateBy:  270].
		
	aSymbolDirection == #up
		ifFalse: [ resizedForm _ resizedForm
			copy: (resizedForm boundingBox insetBy: (resizedForm width - finalSizeInteger/ 2.0) rounded) ].
		
	^resizedForm! !

!ScrollbarButton class methodsFor: 'images' stamp: 'jmv 4/5/2009 18:58'!
createBoxIn: aRectangle 
	"PRIVATE - create an box bounded in aRectangle"
	| box |
	box := RectangleMorph new.
	box extent: (aRectangle scaleBy: 1 / 2) extent rounded;
		 borderWidth: 0.
	box color: Color darkGray.
	^ box! !

!ScrollbarButton class methodsFor: 'images' stamp: 'jmv 4/5/2009 19:39'!
createBoxOfSize: finalSizeInteger
	"PRIVATE - create a box with finalSizeInteger and aColor  
	 
	Try with:  
	(ScrollBar createBoxOfSize: 32) display
	"

	| resizeFactor outerBox innerBox resizedForm |
	resizeFactor := 4.
	outerBox := RectangleMorph new.
	outerBox
		extent: finalSizeInteger asPoint * resizeFactor;
		borderWidth: 0;
		color: Color transparent.

	innerBox := self createBoxIn: outerBox bounds.
	outerBox addMorphCentered: innerBox.

	resizedForm := outerBox imageForm 
				magnify: outerBox imageForm boundingBox
				by: 1 / resizeFactor
				smoothing: 4.

	^resizedForm! !

!ScrollbarButton class methodsFor: 'images' stamp: 'jmv 4/5/2009 18:57'!
initializeArrowsAndBox: finalSizeInteger
	Arrows _ Dictionary new.
	#(#top #bottom #left #right ) do: [ :dir |
		Arrows at: dir put: (self createArrowOfDirection: dir size: finalSizeInteger) ].
	Box _ self createBoxOfSize: finalSizeInteger.
	CurrentSize _ finalSizeInteger! !

!ScrollbarButton class methodsFor: 'images' stamp: 'jmv 4/5/2009 18:58'!
verticesForSimpleArrow: aRectangle 
	"PRIVATE - answer a collection of vertices to draw a simple arrow"
	| vertices |
	vertices _ OrderedCollection new.
	
	vertices add: aRectangle bottomLeft.
	vertices add: aRectangle center x @ (aRectangle top + (aRectangle width / 8)).
	vertices add: aRectangle bottomRight.
	
	^ vertices! !


!SimpleHierarchicalListMorph methodsFor: 'selection' stamp: 'jmv 4/5/2009 23:23'!
numSelectionsInView
	^ self viewableHeight // self listItemHeight! !

!SimpleHierarchicalListMorph methodsFor: 'selection' stamp: 'jmv 4/5/2009 23:23'!
selectionIndex: idx
	"Called internally to select the index-th item."
	| theMorph range index |
	idx ifNil: [^ self].
	index := idx min: scroller submorphs size max: 0.
	(theMorph _ index = 0 ifTrue: [nil] ifFalse: [scroller submorphs at: index])
		ifNotNil:
		[((theMorph bounds top - scroller offset y) >= 0
			and: [(theMorph bounds bottom - scroller offset y) <= self viewableHeight]) ifFalse:
			["Scroll into view -- should be elsewhere"
			range _ self vTotalScrollRange.
			scrollBar value: (range > 0
				ifTrue: [((index-1 * theMorph height) / self vTotalScrollRange)
									truncateTo: scrollBar scrollDelta]
				ifFalse: [0]).
			scroller offset: -3 @ (range * scrollBar value)]].
	self selectedMorph: theMorph! !


!SystemDictionary methodsFor: 'shrinking' stamp: 'jmv 4/3/2009 10:53'!
presumedSentMessages   | sent |
"Smalltalk presumedSentMessages"

	"The following should be preserved for doIts, etc"
	sent _ IdentitySet new.
	#( rehashWithoutBecome compactSymbolTable rebuildAllProjects
		browseAllSelect:  lastRemoval
		vScrollBarValue: hScrollBarValue: scrollBarMenuButtonPressed: 
		withSelectionFrom:  to: removeClassNamed:
		dragon: hilberts: mandala: web test3 factorial tinyBenchmarks benchFib
		newDepth: restoreAfter: forgetDoIts zapAllMethods obsoleteClasses
		removeAllUnSentMessages abandonSources removeUnreferencedKeys
		reclaimDependents zapOrganization condenseChanges browseObsoleteReferences
		subclass:instanceVariableNames:classVariableNames:poolDictionaries:category:
		methodsFor:stamp: methodsFor:stamp:prior: instanceVariableNames:
		startTimerInterruptWatcher unusedClasses) do:
		[:sel | sent add: sel].
	"The following may be sent by perform: in dispatchOnChar..."
	(TextEditor classPool at: #CmdActions) asSet do:
		[:sel | sent add: sel].
	(TextEditor classPool at: #ShiftCmdActions) asSet do:
		[:sel | sent add: sel].
	^ sent! !

!SystemDictionary methodsFor: 'shrinking' stamp: 'jmv 4/3/2009 10:53'!
removeAllUnSentMessages
	"Smalltalk removeAllUnSentMessages"
	"[Smalltalk unusedClasses do: [:c | (Smalltalk at: c) removeFromSystem]. 
	Smalltalk removeAllUnSentMessages > 0] whileTrue."
	"Remove all implementations of unsent messages."
	| sels n |
	sels _ self allUnSentMessages.
	"The following should be preserved for doIts, etc"
	"needed even after #majorShrink is pulled"
	#(#rehashWithoutBecome #compactSymbolTable #rebuildAllProjects #browseAllSelect:  #lastRemoval vScrollBarValue: #hScrollBarValue: #scrollBarMenuButtonPressed: #withSelectionFrom: #to: #removeClassNamed: #dragon: #hilberts: #mandala: #web #test3 #factorial #tinyBenchmarks #benchFib #newDepth: #restoreAfter: #forgetDoIts #zapAllMethods #obsoleteClasses #removeAllUnSentMessages #abandonSources #removeUnreferencedKeys #reclaimDependents #zapOrganization #condenseChanges #browseObsoleteReferences #subclass:instanceVariableNames:classVariableNames:poolDictionaries:category: #methodsFor:stamp: #methodsFor:stamp:prior: #instanceVariableNames: #startTimerInterruptWatcher #unusedClasses )
		do: [:sel | sels
				remove: sel
				ifAbsent: []].
	"The following may be sent by perform: in dispatchOnChar..."
	(TextEditor classPool at: #CmdActions) asSet
		do: [:sel | sels
				remove: sel
				ifAbsent: []].
	(TextEditor classPool at: #ShiftCmdActions) asSet
		do: [:sel | sels
				remove: sel
				ifAbsent: []].
	sels size = 0
		ifTrue: [^ 0].
	n _ 0.
	Smalltalk
		allBehaviorsDo: [:x | n _ n + 1].
	'Removing ' , sels size printString , ' messages . . .'
		displayProgressAt: Sensor cursorPoint
		from: 0
		to: n
		during: [:bar | 
			n _ 0.
			self
				allBehaviorsDo: [:class | 
					bar value: (n _ n + 1).
					sels
						do: [:sel | class basicRemoveSelector: sel]]].
	^ sels size! !


!SystemWindow methodsFor: 'menu' stamp: 'jmv 4/5/2009 15:43'!
fullScreen
	"Zoom Window to Full World size with possible DeskMargins"

	"SystemWindow fullScreen"

	| left right possibleBounds |
	left := right := 0.
	self paneMorphs do: 
			[:pane | 
			((pane isKindOf: ScrollPane) and: [pane retractableScrollBar]) 
				ifTrue: [
					right := right max: Preferences scrollbarThickness]].
	possibleBounds := (RealEstateAgent maximumUsableAreaInWorld: self world) 
				insetBy: (left @ 0 corner: right @ 0).
	Preferences fullScreenLeavesDeskMargins 
		ifTrue: [possibleBounds := possibleBounds insetBy: 22].
	self bounds: possibleBounds! !

PluggableListMorphOfMany removeSelector: #list:!
PluggableListMorphByItem removeSelector: #list:!
PluggableListMorph removeSelector: #list:!
ScrollPane removeSelector: #alwaysShowHScrollBar:!
ScrollPane removeSelector: #alwaysShowVScrollBar:!
ScrollPane removeSelector: #flatColoredScrollBarLook!
ScrollPane removeSelector: #hInitScrollBarTEMPORARY!
ScrollPane removeSelector: #hIsScrolled!
ScrollPane removeSelector: #hResizeScrollBar!
ScrollPane removeSelector: #hideHScrollBarIndefinitely:!
ScrollPane removeSelector: #hideOrShowScrollBar!
ScrollPane removeSelector: #hideScrollBars!
ScrollPane removeSelector: #hideScrollBarsIndefinitely:!
ScrollPane removeSelector: #hideVScrollBarIndefinitely:!
ScrollPane removeSelector: #initializePreferences!
ScrollPane removeSelector: #innerBounds!
ScrollPane removeSelector: #isScrolledFromTop!
ScrollPane removeSelector: #resizeScrollBars!
ScrollPane removeSelector: #retractable:!
ScrollPane removeSelector: #scrollBarThickness!
ScrollPane removeSelector: #scroller:!
ScrollPane removeSelector: #showScrollBars!
ScrollPane removeSelector: #vIsScrolled!
ScrollPane removeSelector: #vResizeScrollBar!
!classDefinition: #ScrollPane category: #'Morphic-OldWindows'!
MorphWithModel subclass: #ScrollPane
	instanceVariableNames: 'scrollBar scroller retractableScrollBar scrollBarOnLeft getMenuSelector getMenuTitleSelector hasFocus hScrollBar hideScrollBars'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Morphic-OldWindows'!
ScrollBar class removeSelector: #alwaysShowFlatScrollbarForAlternativeLook!
ScrollBar class removeSelector: #arrowOfDirection:size:color:!
ScrollBar class removeSelector: #arrowSamples!
ScrollBar class removeSelector: #boxOfSize:color:!
ScrollBar class removeSelector: #createArrowImagesCache!
ScrollBar class removeSelector: #createArrowOfDirection:in:!
ScrollBar class removeSelector: #createArrowOfDirection:size:color:!
ScrollBar class removeSelector: #createBoxImagesCache!
ScrollBar class removeSelector: #createBoxIn:!
ScrollBar class removeSelector: #createBoxOfSize:color:!
ScrollBar class removeSelector: #initialize!
ScrollBar class removeSelector: #initializeImagesCache!
ScrollBar class removeSelector: #sampleColors!
ScrollBar class removeSelector: #sampleSizes!
ScrollBar class removeSelector: #updateScrollBarButtonsAspect:color:!
ScrollBar class removeSelector: #verticesForComplexArrow:!
ScrollBar class removeSelector: #verticesForSimpleArrow:!

!ScrollBar class reorganize!
('as yet unclassified')
!

ScrollBar removeSelector: #alternativeScrollbarLook!
ScrollBar removeSelector: #downImage!
ScrollBar removeSelector: #menuImage!
ScrollBar removeSelector: #scrollDown!
ScrollBar removeSelector: #scrollUp!
ScrollBar removeSelector: #upArrow8Bit!
ScrollBar removeSelector: #upImage!
ScrollBar removeSelector: #updateDownButtonImage!
ScrollBar removeSelector: #updateMenuButtonImage!
ScrollBar removeSelector: #updateUpButtonImage!
!classDefinition: #ScrollBar category: #'Morphic-OldWindows'!
MorphWithModel subclass: #ScrollBar
	instanceVariableNames: 'slider value setValueSelector sliderShadow sliderColor menuButton upButton downButton pagingArea scrollDelta pageDelta interval menuSelector timeOfMouseDown timeOfLastScroll nextPageDirection currentScrollDelay scrollBarAction'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Morphic-OldWindows'!

!ScrollBar reorganize!
('access' interval: pagingArea scrollDelta scrollDelta:pageDelta: sliderColor sliderColor: sliderShadowColor thumbColor value wantsSlot)
('accessing' adoptPaneColor:)
('geometry' buttonExtent computeSlider expandSlider extent: roomToMove sliderExtent totalSliderArea)
('initialize' initialize initializeDownButton initializeMenuButton initializePagingArea initializeSlider initializeUpButton)
('model access' setValue: value:)
('other events' menuButtonMouseDown: mouseDownInSlider: mouseUpInSlider:)
('scroll timing' resetTimer waitForDelay1:delay2:)
('scrolling' doScrollByPage doScrollDown doScrollUp finishedScrolling scrollAbsolute: scrollBarAction scrollBarAction: scrollDown: scrollDownInit scrollPageInit: scrollUp: scrollUpInit setNextDirectionFromEvent:)
('stepping and presenter' step)
('testing' stepTime wantsSteps)
('initialization' defaultBorderColor defaultBorderWidth defaultBounds defaultColor)
!

Preferences class removeSelector: #alternativeScrollbarLook!
Preferences class removeSelector: #alwaysHideHScrollbar!
Preferences class removeSelector: #alwaysShowHScrollbar!
Preferences class removeSelector: #alwaysShowVScrollbar!
Preferences class removeSelector: #scrollBarWidth!
Smalltalk removeClassNamed: #LRUCache!
Smalltalk removeClassNamed: #Slider!
"Postscript:
"
Preferences removePreference: #alwaysHideHScrollbar.
Preferences removePreference: #alwaysShowHScrollbar.
Preferences removePreference: #alwaysShowVScrollbar.
Preferences removePreference: #alternativeScrollbarLook.
""!

