[squeak-dev] The Trunk: Morphic-mt.1213.mcz

commits at source.squeak.org commits at source.squeak.org
Sun Jul 31 09:21:26 UTC 2016


Marcel Taeumel uploaded a new version of Morphic to project The Trunk:
http://source.squeak.org/trunk/Morphic-mt.1213.mcz

==================== Summary ====================

Name: Morphic-mt.1213
Author: mt
Time: 31 July 2016, 11:20:50.02449 am
UUID: c742cfa9-9c98-5a44-a7ad-28b28510a158
Ancestors: Morphic-mt.1212

*** Widget Refactorings and UI Themes (Part 6 of 11) ***

Some fixes and refactorings for lists, trees, text boxes --- including added support for UI theming.

=============== Diff against Morphic-mt.1212 ===============

Item was added:
+ ----- Method: IndentingListItemMorph>>colorToUse (in category 'drawing') -----
+ colorToUse
+ 
+ 	^ (self valueOfProperty: #wasRefreshed ifAbsent: [false])
+ 		ifTrue: [complexContents highlightColor ifNil: [self highlightTextColor]]
+ 		ifFalse: [
+ 			self isSelected ifTrue: [^ self selectionTextColor].			
+ 			complexContents preferredColor ifNil: [self color]]!

Item was added:
+ ----- Method: IndentingListItemMorph>>drawHoverOn: (in category 'drawing') -----
+ drawHoverOn: aCanvas 
+ 
+ 	aCanvas
+ 		fillRectangle: self bounds
+ 		color: self hoverColor.!

Item was changed:
  ----- Method: IndentingListItemMorph>>drawOn: (in category 'drawing') -----
  drawOn: aCanvas
  	
  	| tRect sRect columnScanner columnLeft |
  	self backgroundColor ifNotNil: [:c |
  		aCanvas fillRectangle: self innerBounds color: c].
  
  	tRect := self toggleRectangle.	
  	self drawToggleOn: aCanvas in: tRect.
  
  	sRect := bounds withLeft: tRect right + self hMargin.
  	sRect := sRect top: sRect top + sRect bottom - self fontToUse height // 2.	
  	
  	(container columns isNil or: [(contents asString indexOf: Character tab) = 0]) ifTrue: [
  		icon ifNotNil: [
  			aCanvas
  				translucentImage: icon
  				at: sRect left @ (self top + (self height - icon height // 2)).
  			sRect := sRect left: sRect left + icon width + 2.
  		].
  		
+ 		aCanvas drawString: contents asString in: sRect font: self fontToUse color: self colorToUse.
- 		aCanvas drawString: contents asString in: sRect font: self fontToUse color: color.
  	
  	] ifFalse: [
  		columnLeft := sRect left.
  		columnScanner := ReadStream on: contents asString.
  		container columns withIndexDo: [ :widthSpec :column | | columnRect columnData columnWidth |
  			"Draw icon."
  			column = self class iconColumnIndex ifTrue: [
  				icon ifNotNil: [
  					aCanvas
  						translucentImage: icon
  						at: columnLeft @ (self top + (self height - icon height // 2)).
  					columnLeft := columnLeft + icon width + 2]].
  
  			columnWidth := self widthOfColumn: column.
  			columnRect := columnLeft @ sRect top extent: columnWidth @ sRect height.
  			columnData := columnScanner upTo: Character tab.
  			
  			"Draw string."
  			columnData ifNotEmpty: [
+ 				aCanvas drawString: columnData in: columnRect font: self fontToUse color: self colorToUse].
- 				aCanvas drawString: columnData in: columnRect font: self fontToUse color: color].
  
  			"Compute next column offset."			
  			columnLeft := columnRect right + 5.
  			column = 1 ifTrue: [columnLeft := columnLeft - tRect right + self left].
  			
  		].
  	]!

Item was added:
+ ----- Method: IndentingListItemMorph>>drawSelectionOn: (in category 'drawing') -----
+ drawSelectionOn: aCanvas 
+ 
+ 	| fill |
+ 	fill := self selectionColor isColor
+ 		ifTrue: [SolidFillStyle color: self selectionColor]
+ 		ifFalse: [self selectionColor].
+ 	fill isGradientFill ifTrue: [
+ 		fill origin: self topLeft.
+ 		fill direction: 0@ self height].
+ 
+ 	aCanvas
+ 		fillRectangle: self bounds
+ 		fillStyle: fill.!

Item was added:
+ ----- Method: IndentingListItemMorph>>filterColor (in category 'accessing') -----
+ filterColor
+ 
+ 	^ self valueOfProperty: #filterColor ifAbsent: [Color yellow]!

Item was added:
+ ----- Method: IndentingListItemMorph>>filterColor: (in category 'accessing') -----
+ filterColor: aColor
+ 
+ 	| cc fill |
+ 	cc := aColor.
+ 
+ 	MenuMorph gradientMenu
+ 		ifFalse: [fill := SolidFillStyle color: cc]
+ 		ifTrue: [
+ 			fill := GradientFillStyle ramp: { 
+ 				0.0 -> cc twiceLighter. 
+ 				1 -> cc twiceDarker }].
+ 			
+ 	self setProperty: #filterColor toValue: fill.!

Item was added:
+ ----- Method: IndentingListItemMorph>>filterTextColor (in category 'accessing') -----
+ filterTextColor
+ 
+ 	^ self valueOfProperty: #filterTextColor ifAbsent: [Color black]!

Item was added:
+ ----- Method: IndentingListItemMorph>>filterTextColor: (in category 'accessing') -----
+ filterTextColor: aColor
+ 
+ 	self setProperty: #filterTextColor toValue: aColor.!

Item was added:
+ ----- Method: IndentingListItemMorph>>fitContents (in category 'accessing') -----
+ fitContents
+ 
+ 	super fitContents.
+ 	self width: container preferredSubmorphWidth.!

Item was changed:
+ ----- Method: IndentingListItemMorph>>highlight (in category 'drawing') -----
- ----- Method: IndentingListItemMorph>>highlight (in category 'container protocol - private') -----
  highlight
  
- 	(self valueOfProperty: #wasRefreshed ifAbsent: [false])
- 		ifFalse: [self color: complexContents highlightingColor]
- 		ifTrue: [self color: self color negated].
- 		
  	self changed.
  	
  !

Item was added:
+ ----- Method: IndentingListItemMorph>>highlightTextColor (in category 'accessing') -----
+ highlightTextColor
+ 
+ 	^ self valueOfProperty: #highlightTextColor ifAbsent: [Color red]!

Item was added:
+ ----- Method: IndentingListItemMorph>>highlightTextColor: (in category 'accessing') -----
+ highlightTextColor: aColor
+ 
+ 	self setProperty: #highlightTextColor toValue: aColor.!

Item was added:
+ ----- Method: IndentingListItemMorph>>hoverColor (in category 'accessing') -----
+ hoverColor
+ 
+ 	^ self valueOfProperty: #hoverColor ifAbsent: [Color veryLightGray]!

Item was added:
+ ----- Method: IndentingListItemMorph>>hoverColor: (in category 'accessing') -----
+ hoverColor: aColor
+ 
+ 	self setProperty: #hoverColor toValue: aColor.!

Item was added:
+ ----- Method: IndentingListItemMorph>>isSelected (in category 'testing') -----
+ isSelected
+ 
+ 	^ container ifNil: [false] ifNotNil: [container selectedMorph == self]!

Item was changed:
  ----- Method: IndentingListItemMorph>>refresh (in category 'initialization') -----
  refresh
  
  	self contents: self getLabel.
  	icon := self getIcon.
- 	self width: container preferredSubmorphWidth.
  	
  	(self valueOfProperty: #wasRefreshed ifAbsent: [false]) ifFalse: [
+ 		self setProperty: #wasRefreshed toValue: true].!
- 		self setProperty: #wasRefreshed toValue: true.
- 		self color: Color yellow. "Indicate refresh operation."].!

Item was added:
+ ----- Method: IndentingListItemMorph>>selectionColor (in category 'accessing') -----
+ selectionColor
+ 
+ 	^ self valueOfProperty: #selectionColor ifAbsent: [Color blue]!

Item was added:
+ ----- Method: IndentingListItemMorph>>selectionColor: (in category 'accessing') -----
+ selectionColor: aColor
+ 
+ 	| cc fill |
+ 	cc := aColor.
+ 
+ 	MenuMorph gradientMenu
+ 		ifFalse: [fill := SolidFillStyle color: cc]
+ 		ifTrue: [
+ 			fill := GradientFillStyle ramp: { 
+ 				0.0 -> cc twiceLighter. 
+ 				1 -> cc twiceDarker }].
+ 
+ 	self setProperty: #selectionColor toValue: fill.!

Item was added:
+ ----- Method: IndentingListItemMorph>>selectionTextColor (in category 'accessing') -----
+ selectionTextColor
+ 
+ 	^ self valueOfProperty: #selectionTextColor ifAbsent: [Color white]!

Item was added:
+ ----- Method: IndentingListItemMorph>>selectionTextColor: (in category 'accessing') -----
+ selectionTextColor: aColor
+ 
+ 	self setProperty: #selectionTextColor toValue: aColor.!

Item was changed:
  ----- Method: IndentingListItemMorph>>unhighlight (in category 'drawing') -----
  unhighlight
  
- 	(self valueOfProperty: #wasRefreshed ifAbsent: [false])
- 		ifFalse: [self color: complexContents preferredColor]
- 		ifTrue: [self color: self color negated].
- 
  	self changed.
  	
  	
  !

Item was changed:
  Morph subclass: #LazyListMorph
  	instanceVariableNames: 'listItems listIcons listFilterOffsets font selectedRow selectedRows preSelectedRow listSource maxWidth'
+ 	classVariableNames: ''
- 	classVariableNames: 'ListPreSelectionColor ListSelectionColor ListSelectionTextColor'
  	poolDictionaries: ''
  	category: 'Morphic-Widgets'!
  
  !LazyListMorph commentStamp: 'efc 8/6/2005 11:34' prior: 0!
  The morph that displays the list in a PluggableListMorph.  It is "lazy" because it will only request the list items that it actually needs to display.
  
  I will cache the maximum width of my items in maxWidth to avoid this potentially expensive and frequent computation.!

Item was removed:
- ----- Method: LazyListMorph class>>listFilterHighlightColor (in category 'preferences') -----
- listFilterHighlightColor
- 
- 	^ Color yellow paler alpha: 0.5!

Item was removed:
- ----- Method: LazyListMorph class>>listPreSelectionColor (in category 'preferences') -----
- listPreSelectionColor
- 	<preference: 'List Pre Selection Color'
- 		category: 'colors'
- 		description: 'Governs the color of pre selection highlight in lists'
- 		type: #Color>
- 	^ ListPreSelectionColor ifNil: [Color r: 0.9 g: 0.9 b: 0.9]!

Item was removed:
- ----- Method: LazyListMorph class>>listPreSelectionColor: (in category 'preferences') -----
- listPreSelectionColor: aColor
- 
- 	ListPreSelectionColor := aColor.
- 	World invalidRect: World bounds from: World.!

Item was removed:
- ----- Method: LazyListMorph class>>listSelectionColor (in category 'preferences') -----
- listSelectionColor
- 	<preference: 'List Selection Color'
- 		category: 'colors'
- 		description: 'Governs the selection background in lists'
- 		type: #Color>
- 	^ ListSelectionColor ifNil: [Color r: 0.72 g: 0.72 b: 0.9]!

Item was removed:
- ----- Method: LazyListMorph class>>listSelectionColor: (in category 'preferences') -----
- listSelectionColor: aColor
- 
- 	ListSelectionColor := aColor.
- 	World invalidRect: World bounds from: World.!

Item was removed:
- ----- Method: LazyListMorph class>>listSelectionTextColor (in category 'preferences') -----
- listSelectionTextColor
- 	<preference: 'List Selection Text Color'
- 		category: 'colors'
- 		description: 'Governs the color of selected text in lists'
- 		type: #Color>
- 	^ ListSelectionTextColor ifNil: [Color black]!

Item was removed:
- ----- Method: LazyListMorph class>>listSelectionTextColor: (in category 'preferences') -----
- listSelectionTextColor: aColor
- 	
- 	ListSelectionTextColor := aColor.
- 	World invalidRect: World bounds from: World.!

Item was changed:
  ----- Method: LazyListMorph>>colorForRow: (in category 'drawing') -----
  colorForRow: row
  	
  	^(selectedRow notNil and: [ row = selectedRow])
+ 		ifTrue: [ self selectionTextColor ]
- 		ifTrue: [ self class listSelectionTextColor ]
  		ifFalse: [ self color ].!

Item was changed:
  ----- Method: LazyListMorph>>display:atRow:on: (in category 'drawing') -----
  display: item atRow: row on: canvas
  	"display the given item at row row"
  
  	| drawBounds emphasized rowColor itemAsText |
  	itemAsText := item asStringOrText.
  	
  	"If it is a text, we will only use the first character's emphasis."
  	emphasized := itemAsText isText 
  		ifTrue: [font emphasized: (itemAsText emphasisAt: 1)] 
  		ifFalse: [font].
  	
  	rowColor := itemAsText isText
  		ifTrue: [itemAsText colorAt: 1 ifNone: [self colorForRow: row]]
  		ifFalse: [self colorForRow: row].
  	
  	drawBounds := (self drawBoundsForRow: row) translateBy: (self hMargin @ 0).
  	drawBounds := drawBounds intersect: self bounds.
  
  	"Draw icon if existing. Adjust draw bounds in that case."
  	(self icon: row) ifNotNil: [ :icon || top |
  		top := drawBounds top + ((drawBounds height - icon height) // 2).
  		canvas translucentImage: icon at: drawBounds left @ top.
  		drawBounds := drawBounds left: drawBounds left + icon width + 2 ].
- 
- 	"Draw filter matches if any."
- 	(self filterOffsets: row) do: [:offset |
- 		canvas
- 			frameAndFillRoundRect: ((drawBounds left + offset first) @ drawBounds top corner: (drawBounds left + offset last) @ drawBounds bottom)
- 			radius: 3
- 			fillStyle: self class listFilterHighlightColor
- 			borderWidth: 1
- 			borderColor: self class listFilterHighlightColor twiceDarker].
  		
  	"We will only draw strings here."
  	canvas
  		drawString: itemAsText asString
  		in: drawBounds
  		font: emphasized
+ 		color: rowColor.
+ 
+ 	"Draw filter matches if any."
+ 	self
+ 		displayFilterOn: canvas
+ 		for: row
+ 		in: drawBounds
+ 		font: emphasized.!
- 		color: rowColor.!

Item was added:
+ ----- Method: LazyListMorph>>displayFilterOn:for:in:font: (in category 'drawing') -----
+ displayFilterOn: canvas for: row in: drawBounds font: font
+ 	"Draw filter matches if any."
+ 	
+ 	| fill |
+ 	fill := self filterColor isColor
+ 		ifTrue: [SolidFillStyle color: self filterColor]
+ 		ifFalse: [self filterColor].
+ 	fill isGradientFill ifTrue: [
+ 		fill origin: drawBounds topLeft.
+ 		fill direction: 0@ drawBounds height].
+ 	
+ 	(self filterOffsets: row) do: [:offset | | r |
+ 		r := ((drawBounds left + offset first first) @ drawBounds top corner: (drawBounds left + offset first last) @ drawBounds bottom).
+ 		canvas
+ 			frameAndFillRoundRect: (r outsetBy: 1 at 0)
+ 			radius: 3
+ 			fillStyle: fill
+ 			borderWidth: 1
+ 			borderColor: fill asColor twiceDarker.
+ 		canvas
+ 			drawString: offset second
+ 			in: r
+ 			font: font
+ 			color: self filterTextColor].!

Item was changed:
  ----- Method: LazyListMorph>>drawBackgroundForMulti:on: (in category 'drawing') -----
  drawBackgroundForMulti: row on: aCanvas 
  	"shade the background paler, if this row is selected, but not the current selected row"
+ 	| selectionDrawBounds |
+ 	selectedRow = row ifTrue: [^ self].
- 	| selectionDrawBounds thisColor |
- 	thisColor := selectedRow = row
- 		ifTrue: [ self class listSelectionColor twiceDarker ]
- 		ifFalse: [ self class listSelectionColor ].
  	selectionDrawBounds := self drawBoundsForRow: row.
  	selectionDrawBounds := selectionDrawBounds intersect: self bounds.
  	aCanvas
  		fillRectangle: selectionDrawBounds
+ 		color: self multiSelectionColor!
- 		color: thisColor!

Item was removed:
- ----- Method: LazyListMorph>>drawBackgroundForPotentialDrop:on: (in category 'drawing') -----
- drawBackgroundForPotentialDrop: row on: aCanvas
- 	| selectionDrawBounds |
- 	"shade the background darker, if this row is a potential drop target"
- 
- 	selectionDrawBounds := self drawBoundsForRow: row.
- 	selectionDrawBounds := selectionDrawBounds intersect: self bounds.
- 	aCanvas fillRectangle: selectionDrawBounds color:  self color muchLighter darker!

Item was changed:
  ----- Method: LazyListMorph>>drawOn: (in category 'drawing') -----
  drawOn: aCanvas
  
  	| topRow bottomRow |
  	listItems ifEmpty: [ ^self ].
+ 	
+ 	self drawPreSelectionOn: aCanvas.
+ 	
- 	 
- 	self 
- 		drawPreSelectionOn: aCanvas;
- 		drawSelectionOn: aCanvas.
- 
  	topRow := self topVisibleRowForCanvas: aCanvas.
  	bottomRow := self bottomVisibleRowForCanvas: aCanvas.
  
  	"Draw multi-selection."
  	topRow to: bottomRow do: [ :row |
  		(listSource itemSelectedAmongMultiple: row) ifTrue: [
  			self drawBackgroundForMulti: row on: aCanvas ] ].
+ 	self drawSelectionOn: aCanvas.
  
  	"Draw hovered row if preference enabled."
  	PluggableListMorph highlightHoveredRow ifTrue: [
  		listSource hoverRow > 0 ifTrue: [
  			self highlightHoverRow: listSource hoverRow on: aCanvas ] ].
  
  	"Draw all visible rows."
  	topRow to: bottomRow do: [ :row |
  		self display: (self item: row) atRow: row on: aCanvas ].
  
  	"Finally, highlight drop row for drag/drop operations.."
  	listSource potentialDropRow > 0 ifTrue: [
  		self highlightPotentialDropRow: listSource potentialDropRow on: aCanvas ].!

Item was changed:
  ----- Method: LazyListMorph>>drawPreSelectionOn: (in category 'drawing') -----
  drawPreSelectionOn: aCanvas
  	
  	self 
  		drawSelectionFor: preSelectedRow
+ 		withColor: self preSelectionColor 
- 		withColor: self class listPreSelectionColor 
  		on: aCanvas!

Item was changed:
  ----- Method: LazyListMorph>>drawSelectionFor:withColor:on: (in category 'drawing') -----
  drawSelectionFor: index withColor: color on: aCanvas
  	
+ 	| selectionDrawBounds fill |
- 	| selectionDrawBounds |
  	index ifNil: [ ^self ].
  	index = 0 ifTrue: [ ^self ].
  	selectionDrawBounds := self drawBoundsForRow: index.
  	selectionDrawBounds := selectionDrawBounds intersect: self bounds.
+ 	
+ 	fill := color isColor
+ 		ifTrue: [SolidFillStyle color: color]
+ 		ifFalse: [color].
+ 	fill isGradientFill ifTrue: [
+ 		fill origin: selectionDrawBounds topLeft.
+ 		fill direction: 0@ selectionDrawBounds height].
+ 	
+ 	aCanvas fillRectangle: selectionDrawBounds fillStyle: fill.!
- 	aCanvas fillRectangle: selectionDrawBounds color: color.!

Item was changed:
  ----- Method: LazyListMorph>>drawSelectionOn: (in category 'drawing') -----
  drawSelectionOn: aCanvas
  	
  	self 
  		drawSelectionFor: selectedRow 
+ 		withColor: self selectionColor 
- 		withColor: self class listSelectionColor 
  		on: aCanvas!

Item was added:
+ ----- Method: LazyListMorph>>filterColor (in category 'accessing') -----
+ filterColor
+ 	^ self valueOfProperty: #filterColor ifAbsent: [Color yellow]!

Item was added:
+ ----- Method: LazyListMorph>>filterColor: (in category 'accessing') -----
+ filterColor: aColor
+ 
+ 	| cc fill |
+ 	cc := aColor.
+ 
+ 	MenuMorph gradientMenu
+ 		ifFalse: [fill := SolidFillStyle color: cc]
+ 		ifTrue: [
+ 			fill := GradientFillStyle ramp: { 
+ 				0.0 -> cc twiceLighter. 
+ 				1 -> cc twiceDarker }].
+ 
+ 	self setProperty: #filterColor toValue: fill!

Item was added:
+ ----- Method: LazyListMorph>>filterTextColor (in category 'accessing') -----
+ filterTextColor
+ 	^ self valueOfProperty: #filterTextColor ifAbsent: [Color black]!

Item was changed:
  ----- Method: LazyListMorph>>getFilterOffsets: (in category 'list access') -----
  getFilterOffsets: row
  	"Calculate matching character indexes for the current filter term."
  	
+ 	| item filter offsets currentIndex sub |
- 	| item filter offsets currentIndex |
  	filter := listSource filterTerm.
  	filter ifEmpty: [^ Array empty].
  
  	item := (self item: row) asStringOrText asString. "See row drawing. Strings only."
  	offsets := OrderedCollection new.
  	
  	currentIndex := 1.
  	[currentIndex > 0] whileTrue: [
  		currentIndex := item findString: filter startingAt: currentIndex caseSensitive: false.
  		currentIndex > 0 ifTrue: [ | left width |
  			left := font widthOfString: item from: 1 to: currentIndex-1.
+ 			sub := item copyFrom: currentIndex to: currentIndex + filter size - 1.
+ 			width := font widthOfString: sub.
+ 			offsets addLast: {(left to: left + width). sub}.
- 			width := font widthOfString: item from: currentIndex to: currentIndex + filter size - 1.
- 			offsets addLast: (left to: left + width).
  			currentIndex := currentIndex + 1] ].
  	^ offsets!

Item was changed:
  ----- Method: LazyListMorph>>highlightHoverRow:on: (in category 'drawing') -----
  highlightHoverRow: row on: aCanvas
  	| drawBounds  |
  	drawBounds := self drawBoundsForRow: row.
  	drawBounds := drawBounds intersect: self bounds.
+ 	aCanvas fillRectangle: drawBounds color: self hoverColor.!
- 	aCanvas fillRectangle: drawBounds color: (self class listSelectionColor darker alpha: 0.3).!

Item was changed:
  ----- Method: LazyListMorph>>highlightPotentialDropRow:on: (in category 'drawing') -----
  highlightPotentialDropRow: row  on: aCanvas
  	| drawBounds  |
  	drawBounds := self drawBoundsForRow: row.
  	drawBounds := drawBounds intersect: self bounds.
+ 	aCanvas frameRectangle: drawBounds color: self selectionColor asColor!
- 	aCanvas frameRectangle: drawBounds color: Color blue!

Item was added:
+ ----- Method: LazyListMorph>>hoverColor (in category 'accessing') -----
+ hoverColor
+ 	^ self valueOfProperty: #hoverColor ifAbsent: [Color veryVeryLightGray]!

Item was added:
+ ----- Method: LazyListMorph>>multiSelectionColor (in category 'accessing') -----
+ multiSelectionColor
+ 
+ 	^ self valueOfProperty: #multiSelectionColor ifAbsent: [self selectionColor asColor]!

Item was added:
+ ----- Method: LazyListMorph>>multiSelectionColor: (in category 'accessing') -----
+ multiSelectionColor: aColor
+ 
+ 	self setProperty: #multiSelectionColor toValue: aColor.!

Item was added:
+ ----- Method: LazyListMorph>>preSelectionColor (in category 'accessing') -----
+ preSelectionColor
+ 	^ self valueOfProperty: #preSelectionColor ifAbsent: [Color gray]!

Item was added:
+ ----- Method: LazyListMorph>>resetFilterOffsets (in category 'list access') -----
+ resetFilterOffsets
+ 	
+ 	listFilterOffsets := nil.!

Item was added:
+ ----- Method: LazyListMorph>>selectionColor (in category 'accessing') -----
+ selectionColor
+ 	^ self valueOfProperty: #selectionColor ifAbsent: [Color blue]!

Item was added:
+ ----- Method: LazyListMorph>>selectionColor: (in category 'accessing') -----
+ selectionColor: aColor
+ 
+ 	| cc fill |
+ 	cc := aColor.
+ 
+ 	MenuMorph gradientMenu
+ 		ifFalse: [fill := SolidFillStyle color: cc]
+ 		ifTrue: [
+ 			fill := GradientFillStyle ramp: { 
+ 				0.0 -> cc twiceLighter. 
+ 				1 -> cc twiceDarker }].
+ 
+ 	self setProperty: #selectionColor toValue: fill!

Item was added:
+ ----- Method: LazyListMorph>>selectionTextColor (in category 'accessing') -----
+ selectionTextColor
+ 	^ self valueOfProperty: #selectionTextColor ifAbsent: [Color white]!

Item was added:
+ ----- Method: ListItemWrapper>>highlightColor (in category 'accessing') -----
+ highlightColor
+ 	"You can override the current theme's default with a custom value."
+ 
+ 	^ nil!

Item was removed:
- ----- Method: ListItemWrapper>>highlightingColor (in category 'accessing') -----
- highlightingColor
- 
- 	^ LazyListMorph listSelectionColor makeForegroundColor!

Item was changed:
  ----- Method: ListItemWrapper>>preferredColor (in category 'accessing') -----
  preferredColor
+ 	"You can override the current theme's default with a custom value."
+ 	
+ 	^ nil!
- 	^ Color black!

Item was changed:
  Object subclass: #NewParagraph
+ 	instanceVariableNames: 'text textStyle firstCharacterIndex container lines positionWhenComposed offsetToEnd maxRightX selectionStart selectionStop wantsColumnBreaks focused caretRect showCaret caretColor selectionColor unfocusedSelectionColor'
- 	instanceVariableNames: 'text textStyle firstCharacterIndex container lines positionWhenComposed offsetToEnd maxRightX selectionStart selectionStop wantsColumnBreaks focused caretRect showCaret'
  	classVariableNames: ''
  	poolDictionaries: ''
  	category: 'Morphic-Text Support'!
  
  !NewParagraph commentStamp: '<historical>' prior: 0!
  A Paragraph represents text that has been laid out, or composed, in some container.
  	text 		A Text with encoded per-character emphasis.
  	textStyle	A TextStyle with font set, line height and horizontal alignment.
  	firstCharacterIndex    The starting index in text for this paragraph, allowing
  				composition of a long text into a number of containers.
  	container	A Rectangle or TextContainer that determines where text can go.
  	lines		An Array of TextLines comprising the final layout of the text
  				after it has been composed within its container.
  	positionWhenComposed   As its name implies.  Allows display at new locations
  				without the need to recompose the text.
  Lines are ordered vertically.  However, for a given y, there may be several lines in left to right order.  Lines must never be empty, even if text is empty.
  
  Notes on yet another hack - 5 Feb 2001
  
  We really need to clean up #composeLinesFrom:to:delta:into:priorLines:atY:!!!!!!
  
  I added one more habdful of code to correct:
  
  This is an annoying bug that's been around for a couple of years, but I finally figured out how to duplicate the problem, so I figured I'd just report it now.  (It doesn't necessarily have to be fixed for 3.0 if it looks messy, but if it's a simple fix, it would be worth it.)
  
  In Morphic, if you have the following text in a workspace:
  
  This is line 1
  This is line 2
  
  **and** you have a return character after line 2, you will normally be able to click the mouse two times below line 2 in order to select all the text.  If you edit line 2 (e.g. so that it reads "line number 2"), you can still select all the text by clicking below the second line.  However, if you edit line 1, you will not be able to select all the text from the bottom in the same way.  Things get messed up such that the last return character seems to be gone.  In this state, if you position the cursor immediately after the 2, and press the right arrow, the cursor jumps to the beginning of line 2... oof. (report by Doug Way)
  
  While I don't have a very deep understanding of the above mentioned method, I was able to determine that text ending in a CR worked better in the editor when the last entry in <lines> had a start of text size + 1 and a stop of text size. I have accordingly added code near the end to ensure this. It seems to have fixed the problem, but we do need to clean this baby up some day. - Bob
  !

Item was added:
+ ----- Method: NewParagraph>>caretColor (in category 'access') -----
+ caretColor
+ 	^ caretColor ifNil: [Color red]!

Item was added:
+ ----- Method: NewParagraph>>caretColor: (in category 'access') -----
+ caretColor: aColor
+ 	caretColor := aColor.!

Item was changed:
  ----- Method: NewParagraph>>caretWidth (in category 'access') -----
  caretWidth
  	^ Editor dumbbellCursor
  		ifTrue: [ 3 ]
+ 		ifFalse: [ 2 ]!
- 		ifFalse: [ 1 ]!

Item was added:
+ ----- Method: NewParagraph>>displayDumbbellCursorOn:at:in: (in category 'display') -----
+ displayDumbbellCursorOn: aCanvas at: leftX in: line
+ 
+ 	| w |
+ 	w := 2.
+ 	self focused ifFalse: [^ w].
+ 	
+ 	1 to: w
+ 		do: 
+ 			[:i | 
+ 			"Draw caret triangles at top and bottom"
+ 
+ 			aCanvas fillRectangle: ((leftX - w + i - 1) @ (line top + i - 1) 
+ 						extent: ((w - i) * 2 + 3) @ 1)
+ 				color: self caretColor.
+ 			aCanvas fillRectangle: ((leftX - w + i - 1) @ (line bottom - i) 
+ 						extent: ((w - i) * 2 + 3) @ 1)
+ 				color: self caretColor].
+ 	
+ 	aCanvas
+ 		line: leftX @ line top
+ 		to: leftX @ (line bottom-1)
+ 		color: self caretColor.
+ 	
+ 	^ w!

Item was changed:
  ----- Method: NewParagraph>>displaySelectionInLine:on: (in category 'display') -----
  displaySelectionInLine: line on: aCanvas 
+ 	| leftX rightX w |
- 	| leftX rightX w caretColor |
  	selectionStart ifNil: [^self].	"No selection"
  	aCanvas isShadowDrawing ifTrue: [ ^self ].	"don't draw selection with shadow"
  	selectionStart = selectionStop 
  		ifTrue: 
  			["Only show caret on line where clicked"
  
  			selectionStart textLine ~= line ifTrue: [^self]]
+ 		ifFalse:
- 		ifFalse: 
  			["Test entire selection before or after here"
  
  			(selectionStop stringIndex < line first 
  				or: [selectionStart stringIndex > (line last + 1)]) ifTrue: [^self].	"No selection on this line"
  			(selectionStop stringIndex = line first 
  				and: [selectionStop textLine ~= line]) ifTrue: [^self].	"Selection ends on line above"
  			(selectionStart stringIndex = (line last + 1) 
  				and: [selectionStop textLine ~= line]) ifTrue: [^self]].	"Selection begins on line below"
  	leftX := (selectionStart stringIndex < line first 
  				ifTrue: [line ]
  				ifFalse: [selectionStart ])left.
  	rightX := (selectionStop stringIndex > (line last + 1) or: 
  					[selectionStop stringIndex = (line last + 1) 
  						and: [selectionStop textLine ~= line]]) 
  				ifTrue: [line right]
  				ifFalse: [selectionStop left].
  	selectionStart = selectionStop 
+ 		ifTrue: [
+ 			rightX := rightX + 1.
+ 			caretRect := (leftX-2) @ line top corner: (rightX+2)@ line bottom. "sigh..."
+ 			self showCaret ifFalse: [^self].
+ 			w := (Editor dumbbellCursor
+ 				ifTrue: [self displayDumbbellCursorOn: aCanvas at: leftX in: line]
+ 				ifFalse: [self displaySimpleCursorOn: aCanvas at: leftX in: line]).
+ 			caretRect := (leftX-w) @ line top corner: (rightX+w)@ line bottom]
+ 		ifFalse: [
+ 			caretRect := nil.
- 		ifTrue: 
- 			[rightX := rightX + 1.
- 			w := self caretWidth-1.
- 			caretRect := (leftX-w) @ line top corner: (rightX+w)@ line bottom.
- 			self showCaret ifFalse:[^self].
- 			caretColor := self insertionPointColor.
- 			1 to: w
- 				do: 
- 					[:i | 
- 					"Draw caret triangles at top and bottom"
- 
- 					aCanvas fillRectangle: ((leftX - w + i - 1) @ (line top + i - 1) 
- 								extent: ((w - i) * 2 + 3) @ 1)
- 						color: caretColor.
- 					aCanvas fillRectangle: ((leftX - w + i - 1) @ (line bottom - i) 
- 								extent: ((w - i) * 2 + 3) @ 1)
- 						color: caretColor].
  			aCanvas fillRectangle: (leftX @ line top corner: rightX @ line bottom)
+ 				color: (self focused ifTrue: [self selectionColor] ifFalse: [self unfocusedSelectionColor])]!
- 				color: caretColor]
- 		ifFalse: 
- 			[caretRect := nil.
- 			aCanvas fillRectangle: (leftX @ line top corner: rightX @ line bottom)
- 				color: self selectionColor]!

Item was added:
+ ----- Method: NewParagraph>>displaySimpleCursorOn:at:in: (in category 'display') -----
+ displaySimpleCursorOn: aCanvas at: leftX in: line
+ 
+ 	self focused ifFalse: [^ 1].
+ 	
+ 	aCanvas
+ 		line: leftX @ (line top+1)
+ 		to: leftX @ (line bottom-1)
+ 		color: self caretColor.
+ 
+ 	aCanvas
+ 		line: leftX+1 @ (line top+1)
+ 		to: leftX+1 @ (line bottom-1)
+ 		color: (self caretColor alpha: 0.3).
+ 	
+ 	^ 1!

Item was removed:
- ----- Method: NewParagraph>>insertionPointColor (in category 'display') -----
- insertionPointColor
- 	self focused ifFalse: [^ Color transparent].
- 	^ Display depth <= 2
- 		ifTrue: [Color black]
- 		ifFalse: [Preferences insertionPointColor]!

Item was changed:
+ ----- Method: NewParagraph>>selectionColor (in category 'access') -----
- ----- Method: NewParagraph>>selectionColor (in category 'display') -----
  selectionColor
+ 	^ selectionColor ifNil: [Color blue muchLighter]!
- 	| color |
- 	Display depth = 1 ifTrue: [^ Color veryLightGray].
- 	Display depth = 2 ifTrue: [^ Color gray].
- 	color := Preferences textHighlightColor.
- 	self focused ifFalse: [color := Color gray: 0.9].
- 	^ color!

Item was added:
+ ----- Method: NewParagraph>>selectionColor: (in category 'access') -----
+ selectionColor: aColor
+ 	selectionColor := aColor.!

Item was added:
+ ----- Method: NewParagraph>>unfocusedSelectionColor (in category 'access') -----
+ unfocusedSelectionColor
+ 	^ unfocusedSelectionColor ifNil: [Color gray: 0.9]!

Item was added:
+ ----- Method: NewParagraph>>unfocusedSelectionColor: (in category 'access') -----
+ unfocusedSelectionColor: aColor
+ 	unfocusedSelectionColor := aColor.!

Item was added:
+ ----- Method: PluggableListMorph class>>themeProperties (in category 'preferences') -----
+ themeProperties
+ 
+ 	^ super themeProperties, {
+ 		{ #font. 'Fonts'. 'Font of the list items.' }.
+ 		{ #textColor. 'Colors'. 'Color of the list items.' }.
+ 		{ #selectionColor. 'Colors'. 'Color used for items when hovering or selecting them.' }.
+ 		{ #multiSelectionColor. 'Colors'. 'Colors used for items that are selected among others.'}.
+ 		{ #selectionTextColor. 'Colors'. 'Color used for label when hovering or selecting them.' }.
+ 		{ #filterColor. 'Colors'. 'Color used for items to indicate the matching filter.' }.
+ 		{ #filterTextColor. 'Colors'. 'Color used for items to indicate the matching filter.' }.
+ 		
+ 		{ #preSelectionModifier. 'Colors'. 'How to derive the pre-selection color from the selection color.'}.
+ 		{ #hoverSelectionModifier. 'Colors'. 'How to derive the hover color from the selection color.'}.
+ 	}!

Item was added:
+ ----- Method: PluggableListMorph>>applyUserInterfaceTheme (in category 'updating') -----
+ applyUserInterfaceTheme
+ 
+ 	super applyUserInterfaceTheme.!

Item was changed:
  ----- Method: PluggableListMorph>>indicateUnfiltered (in category 'filtering') -----
  indicateUnfiltered
+ 	!
- 	self color: Color white!

Item was removed:
- ----- Method: PluggableListMorph>>listItemHeight (in category 'initialization') -----
- listItemHeight
- 	"This should be cleaned up.  The list should get spaced by this parameter."
- 	^ 12!

Item was changed:
  ----- Method: PluggableListMorph>>on:list:selected:changeSelected:menu:keystroke: (in category 'initialization') -----
  on: anObject list: getListSel selected: getSelectionSel changeSelected: setSelectionSel menu: getMenuSel keystroke: keyActionSel 
  	self model: anObject.
  	getListSelector := getListSel.
  	getIndexSelector := getSelectionSel.
  	setIndexSelector := setSelectionSel.
  	getMenuSelector := getMenuSel.
  	keystrokeActionSelector := keyActionSel.
  	autoDeselect := true.
- 	self borderWidth: 1.
  	self updateList.
  	self selectionIndex: self getCurrentSelectionIndex.
  	self initForKeystrokes!

Item was added:
+ ----- Method: PluggableListMorph>>setDefaultParameters (in category 'initialization') -----
+ setDefaultParameters
+ 
+ 	super setDefaultParameters.
+ 	
+ 	self
+ 		font: (self userInterfaceTheme font ifNil: [TextStyle defaultFont]);
+ 		textColor: (self userInterfaceTheme textColor ifNil: [Color black]).
+ 		
+ 	self setListParameters.!

Item was added:
+ ----- Method: PluggableListMorph>>setListParameters (in category 'initialization') -----
+ setListParameters
+ 
+ 	self listMorph
+ 		selectionColor: (self userInterfaceTheme selectionColor ifNil: [Color r: 0.72 g: 0.72 b: 0.9]);
+ 		multiSelectionColor: (self userInterfaceTheme multiSelectionColor ifNil: [(Color r: 0.72 g: 0.72 b: 0.9) lighter]);
+ 		setProperty: #selectionTextColor
+ 			toValue: (self userInterfaceTheme selectionTextColor ifNil: [Color black]);
+ 		filterColor: (self userInterfaceTheme filterColor ifNil: [Color yellow paler]);
+ 		setProperty: #filterTextColor
+ 			toValue: (self userInterfaceTheme filterTextColor ifNil: [Color black]);
+ 		
+ 		setProperty: #preSelectionColor
+ 			toValue: ((self userInterfaceTheme preSelectionModifier ifNil: [ [:c | Color gray: 0.9] ]) value: self listMorph selectionColor asColor);
+ 		setProperty: #hoverColor
+ 			toValue: ((self userInterfaceTheme hoverSelectionModifier ifNil: [ [:c | c darker alpha: 0.3] ]) value: self listMorph selectionColor asColor)!

Item was changed:
  ----- Method: PluggableTextMorph class>>adornmentWithColor: (in category 'frame adornments') -----
  adornmentWithColor: aColor
  	"Create and return a frame adornment with the given color"
  
  	| size box form fillStyle |
  	^self adornmentCache at: aColor ifAbsentPut:[
+ 		size := 20. 
- 		size := 25. 
  		box := 0 at 0 extent: size asPoint.
  		form := Form extent: size at size depth: 32.
+ 		fillStyle := MenuMorph gradientMenu ifFalse: [SolidFillStyle color: aColor] ifTrue: [
+ 			(GradientFillStyle ramp: {
+ 				0.0->(aColor alpha: 0.01).
+ 				0.8->aColor.
+ 				1.0->aColor})
+ 				origin: box topRight - (size at 0);
+ 				direction: (size @ size negated) // 4;
+ 				radial: false].
- 		fillStyle := (GradientFillStyle ramp: {
- 			0.0->(Color white alpha: 0.01).
- 			0.8->aColor.
- 			1.0->aColor})
- 			origin: box topRight - (size at 0);
- 			direction: (size @ size negated) // 4;
- 			radial: false.
  		form getCanvas drawPolygon:  {
  			box topRight. 
  			box topRight + (0 at size). 
  			box topRight - (size at 0)
  		} fillStyle: fillStyle.
  		form].
  !

Item was added:
+ ----- Method: PluggableTextMorph class>>themeProperties (in category 'preferences') -----
+ themeProperties
+ 
+ 	^ super themeProperties, {
+ 		{ #font. 'Fonts'. 'Font for text if not styled.' }.
+ 		{ #textColor. 'Colors'. 'Color for text if not styled.' }.		
+ 		{ #caretColor. 'Colors'. 'The color of the text cursor.' }.
+ 		{ #selectionColor. 'Colors'. 'The color of the text selection.' }.
+ 		{ #unfocusedSelectionModifier. 'Colors'. 'How to derive the text selection color if not focused.' }.
+ 		
+ 		{ #adornmentReadOnly. 'Color'. 'How to indicate read-only contents.' }.
+ 		{ #adornmentRefuse. 'Color'. 'How to indicate that the model refuses to accept.' }.
+ 		{ #adornmentConflict. 'Color'. 'How to indicate that there are editing conflicts.' }.
+ 		{ #adornmentDiff. 'Color'. 'How to indicate that the model wants diff feedback.' }.
+ 		{ #adornmentNormalEdit. 'Color'. 'How to indicate that there are unaccepted edits.' }.
+ 		{ #adornmentDiffEdit. 'Color'. 'How to indicate that there are unaccepted edits in a diff view.' }.
+ 		
+ 		{ #wrapBorderColorModifier. 'Color'. 'How to indicate a specific wrap border.' }.
+ 	}!

Item was added:
+ ----- Method: PluggableTextMorph>>adoptPaneColor: (in category 'accessing') -----
+ adoptPaneColor: aColor
+ 
+ 	super adoptPaneColor: aColor.
+ 	
+ 	self wrapBorderColor: ((self userInterfaceTheme wrapBorderColorModifier ifNil: [ [:c | c muchLighter alpha: 0.3] ])
+ 								value: self borderColor).!

Item was added:
+ ----- Method: PluggableTextMorph>>applyUserInterfaceTheme (in category 'updating') -----
+ applyUserInterfaceTheme
+ 
+ 	super applyUserInterfaceTheme.
+ 	self textMorph releaseParagraph; paragraph.!

Item was changed:
  ----- Method: PluggableTextMorph>>drawFrameAdornmentsOn: (in category 'drawing') -----
  drawFrameAdornmentsOn: aCanvas 
  	"Include a thin red inset border for unaccepted edits, or, if the unaccepted edits are known to conflict with a change made somewhere else to the same method (typically), put a thick red frame"
  
  	self wantsFrameAdornments ifFalse: [^ self].
  	
+ 	self readOnly ifTrue: [^ self drawFrameAdornment: (self valueOfProperty: #adornmentReadOnly ifAbsent: [Color black]) on: aCanvas].
- 	self readOnly ifTrue: [^ self drawFrameAdornment: Color black on: aCanvas].
  	
  	(model notNil and: [model refusesToAcceptCode])
  		ifTrue: [
  			"Put up feedback showing that code cannot be submitted in this state"
+ 			^ self drawFrameAdornment: (self valueOfProperty: #adornmentRefuse ifAbsent: [Color tan]) on: aCanvas].
- 			^ self drawFrameAdornment: Color tan on: aCanvas].
  	
  	self hasEditingConflicts
+ 		ifTrue: [^ self drawFrameAdornment: (self valueOfProperty: #adornmentConflict ifAbsent: [Color red]) on: aCanvas].
- 		ifTrue: [^ self drawFrameAdornment: Color red on: aCanvas].
  		 
  	self hasUnacceptedEdits ifTrue: [
  		model wantsDiffFeedback
+ 			ifTrue: [self drawFrameAdornment: (self valueOfProperty: #adornmentDiffEdit ifAbsent: [Color yellow]) on: aCanvas]
+ 			ifFalse: [self drawFrameAdornment: (self valueOfProperty: #adornmentNormalEdit ifAbsent: [Color orange]) on: aCanvas].
- 			ifTrue: [self drawFrameAdornment: Color yellow on: aCanvas]
- 			ifFalse: [self drawFrameAdornment: Color orange on: aCanvas].
  		^ self].
  
  	model wantsDiffFeedback
+ 		ifTrue: [self drawFrameAdornment: (self valueOfProperty: #adornmentDiff ifAbsent: [Color green]) on: aCanvas].!
- 		ifTrue: [self drawFrameAdornment: Color green on: aCanvas].!

Item was changed:
  ----- Method: PluggableTextMorph>>drawWrapBorderOn: (in category 'drawing') -----
  drawWrapBorderOn: aCanvas
  
  	| offset rect |
  	self wantsWrapBorder ifFalse: [^ self].
  	textMorph ifNil: [^ self].
  	
  	offset := textMorph margins isRectangle
  		ifTrue: [textMorph margins left]
  		ifFalse: [textMorph margins isPoint
  			ifTrue: [textMorph margins x]
  			ifFalse: [textMorph margins]].
  	offset := offset + ((textMorph textStyle defaultFont widthOf: $x) * self class visualWrapBorderLimit).
  	offset > self width ifTrue: [^ self].
  	
  	rect := scroller topLeft + (offset @ 0) corner: scroller bottomRight.
  
  	aCanvas
  		fillRectangle: rect
+ 		color: self wrapBorderColor.
- 		color: (self borderStyle color muchLighter alpha: 0.3).
  	aCanvas
  		line: rect topLeft
  		to: rect bottomLeft
  		width: self borderStyle width
+ 		color: (self wrapBorderColor muchDarker alpha: 0.5).!
- 		color: (self borderStyle color alpha: 0.5).!

Item was changed:
  ----- Method: PluggableTextMorph>>initialize (in category 'initialization') -----
  initialize
+ 
+ 	self initializeTextMorph.
- 	"initialize the state of the receiver"
  	super initialize.
+ 
  	hasUnacceptedEdits := false.
  	hasEditingConflicts := false.
  	askBeforeDiscardingEdits := true.
  
+ 	self minimumWidth: (TextStyle defaultFont widthOf: $m) * 10.
+ 		
+ 	scroller addMorph: textMorph.
+ 	
+ 	"Reset minExtent because only now we can anser #isAutoFit correctly."
+ 	self minimumExtent: 0 at 0; updateMinimumExtent.!
- 	self minimumWidth: (TextStyle defaultFont widthOf: $m) * 10.!

Item was added:
+ ----- Method: PluggableTextMorph>>initializeTextMorph (in category 'initialization') -----
+ initializeTextMorph
+ 
+ 	textMorph := self textMorphClass new
+ 		margins: (3 at 0 corner: 0 at 0);
+ 		setEditView: self;
+ 		autoFit: true;
+ 		setProperty: #indicateKeyboardFocus toValue: #never;
+ 		yourself.!

Item was changed:
  ----- Method: PluggableTextMorph>>on:text:accept:readSelection:menu: (in category 'initialization') -----
  on: anObject text: getTextSel accept: setTextSel readSelection: getSelectionSel menu: getMenuSel
  
  	self model: anObject.
  	getTextSelector := getTextSel.
  	setTextSelector := setTextSel.
  	getSelectionSelector := getSelectionSel.
  	getMenuSelector := getMenuSel.
- 	self borderWidth: 1.
  	self setText: self getText.
  	self setSelection: self getSelection.!

Item was added:
+ ----- Method: PluggableTextMorph>>setDefaultParameters (in category 'initialization') -----
+ setDefaultParameters
+ 
+ 	super setDefaultParameters.
+ 	
+ 	self
+ 		font: (self userInterfaceTheme font ifNil: [TextStyle defaultFont]);
+ 		setTextColor: (self userInterfaceTheme textColor ifNil: [Color black]).
+ 	
+ 	self wrapBorderColor: ((self userInterfaceTheme wrapBorderColorModifier ifNil: [ [:c | c muchLighter alpha: 0.3] ])
+ 								value: self borderColor).
+ 	
+ 	self
+ 		setProperty: #adornmentReadOnly
+ 		toValue: (self userInterfaceTheme adornmentReadOnly ifNil: [Color black]);
+ 		setProperty: #adornmentRefuse
+ 		toValue: (self userInterfaceTheme adornmentRefuse ifNil: [Color tan]);
+ 		setProperty: #adornmentConflict
+ 		toValue: (self userInterfaceTheme adornmentConflict ifNil: [Color red]);
+ 		setProperty: #adornmentDiff
+ 		toValue: (self userInterfaceTheme adornmentDiff ifNil: [Color green]);
+ 		setProperty: #adornmentNormalEdit
+ 		toValue: (self userInterfaceTheme adornmentNormalEdit ifNil: [Color orange]);
+ 		setProperty: #adornmentDiffEdit
+ 		toValue: (self userInterfaceTheme adornmentDiffEdit ifNil: [Color yellow]).
+ 	
+ 	textMorph
+ 		setProperty: #caretColor
+ 		toValue: (self userInterfaceTheme caretColor ifNil: [Color red]);
+ 		setProperty: #selectionColor
+ 		toValue: (self userInterfaceTheme selectionColor ifNil: [TranslucentColor r: 0.0 g: 0.0 b: 0.8 alpha: 0.2]);
+ 		setProperty: #unfocusedSelectionColor
+ 		toValue: ((self userInterfaceTheme unfocusedSelectionModifier ifNil: [ [:c | Color gray: 0.9] ])
+ 			value: textMorph selectionColor).!

Item was changed:
  ----- Method: PluggableTextMorph>>setText: (in category 'model access') -----
  setText: aText
+ 
+ 	textMorph newContents: aText.
- 	textMorph
- 		ifNil: [textMorph := self textMorphClass new
- 					contents: aText
- 					wrappedTo: self innerBounds width.
- 				textMorph
- 					margins: (3 at 0 corner: 0 at 0);
- 					setEditView: self;
- 					autoFit: true;
- 					setProperty: #indicateKeyboardFocus toValue: #never.
- 				scroller addMorph: textMorph.
- 				"Reset minExtent because only now we can anser #isAutoFit correctly."
- 				self minimumExtent: 0 at 0; updateMinimumExtent]
- 		ifNotNil: [textMorph newContents: aText].
  	self hasUnacceptedEdits: false.
+ 	self setScrollDeltas.	
- 	self setScrollDeltas.
- 	
  	self changed. "Redraw the whole area. For example, it might not be necssary to draw the help text anymore."!

Item was added:
+ ----- Method: PluggableTextMorph>>wrapBorderColor (in category 'accessing') -----
+ wrapBorderColor
+ 
+ 	^ self valueOfProperty: #wrapBorderColor ifAbsent: [Color gray alpha: 0.3]!

Item was added:
+ ----- Method: PluggableTextMorph>>wrapBorderColor: (in category 'accessing') -----
+ wrapBorderColor: aColor
+ 
+ 	self setProperty: #wrapBorderColor toValue: aColor.
+ 	self changed.!

Item was removed:
- ----- Method: ScrollBar class>>createArrowOfDirection:in: (in category 'images') -----
- createArrowOfDirection: aSymbol in: aRectangle 
- 	"PRIVATE - create an arrow bounded in aRectangle"
- 
- 	| arrow vertices |
- 	vertices := Preferences alternativeButtonsInScrollBars 
- 				ifTrue: [self verticesForComplexArrow: aRectangle]
- 				ifFalse: [self verticesForSimpleArrow: aRectangle].
- 	""
- 	arrow := PolygonMorph 
- 				vertices: vertices
- 				color: Color transparent
- 				borderWidth: 0
- 				borderColor: Color black.
- 	""
- 	arrow bounds: (arrow bounds insetBy: (aRectangle width / 6) rounded).
- 	""
- 	Preferences alternativeButtonsInScrollBars 
- 		ifTrue: [arrow rotationDegrees: 45].
- 	""
- 	aSymbol == #right 
- 		ifTrue: [arrow rotationDegrees: arrow rotationDegrees + 90].
- 	aSymbol == #bottom 
- 		ifTrue: [arrow rotationDegrees: arrow rotationDegrees + 180].
- 	aSymbol == #left 
- 		ifTrue: [arrow rotationDegrees: arrow rotationDegrees + 270].
- 	""
- 	^arrow!

Item was changed:
  ----- Method: ScrollBar class>>createArrowOfDirection:size:color: (in category 'images') -----
+ createArrowOfDirection: aSymbolDirection size: size color: aColor 
+ 	"PRIVATE - create an arrow with aSymbolDirectionDirection, finalSizeInteger and aColor  
- createArrowOfDirection: aSymbolDirection size: finalSizeInteger color: aColor 
- 	"PRIVATE - create an arrow with aSymbolDirectionDirection,  
- 	finalSizeInteger and aColor  
- 	 
  	aSymbolDirectionDirection = #top, #bottom. #left or #right  
+ 	 ScrollBar initializeImagesCache.
+ 	Try with: 
+ 	(ScrollBar createArrowOfDirection: #right size: 14 color: Color lightGreen) asMorph openInHand."
+ 	
+ 	| form canvas vertices margin |
+ 	form := Form extent: size asPoint depth: 32.
+ 	canvas := form getCanvas.
+ 	margin := size < 14 ifTrue: [2] ifFalse: [3].
+ 	vertices := {
+ 		size // 2 @ margin.
+ 		size asPoint - margin asPoint.
+ 		margin @ (size-margin).
+ 		size // 2 @ margin}.
+ 	
+ 	"Preferences gradientScrollBars
+ 		ifTrue: [
+ 			fillStyle := GradientFillStyle ramp: {
+ 					0.0 -> (aColor adjustBrightness: 0.5).
+ 					0.1-> (aColor adjustBrightness: 0.05).
+ 					0.6 -> (aColor darker)}.
+ 			fillStyle origin: size // 2 @ margin.
+ 			fillStyle direction: 0 @ size]
+ 		ifFalse: [
+ 			fillStyle := SolidFillStyle color: aColor]. "
+ 	
+ 	canvas
+ 		drawPolygon: vertices
+ 		fillStyle: (SolidFillStyle color: aColor).
+ 	
+ 	^ (form rotateBy: (aSymbolDirection caseOf: {
+ 		[#top] -> [0].
+ 		[#bottom] -> [180].
+ 		[#left] -> [270].
+ 		[#right] -> [90]})) clippedToSize: size asPoint!
- 	 
- 	Try with:  
- 	(ScrollBar createArrowOfDirection: #top size: 32 color: Color  
- 	lightGreen) asMorph openInHand.  
- 	"
- 	| resizeFactor outerBox arrow resizedForm gradient |
- 	resizeFactor := 4.
- 	outerBox := RectangleMorph new
- 		extent: finalSizeInteger asPoint * resizeFactor;
- 		borderWidth: 0;
- 		color: aColor.
- 
- 	self gradientScrollBar ifTrue: [
- 		gradient := GradientFillStyle ramp: {
- 				0 -> (Color gray: 0.95).
- 				0.49 -> (Color gray: 0.9).
- 				0.5 -> (Color gray: 0.87).
- 				1 -> (Color gray: 0.93).
- 		}.
- 		gradient origin: outerBox topLeft.
- 		(aSymbolDirection == #left or:[aSymbolDirection == #right])
- 			ifTrue:[gradient direction: 0@ outerBox height]
- 			ifFalse:[gradient direction: outerBox width @ 0].
- 		outerBox fillStyle: gradient].
- 	outerBox borderStyle: (BorderStyle width: 4 color: Color lightGray).
- 
- 	""
- 	arrow := self createArrowOfDirection: aSymbolDirection in: (outerBox bounds expandBy: -4).
- 	self updateScrollBarButtonAspect: arrow color: aColor muchDarker.
- 	outerBox addMorphCentered: arrow.
- 	""
- 	resizedForm := outerBox imageForm
- 				magnify: outerBox imageForm boundingBox
- 				by: 1 / resizeFactor
- 				smoothing: 4.
- 	""
- 	^ (resizedForm replaceColor: aColor withColor: Color transparent)
- 		trimBordersOfColor: Color transparent!

Item was removed:
- ----- Method: ScrollBar class>>createBoxIn: (in category 'images') -----
- createBoxIn: aRectangle 
- 	"PRIVATE - create an box bounded in aRectangle"
- 	| box |
- 	box := RectangleMorph new.
- 	box extent: (aRectangle scaleBy: 1 / 2) extent rounded;
- 		 borderWidth: 0.
- 	""
- 	^ box!

Item was changed:
  ----- Method: ScrollBar class>>createBoxOfSize:color: (in category 'images') -----
+ createBoxOfSize: anInteger color: aColor 
+ 	"PRIVATE - create a box with anInteger and aColor  
- createBoxOfSize: finalSizeInteger color: aColor 
- 	"PRIVATE - create a box with finalSizeInteger and aColor  
  	 
  	Try with:  
+ 	(ScrollBar createBoxOfSize: 32 color: Color gray) asMorph  
- 	(ScrollBar createBoxOfSize: 32 color: Color lightGreen) asMorph  
  	openInHand.  
  	"
+ 	
+ 	| form canvas margin |
+ 	form := Form extent: anInteger asPoint depth: 32.
+ 	canvas := form getCanvas.
+ 	margin := anInteger < 14 ifTrue: [3] ifFalse: [4].
+ 
+ 	"Preferences gradientScrollBars
+ 		ifTrue: [
+ 			fillStyle := GradientFillStyle ramp: {
+ 					0.0 -> (aColor adjustBrightness: 0.5).
+ 					0.1-> (aColor adjustBrightness: 0.05).
+ 					0.6 -> (aColor darker)}.
+ 			fillStyle origin: margin asPoint.
+ 			fillStyle direction: anInteger @ 0]
+ 		ifFalse: [
+ 			fillStyle := SolidFillStyle color: aColor]. "
+ 	
+ 	canvas
+ 		fillRectangle: ((0 at 0 extent: anInteger asPoint) insetBy: margin)
+ 		fillStyle: (SolidFillStyle color: aColor).
+ 		
+ 	^ form!
- 	| resizeFactor outerBox innerBox resizedForm gradient |
- 	resizeFactor := 4.
- 	outerBox := RectangleMorph new
- 		extent: finalSizeInteger asPoint * resizeFactor;
- 		borderWidth: 0;
- 		color: aColor.
- 	self gradientScrollBar ifTrue: [
- 		gradient := GradientFillStyle ramp: {
- 				0 -> (Color gray: 0.95).
- 				0.49 -> (Color gray: 0.9).
- 				0.5 -> (Color gray: 0.87).
- 				1 -> (Color gray: 0.93).
- 		}.
- 		gradient origin: outerBox topLeft.
- 		gradient direction: outerBox width @ 0.
- 		outerBox fillStyle: gradient].
- 	outerBox borderStyle: (BorderStyle width: 4 color: Color lightGray).
- 	""
- 	innerBox := self createBoxIn: (outerBox bounds expandBy: -4).
- 	self updateScrollBarButtonAspect: innerBox color: aColor muchDarker.
- 	outerBox addMorphCentered: innerBox.
- 	""
- 	resizedForm := outerBox imageForm
- 				magnify: outerBox imageForm boundingBox
- 				by: 1 / resizeFactor
- 				smoothing: 4.
- 	""
- 	^ (resizedForm replaceColor: aColor withColor: Color transparent)
- 		trimBordersOfColor: Color transparent!

Item was changed:
  ----- Method: ScrollBar class>>roundedScrollBarLook: (in category 'preferences') -----
  roundedScrollBarLook: aBoolean
  
+ 	RoundedScrollBarLook = aBoolean ifTrue: [^ self].
+ 	RoundedScrollBarLook := aBoolean.
+ 	
+ 	ScrollBar allSubInstancesDo: [:ea | ea updateSliderCornerStyle].!
- 	RoundedScrollBarLook := aBoolean.!

Item was added:
+ ----- Method: ScrollBar class>>themeProperties (in category 'preferences') -----
+ themeProperties
+ 
+ 	^ super themeProperties, {		
+ 		{ #pagingAreaColorModifier. 'Colors'. 'How to modify the paging area color when adopting a pane color.' }.
+ 		{ #thumbColorModifier. 'Colors'. 'How to modify the thumb color when adopting a pane color.' }.
+ 		{ #borderColorModifier. 'Colors'. 'How to modify the border color when adopting a pane color.' }.
+ 	}!

Item was removed:
- ----- Method: ScrollBar class>>updateScrollBarButtonAspect:color: (in category 'coloring morphs') -----
- updateScrollBarButtonAspect: aMorph color: aColor 
- 	"update aMorph with aColor"
- 	| fill direction |
- 	aMorph isNil
- 		ifTrue: [^ self].
- 	""
- 	aMorph color: aColor.
- 	self gradientScrollBar
- 		ifFalse: [^ self].
- 	""
- 	fill := GradientFillStyle ramp: {
- 		0.0 -> aColor twiceLighter twiceLighter.
- 		1.0 -> aColor twiceDarker}.
- 	""
- 	direction := ((aMorph width min: aMorph height)
- 				+ ((aMorph width - aMorph height) abs * 0.3)) rounded.
- 	""
- 	fill origin: aMorph topLeft + (direction // 8).
- 	fill direction: direction @ direction.
- 	fill radial: true.
- 	""
- 	aMorph fillStyle: fill!

Item was removed:
- ----- Method: ScrollBar class>>updateScrollBarButtonsAspect:color: (in category 'coloring morphs') -----
- updateScrollBarButtonsAspect: aCollection color: aColor 
- 	"update aCollection of morphs with aColor"
- 	
- 	
- 	aCollection
- 		do: [:each | self updateScrollBarButtonAspect: each color: aColor]!

Item was removed:
- ----- Method: ScrollBar class>>verticesForComplexArrow: (in category 'images') -----
- verticesForComplexArrow: aRectangle 
- 	"PRIVATE - answer a collection of vertices to draw a complex arrow"
- 	| vertices aux |
- 	vertices := OrderedCollection new.
- 	""
- 	vertices add: aRectangle bottomLeft.
- 	vertices add: aRectangle topLeft.
- 	vertices add: aRectangle topRight.
- 	""
- 	aux := (aRectangle width / 3) rounded.
- 	vertices add: aRectangle topRight + (0 @ aux).
- 	vertices add: aRectangle topLeft + aux.
- 	vertices add: aRectangle bottomLeft + (aux @ 0).
- 	""
- 	^ vertices!

Item was removed:
- ----- Method: ScrollBar class>>verticesForSimpleArrow: (in category 'images') -----
- 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!

Item was changed:
+ ----- Method: ScrollBar>>adoptPaneColor: (in category 'updating') -----
- ----- Method: ScrollBar>>adoptPaneColor: (in category 'access') -----
  adoptPaneColor: aColor
  	"Adopt the given pane color"
  	aColor ifNil:[^self].
  	self sliderColor: aColor.!

Item was added:
+ ----- Method: ScrollBar>>applyUserInterfaceTheme (in category 'updating') -----
+ applyUserInterfaceTheme
+ 
+ 	super applyUserInterfaceTheme.!

Item was changed:
+ ----- Method: ScrollBar>>boundsForDownButton (in category 'geometry') -----
- ----- Method: ScrollBar>>boundsForDownButton (in category 'initialize') -----
  boundsForDownButton
  	
  	^ self innerBounds bottomRight - self buttonExtent 
  		extent: self buttonExtent!

Item was changed:
+ ----- Method: ScrollBar>>boundsForMenuButton (in category 'geometry') -----
- ----- Method: ScrollBar>>boundsForMenuButton (in category 'initialize') -----
  boundsForMenuButton
  
  	^ self innerBounds topLeft extent: self buttonExtent!

Item was changed:
+ ----- Method: ScrollBar>>boundsForUpButton (in category 'geometry') -----
- ----- Method: ScrollBar>>boundsForUpButton (in category 'initialize') -----
  boundsForUpButton
  
  	^ (self menuButton visible
  		ifFalse: [self innerBounds topLeft]
  		ifTrue: [self orientation == #horizontal
  			ifTrue: [self menuButton bounds topRight - (1 at 0)]
  			ifFalse: [self menuButton bounds bottomLeft - (0 at 1)]])
  		extent: self buttonExtent!

Item was removed:
- ----- Method: ScrollBar>>defaultBorderWidth (in category 'initialize') -----
- defaultBorderWidth
- 	^ 0!

Item was added:
+ ----- Method: ScrollBar>>downButton (in category 'accessing') -----
+ downButton
+ 	^ downButton!

Item was changed:
+ ----- Method: ScrollBar>>downImage (in category 'images') -----
- ----- Method: ScrollBar>>downImage (in category 'initialize') -----
  downImage
  	"answer a form to be used in the down button"
  	^ self class
  		arrowOfDirection: (self orientation == #horizontal
  				ifTrue: [#right]
  				ifFalse: [#bottom])
  		size: (self buttonExtent x min: self buttonExtent y)
+ 		color: self imageColor!
- 		color: self thumbColor!

Item was changed:
  ----- Method: ScrollBar>>extent: (in category 'geometry') -----
  extent: p 
+ 
+ 	(bounds extent closeTo: p) ifTrue: [^ self].
+ 	
  	p x > p y
  		ifTrue: [super
  				extent: (p max: 8 @ 4)]
  		ifFalse: [super
  				extent: (p max: 4 @ 8)].
+ 			
+ 	self updateSliderColor.
  	!

Item was changed:
  ----- Method: ScrollBar>>finishedScrolling (in category 'scrolling') -----
  finishedScrolling
  	self stopStepping.
  	self scrollBarAction: nil.
- 	self class roundedScrollBarLook ifTrue:[
- 		upButton borderStyle: (BorderStyle complexRaised width: upButton borderWidth).
- 		downButton borderStyle: (BorderStyle complexRaised width: downButton borderWidth).
- 	] ifFalse:[
- 		downButton borderStyle: BorderStyle thinGray.
- 		upButton borderStyle: BorderStyle thinGray.
- 	].
- 
  !

Item was added:
+ ----- Method: ScrollBar>>imageColor (in category 'accessing') -----
+ imageColor
+ 
+ 	^ slider ifNil: [Color black] ifNotNil: [:s | s borderColor]!

Item was changed:
  ----- Method: ScrollBar>>initialize (in category 'initialize') -----
  initialize
  
  	interval := 0.2.
- 	
- 	super initialize.
- 
  	scrollDelta := 0.02.
  	pageDelta := 0.2.
+ 	
+ 	super initialize.!
- 
- 	self color: Color transparent.
- 
- 	self class roundedScrollBarLook
- 		ifFalse: [self borderWidth: 0]
- 		ifTrue:[self borderStyle: ((BorderStyle complexFramed width: 2) "baseColor: Color gray")].!

Item was changed:
  ----- Method: ScrollBar>>initializeDownButton (in category 'initialize') -----
  initializeDownButton
  	"initialize the receiver's downButton"
  
+ 	downButton := RectangleMorph newBounds: self boundsForDownButton.
- 	downButton := RectangleMorph 
- 				newBounds: self boundsForDownButton
- 				color: self thumbColor.
  	downButton 
  		on: #mouseDown
  		send: #scrollDownInit
  		to: self.
  	downButton 
  		on: #mouseUp
  		send: #finishedScrolling
  		to: self.
+ 	self updateDownButtonImage.	
+ 	self addMorphFront: downButton.
- 	self updateDownButtonImage.
- 	self class roundedScrollBarLook 
- 		ifTrue: 
- 			[downButton color: Color veryLightGray.
- 			downButton borderStyle: (BorderStyle complexRaised width: 3)]
- 		ifFalse: [downButton setBorderWidth: 1 borderColor: Color lightGray].
- 	
- 	self addMorph: downButton.
  	downButton visible: self class scrollBarsWithoutArrowButtons not.!

Item was removed:
- ----- Method: ScrollBar>>initializeEmbedded: (in category 'initialize') -----
- initializeEmbedded: aBool
- 	"aBool == true => inboard scrollbar
- 	aBool == false => flop-out scrollbar"
- 	self class roundedScrollBarLook ifFalse:[^self].
- 	aBool ifTrue:[
- 		self borderStyle: (BorderStyle inset width: 2).
- 		self cornerStyle: #square.
- 	] ifFalse:[
- 		self borderStyle: (BorderStyle width: 1 color: Color black).
- 		self cornerStyle: #rounded.
- 	].
- 	self removeAllMorphs.
- 	self initializeSlider.!

Item was changed:
  ----- Method: ScrollBar>>initializeMenuButton (in category 'initialize') -----
  initializeMenuButton
  "initialize the receiver's menuButton"
  	"Preferences disable: #scrollBarsWithoutMenuButton"
  	"Preferences enable: #scrollBarsWithoutMenuButton"
+ 	menuButton := RectangleMorph newBounds: self boundsForMenuButton.
- 	menuButton := RectangleMorph
- 					newBounds: self boundsForMenuButton
- 					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 
  	addMorphCentered: (RectangleMorph 
  	newBounds: (0 @ 0 extent: 4 @ 2) 
  	color: Color black)."
  	self updateMenuButtonImage.
+ 	self addMorphFront: menuButton.
- 	self class roundedScrollBarLook
- 		ifTrue: [menuButton color: Color veryLightGray.
- 			menuButton
- 				borderStyle: (BorderStyle complexRaised width: 3)]
- 		ifFalse: [menuButton setBorderWidth: 1 borderColor: Color lightGray].
- 
- 	self addMorph: menuButton.
  	menuButton visible: (self class scrollBarsWithoutMenuButton or: [self orientation == #horizontal]) not.!

Item was changed:
  ----- Method: ScrollBar>>initializePagingArea (in category 'initialize') -----
  initializePagingArea
  	
  	"Appearance"
+ 	pagingArea := RectangleMorph newBounds: self totalSliderArea.
- 	pagingArea := RectangleMorph
- 				newBounds: self totalSliderArea
- 				color: (self class roundedScrollBarLook
- 					ifTrue: [Color gray: 0.9]
- 					ifFalse: [Color r: 0.6 g: 0.6 b: 0.8]).
- 	self class gradientScrollBar
- 		ifTrue: [pagingArea setBorderWidth: 1 borderColor: (Color lightGray alpha: 0.5)]
- 		ifFalse: [pagingArea borderWidth: 0].
  	self addMorphBack: pagingArea.
  			
  	"Interactions"
  	pagingArea
  		on: #mouseDown
  		send: #scrollPageInit:
  		to: self.
  	pagingArea
  		on: #mouseUp
  		send: #finishedScrolling
  		to: self.
  	
  !

Item was changed:
  ----- Method: ScrollBar>>initializeSlider (in category 'initialize') -----
  initializeSlider
  
  	self
  		initializeMenuButton;
  		initializeUpButton;
  		initializeDownButton;
  		initializePagingArea.
  		
  	super initializeSlider.
- 	self expandSlider.
  	
+ 	self expandSlider.!
- 	self class roundedScrollBarLook ifTrue: [
- 		slider cornerStyle: #rounded.
- 		sliderShadow cornerStyle: #rounded.
- 		
- 		Preferences menuAppearance3d ifTrue: [	
- 			slider borderStyle: (BorderStyle complexRaised width: 1)]].
- 	
- 	self sliderColor: self sliderColor.!

Item was changed:
  ----- Method: ScrollBar>>initializeUpButton (in category 'initialize') -----
  initializeUpButton
  "initialize the receiver's upButton"
  	upButton := RectangleMorph newBounds: self boundsForUpButton.
- 	upButton color: self thumbColor.
  	upButton
  		on: #mouseDown
  		send: #scrollUpInit
  		to: self.
  	upButton
  		on: #mouseUp
  		send: #finishedScrolling
  		to: self.
  	self updateUpButtonImage.
- 	self class roundedScrollBarLook
- 		ifTrue: [upButton color: Color veryLightGray.
- 			upButton
- 				borderStyle: (BorderStyle complexRaised width: 3)]
- 		ifFalse: [upButton setBorderWidth: 1 borderColor: Color lightGray].
- 	
  	self addMorph: upButton.	
  	upButton visible: self class scrollBarsWithoutArrowButtons not.!

Item was changed:
+ ----- Method: ScrollBar>>interval (in category 'accessing') -----
- ----- Method: ScrollBar>>interval (in category 'access') -----
  interval
  	
  	^ interval ifNil: [interval := 0.2]!

Item was changed:
+ ----- Method: ScrollBar>>interval: (in category 'accessing') -----
- ----- Method: ScrollBar>>interval: (in category 'access') -----
  interval: d
  	"Supply an optional floating fraction so slider can expand to indicate range"
  	interval := d min: 1.0.
  	self expandSlider.
  	self computeSlider.!

Item was changed:
+ ----- Method: ScrollBar>>menuButton (in category 'accessing') -----
- ----- Method: ScrollBar>>menuButton (in category 'access') -----
  menuButton
  
  	^ menuButton ifNil: [menuButton := RectangleMorph new]!

Item was changed:
+ ----- Method: ScrollBar>>menuButtonMouseDown: (in category 'event handling') -----
- ----- Method: ScrollBar>>menuButtonMouseDown: (in category 'other events') -----
  menuButtonMouseDown: event
  	event hand showTemporaryCursor: nil.
  	self use: menuSelector orMakeModelSelectorFor: 'MenuButtonPressed:'
  		in: [:sel | menuSelector := sel.  model perform: sel with: event]!

Item was changed:
+ ----- Method: ScrollBar>>menuImage (in category 'images') -----
- ----- Method: ScrollBar>>menuImage (in category 'initialize') -----
  menuImage
  	"answer a form to be used in the menu button"
  	^ self class
  		boxOfSize: (self buttonExtent x min: self buttonExtent y)
+ 		color: self imageColor!
- 		color: self thumbColor!

Item was changed:
+ ----- Method: ScrollBar>>menuSelector (in category 'accessing') -----
- ----- Method: ScrollBar>>menuSelector (in category 'access') -----
  menuSelector
  	^ menuSelector!

Item was changed:
+ ----- Method: ScrollBar>>menuSelector: (in category 'accessing') -----
- ----- Method: ScrollBar>>menuSelector: (in category 'access') -----
  menuSelector: aSymbol
  	menuSelector := aSymbol.!

Item was changed:
+ ----- Method: ScrollBar>>mouseDownInSlider: (in category 'event handling') -----
- ----- Method: ScrollBar>>mouseDownInSlider: (in category 'other events') -----
  mouseDownInSlider: event
+ 
+ 	"make the entire scrollable area visible if a full scrollbar is clicked on"
+ 	self interval = self maximumValue ifTrue: [
- 	self interval = self maximumValue ifTrue:
- 		["make the entire scrollable area visible if a full scrollbar is clicked on"
  		self setValue: 0.
+ 		self model hideOrShowScrollBars].
+ 	
+ 	self showSliderShadow.!
- 		self model hideOrShowScrollBars.].
- "	super mouseDownInSlider: event"
- !

Item was changed:
+ ----- Method: ScrollBar>>pagingArea (in category 'accessing') -----
- ----- Method: ScrollBar>>pagingArea (in category 'access') -----
  pagingArea
  	^pagingArea!

Item was changed:
+ ----- Method: ScrollBar>>scrollDelta (in category 'accessing') -----
- ----- Method: ScrollBar>>scrollDelta (in category 'access') -----
  scrollDelta
  	^ scrollDelta!

Item was changed:
+ ----- Method: ScrollBar>>scrollDelta:pageDelta: (in category 'accessing') -----
- ----- Method: ScrollBar>>scrollDelta:pageDelta: (in category 'access') -----
  scrollDelta: d1 pageDelta: d2
  	"Supply optional increments for better scrolling of, eg, text"
  	scrollDelta := d1.
  	pageDelta := d2.!

Item was removed:
- ----- Method: ScrollBar>>scrollDown (in category 'scrolling') -----
- scrollDown
- 	self flag: #obsolete.
- 	downButton eventHandler: nil.
- 	downButton on: #mouseDown send: #scrollDownInit to: self.
- 	downButton on: #mouseUp send: #finishedScrolling to: self.
- 	^self scrollDownInit!

Item was changed:
  ----- Method: ScrollBar>>scrollDownInit (in category 'scrolling') -----
  scrollDownInit
- 	downButton borderInset.
  	self resetTimer.
  	self scrollBarAction: #doScrollDown.
  	self startStepping.!

Item was removed:
- ----- Method: ScrollBar>>scrollUp (in category 'scrolling') -----
- scrollUp
- 	self flag: #obsolete.
- 	upButton eventHandler: nil.
- 	upButton on: #mouseDown send: #scrollUpInit to: self.
- 	upButton on: #mouseUp send: #finishedScrolling to: self.
- 	^self scrollUpInit!

Item was changed:
  ----- Method: ScrollBar>>scrollUpInit (in category 'scrolling') -----
  scrollUpInit
- 	upButton borderInset.
  	self resetTimer.
  	self scrollBarAction: #doScrollUp.
  	self startStepping.!

Item was added:
+ ----- Method: ScrollBar>>setDefaultParameters (in category 'initialize') -----
+ setDefaultParameters
+ 
+ 	"Compared to generic sliders, I am not my own paging area. Thus, make me transparent."
+ 	self
+ 		color: Color transparent;
+ 		borderWidth: 0.
+ 
+ 	pagingArea
+ 		color: (self userInterfaceTheme color ifNil: [Color veryVeryLightGray darker alpha: 0.35]);
+ 		borderWidth: 0. "no border for the paging area"
+ 
+ 	slider
+ 		color: (self userInterfaceTheme thumbColor ifNil: [Color veryVeryLightGray]);
+ 		borderColor: (self userInterfaceTheme thumbBorderColor ifNil: [Color gray: 0.6]);
+ 		borderWidth: (self userInterfaceTheme thumbBorderWidth ifNil: [1]).
+ 	
+ 	self updateSliderCornerStyle.
+ 	
+ 	sliderShadow
+ 		cornerStyle: slider cornerStyle;
+ 		borderWidth: slider borderWidth;
+ 		borderColor: Color transparent.
+ 	
+ 	sliderColor := slider color.
+ 	self updateSliderColor: slider color.!

Item was changed:
+ ----- Method: ScrollBar>>sliderColor: (in category 'accessing') -----
- ----- Method: ScrollBar>>sliderColor: (in category 'access') -----
  sliderColor: aColor 
  	"Change the color of the scrollbar to go with aColor."
+ 
- 	| buttonColor |
  	super sliderColor: aColor.
+ 	self updateSliderColor: aColor.!
- 	self updateSliderColor: aColor.
- 	buttonColor := self thumbColor.
- 	
- 	self menuButton color: aColor.
- 	upButton color: aColor.
- 	downButton color: aColor.
- 	
- 	self class updateScrollBarButtonsAspect: {self menuButton. upButton. downButton} color: aColor.
- 	
- 	self flag: #performance. "mt: This is slow..."
- 	self updateMenuButtonImage.
- 	self updateUpButtonImage.
- 	self updateDownButtonImage.!

Item was removed:
- ----- Method: ScrollBar>>sliderShadowColor (in category 'access') -----
- sliderShadowColor
- 	^ self class roundedScrollBarLook
- 		ifTrue: [self sliderColor darker]
- 		ifFalse: [super sliderShadowColor]
- !

Item was removed:
- ----- Method: ScrollBar>>thumbColor (in category 'access') -----
- 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.5 with: (Color gray: 0.95)
- !

Item was changed:
+ ----- Method: ScrollBar>>upArrow8Bit (in category 'images') -----
- ----- Method: ScrollBar>>upArrow8Bit (in category 'initialize') -----
  upArrow8Bit
  
  	"convert to 8-bit and convert white to transparent to avoid gratuitous conversion every time we put one in an ImageMorph"
  
  	^UpArrow8Bit ifNil: [
  		UpArrow8Bit := (ColorForm mappingWhiteToTransparentFrom: UpArrow) asFormOfDepth: 8
  	]!

Item was added:
+ ----- Method: ScrollBar>>upButton (in category 'accessing') -----
+ upButton
+ 	^ upButton!

Item was changed:
+ ----- Method: ScrollBar>>upImage (in category 'images') -----
- ----- Method: ScrollBar>>upImage (in category 'initialize') -----
  upImage
  	"answer a form to be used in the up button"
  	^ self class
  		arrowOfDirection: (self orientation == #horizontal
  				ifTrue: [#left]
  				ifFalse: [#top])
  		size: (self buttonExtent x min: self buttonExtent y)
+ 		color: self imageColor!
- 		color: self thumbColor!

Item was changed:
+ ----- Method: ScrollBar>>updateDownButtonImage (in category 'updating') -----
- ----- Method: ScrollBar>>updateDownButtonImage (in category 'initialize') -----
  updateDownButtonImage
  	"update the receiver's downButton.  put a new image inside"
  	downButton removeAllMorphs.
+ 	downButton addMorphCentered: (ImageMorph new image: self downImage).!
- 	downButton
- 		addMorphCentered: (ImageMorph new image: self downImage)!

Item was changed:
+ ----- Method: ScrollBar>>updateMenuButtonImage (in category 'updating') -----
- ----- Method: ScrollBar>>updateMenuButtonImage (in category 'initialize') -----
  updateMenuButtonImage
  	"update the receiver's menuButton. put a new image inside"
  
  	self menuButton removeAllMorphs.
  	self menuButton addMorphCentered: (ImageMorph new image: self menuImage).!

Item was changed:
+ ----- Method: ScrollBar>>updateSlider (in category 'updating') -----
- ----- Method: ScrollBar>>updateSlider (in category 'initialize') -----
  updateSlider
  
  	| imagesNeedUpdate |
  	imagesNeedUpdate := upButton width ~= (self orientation == #horizontal ifTrue: [self height] ifFalse: [self width]).
  	
  	self menuButton
  		visible: (self orientation == #horizontal or: [self class scrollBarsWithoutMenuButton]) not;
  		bounds: self boundsForMenuButton.
  	upButton
  		visible: self class scrollBarsWithoutArrowButtons not;
  		bounds: self boundsForUpButton.
  	downButton
  		visible: self class scrollBarsWithoutArrowButtons not;
  		bounds: self boundsForDownButton.
  
  	super updateSlider.
  
  	pagingArea bounds: self totalSliderArea.
  	self expandSlider.
  
  	imagesNeedUpdate ifTrue: [
  		self menuButton visible ifTrue: [self updateMenuButtonImage].
  		upButton visible ifTrue: [self updateUpButtonImage].
  		downButton visible ifTrue: [self updateDownButtonImage]].!

Item was changed:
+ ----- Method: ScrollBar>>updateSliderColor (in category 'updating') -----
- ----- Method: ScrollBar>>updateSliderColor (in category 'access') -----
  updateSliderColor
  
  	self updateSliderColor: self sliderColor.!

Item was changed:
+ ----- Method: ScrollBar>>updateSliderColor: (in category 'updating') -----
- ----- Method: ScrollBar>>updateSliderColor: (in category 'access') -----
  updateSliderColor: aColor
  
+ 	self class gradientScrollBar
+ 		ifFalse: [self updateSliderColorSolid: aColor]
+ 		ifTrue: [self updateSliderColorGradient: aColor].
+ 		
+ 	self flag: #performance. "mt: This is slow..."
+ 	self updateMenuButtonImage.
+ 	self updateUpButtonImage.
+ 	self updateDownButtonImage.!
- 	| gradient |
- 	self class gradientScrollBar ifFalse: [
- 		slider
- 			borderColor: (aColor adjustBrightness: -0.3);
- 			color: aColor.
- 		pagingArea
- 			borderColor: (aColor muchDarker alpha: pagingArea borderStyle color alpha);
- 			color: (aColor darker alpha: 0.35).
- 		^ self].
- 
- 	slider borderStyle: (BorderStyle width: 1 color: Color lightGray).	
- 
- 	"Fill the slider."
- 	gradient := GradientFillStyle ramp: {
- 			0 -> (Color gray: 0.95).
- 			0.49 -> (Color gray: 0.9).
- 			0.5 -> (Color gray: 0.87).
- 			1 -> (Color gray: 0.93).
- 	}.
- 	gradient origin: slider topLeft.
- 	gradient direction: (self orientation == #horizontal
- 		ifTrue:[0 at slider height]
- 		ifFalse:[slider width at 0]).
- 	slider fillStyle: gradient.
- 	
- 	"Fill the paging area."
- 	gradient := GradientFillStyle ramp: {
- 		0 -> (Color gray: 0.65).
- 		0.6 -> (Color gray: 0.82).
- 		1 -> (Color gray: 0.88).
- 	}.
- 	gradient origin: self topLeft.
- 	gradient direction: (self orientation == #horizontal
- 		ifTrue:[0 at self height]
- 		ifFalse:[self width at 0]).
- 	pagingArea fillStyle: gradient.!

Item was added:
+ ----- Method: ScrollBar>>updateSliderColorGradient: (in category 'updating') -----
+ updateSliderColorGradient: aColor
+ 
+ 	| gradient cc |
+ 	pagingArea color: ((self userInterfaceTheme pagingAreaColorModifier
+ 		ifNil: [ [:c | c darker alpha: 0.35] ]) value: aColor).
+ 	slider borderColor: ((self userInterfaceTheme borderColorModifier
+ 		ifNil: [ [:c | c adjustBrightness: -0.3] ]) value: aColor).
+ 	
+ 	cc := ((self userInterfaceTheme thumbColorModifier
+ 		ifNil: [ [:c | c] ]) value: aColor).
+ 	
+ 	gradient := GradientFillStyle ramp: {
+ 		0.0 -> Color white.
+ 		0.1-> (cc adjustBrightness: 0.05).
+ 		0.6 -> (cc darker)}.
+ 	
+ 	"Fill the thumb"
+ 	gradient origin: slider topLeft.
+ 	gradient direction: (self orientation == #horizontal
+ 		ifTrue:[0 at slider height]
+ 		ifFalse:[slider width at 0]).
+ 	slider fillStyle: gradient.
+ 	
+ 	"Fill the buttons"
+ 	{self menuButton. self upButton. self downButton} do: [:ea |
+ 		gradient := gradient copy.
+ 		gradient origin: ea topLeft.
+ 		gradient direction: (self orientation == #horizontal
+ 			ifTrue:[0 at ea height]
+ 			ifFalse:[ea width at 0]).
+ 		ea
+ 			fillStyle: gradient;
+ 			borderWidth: slider borderWidth;
+ 			borderColor: slider borderColor].!

Item was added:
+ ----- Method: ScrollBar>>updateSliderColorSolid: (in category 'updating') -----
+ updateSliderColorSolid: aColor
+ 
+ 	sliderShadow color: self sliderShadowColor.
+ 
+ 	slider color: ((self userInterfaceTheme thumbColorModifier
+ 		ifNil: [ [:c | c] ]) value: aColor).
+ 
+ 	slider borderColor: ((self userInterfaceTheme borderColorModifier
+ 		ifNil: [ [:c | c adjustBrightness: -0.3] ]) value: aColor).
+ 
+ 	pagingArea color: ((self userInterfaceTheme pagingAreaColorModifier
+ 		ifNil: [ [:c | c darker alpha: 0.35] ]) value: aColor).
+ 		
+ 	{self menuButton. self upButton. self downButton} do: [:ea |
+ 		ea
+ 			color: slider color;
+ 			borderWidth: slider borderWidth;
+ 			borderColor: slider borderColor].!

Item was added:
+ ----- Method: ScrollBar>>updateSliderCornerStyle (in category 'updating') -----
+ updateSliderCornerStyle
+ 	"Right now, only the slider's corner style is affected. Buttons and paging area remain square. Looks better somehow... :-)"
+ 	
+ 	slider cornerStyle: (self class roundedScrollBarLook ifTrue: [#rounded] ifFalse: [#square]).!

Item was changed:
+ ----- Method: ScrollBar>>updateUpButtonImage (in category 'updating') -----
- ----- Method: ScrollBar>>updateUpButtonImage (in category 'initialize') -----
  updateUpButtonImage
  "update the receiver's upButton. put a new image inside"
  	upButton removeAllMorphs.
+ 	upButton addMorphCentered: (ImageMorph new image: self upImage).!
- 	upButton
- 		addMorphCentered: (ImageMorph new image: self upImage)!

Item was added:
+ ----- Method: ScrollPane class>>themeProperties (in category 'preferences') -----
+ themeProperties
+ 
+ 	^ super themeProperties, {
+ 		{ #borderColor. 'Colors'. 'Color of the pane''s border.' }.
+ 		{ #borderWidth. 'Borders'. 'Width of the pane''s border.' }.
+ 		{ #borderStyle. 'Borders'. 'Whether to use a plain border, inset, or outset.' }.
+ 		{ #color. 'Colors'. 'Background color of the pane.' }.
+ 	}!

Item was added:
+ ----- Method: ScrollPane>>applyUserInterfaceTheme (in category 'updating') -----
+ applyUserInterfaceTheme
+ 
+ 	super applyUserInterfaceTheme.
+ 	self setDefaultParameters.!

Item was changed:
  ----- Method: ScrollPane>>borderWidth: (in category 'accessing') -----
  borderWidth: aNumber 
  	super borderWidth: aNumber.
+ 	self resizeScroller; setScrollDeltas!
- 	self setScrollDeltas!

Item was removed:
- ----- Method: ScrollPane>>defaultBorderColor (in category 'initialization') -----
- defaultBorderColor
- 	"answer the default border color/fill style for the receiver"
- 	^ Color black!

Item was removed:
- ----- Method: ScrollPane>>defaultBorderWidth (in category 'initialization') -----
- defaultBorderWidth
- 
- 	^ 1 !

Item was removed:
- ----- Method: ScrollPane>>defaultColor (in category 'initialization') -----
- defaultColor
- 
- 	^ Color white !

Item was changed:
  ----- Method: ScrollPane>>initialize (in category 'initialization') -----
  initialize
  	
  	"initialize the state of the receiver"
  	super initialize.
  	""
  	self initializePreferences.
  	hasFocus := false.
  	self initializeScrollBars.
  	""
  	
  	self extent: self defaultExtent.
  	self
  		resizeScrollBars;
  		resizeScroller;
  		hideOrShowScrollBars;
  		updateMinimumExtent.
+ 	
+ 	self setDefaultParameters.
- 		
  	self addKeyboardCaptureFilter: self.!

Item was changed:
  ----- Method: ScrollPane>>initializeScrollBars (in category 'initialization') -----
  initializeScrollBars
  	"Initialize vertical and horizontal scroll bars."
  
  	(scrollBar := ScrollBar on: self getValue: nil setValue: #vScrollBarValue:)
  			menuSelector: #vScrollBarMenuButtonPressed:;
  			orientation: #vertical;
  			extent: 1 at 1.
  	(hScrollBar := ScrollBar on: self getValue: nil setValue: #hScrollBarValue:)
  			menuSelector: #hScrollBarMenuButtonPressed:;
  			orientation: #horizontal;
  			extent: 1 at 1.
  
  	""
  	scroller := TransformMorph new color: Color transparent.
  	scroller offset: 0 @ 0.
  	self addMorph: scroller.
  	""
- 	scrollBar initializeEmbedded: retractableScrollBar not.
- 	hScrollBar initializeEmbedded: retractableScrollBar not.
  	retractableScrollBar ifFalse: 
  			[self 
  				addMorph: scrollBar;
  				addMorph: hScrollBar].
  	self updateMinimumExtent.!

Item was added:
+ ----- Method: ScrollPane>>setDefaultParameters (in category 'initialization') -----
+ setDefaultParameters
+ 	"change the receiver's appareance parameters"
+ 
+ 	self
+ 		color: (self userInterfaceTheme color ifNil: [Color white]);
+ 		borderStyle: (self userInterfaceTheme borderStyle ifNil: [BorderStyle default]);
+ 		borderColor: (self userInterfaceTheme borderColor ifNil: [Color gray: 0.6]);
+ 		borderWidth: (self userInterfaceTheme borderWidth ifNil: [1]).!

Item was changed:
  ScrollPane subclass: #SimpleHierarchicalListMorph
+ 	instanceVariableNames: 'selectedMorph hoveredMorph getListSelector keystrokeActionSelector autoDeselect columns columnsCache sortingSelector getSelectionSelector setSelectionSelector potentialDropMorph lineColor font textColor'
- 	instanceVariableNames: 'selectedMorph hoveredMorph getListSelector keystrokeActionSelector autoDeselect columns columnsCache sortingSelector getSelectionSelector setSelectionSelector potentialDropMorph lineColor'
  	classVariableNames: 'WrappedNavigation'
  	poolDictionaries: ''
  	category: 'Morphic-Explorer'!
  SimpleHierarchicalListMorph class
  	instanceVariableNames: 'expandedForm notExpandedForm'!
  
  !SimpleHierarchicalListMorph commentStamp: 'ls 3/1/2004 12:15' prior: 0!
  Display a hierarchical list of items.  Each item should be wrapped with a ListItemWrapper.
  
  For a simple example, look at submorphsExample.  For beefier examples, look at ObjectExplorer or FileList2.!
  SimpleHierarchicalListMorph class
  	instanceVariableNames: 'expandedForm notExpandedForm'!

Item was added:
+ ----- Method: SimpleHierarchicalListMorph class>>themeProperties (in category 'preferences') -----
+ themeProperties
+ 
+ 	^ super themeProperties, {
+ 		{ #font. 'Fonts'. 'Font of the list items.' }.
+ 		{ #textColor. 'Colors'. 'Color of the list items.' }.
+ 		{ #selectionColor. 'Colors'. 'Color used for items when hovering or selecting them.' }.
+ 		{ #selectionTextColor. 'Colors'. 'Color used for label when hovering or selecting them.' }.
+ 		
+ 		{ #filterColor. 'Colors'. 'Color used for items to indicate the matching filter.' }.
+ 		{ #filterTextColor. 'Colors'. 'Color used for items to indicate the matching filter.' }.
+ 		{ #highlightTextColor. 'Colors'. 'Color used for highlighted items.' }.
+ 		
+ 		{ #hoverSelectionModifier. 'Colors'. 'How to derive the hover color from the selection color.'}.
+ 
+ 		{ #lineColor. 'Colors'. 'How the lines are drawn.' }.
+ 	}!

Item was changed:
  ----- Method: SimpleHierarchicalListMorph>>addMorphsTo:from:allowSorting:withExpandedItems:atLevel: (in category 'private') -----
  addMorphsTo: morphList from: aCollection allowSorting: sortBoolean withExpandedItems: expandedItems atLevel: newIndent
  
  	| priorMorph newCollection firstAddition |
  	priorMorph := nil.
  	newCollection := (sortBoolean and: [sortingSelector notNil]) ifTrue: [
  		(aCollection asSortedCollection: [ :a :b | 
  			(a perform: sortingSelector) <= (b perform: sortingSelector)]) asOrderedCollection
  	] ifFalse: [
  		aCollection
  	].
  	firstAddition := nil.
  	newCollection do: [:item | 
  		priorMorph := self indentingItemClass basicNew 
  			initWithContents: item 
  			prior: priorMorph 
  			forList: self
  			indentLevel: newIndent.
+ 		priorMorph
+ 			color: self textColor;
+ 			font: self font;
+ 			selectionColor: self selectionColor;
+ 			selectionTextColor: self selectionTextColor;
+ 			hoverColor: self hoverColor;
+ 			highlightTextColor: self highlightTextColor;
+ 			filterColor: self filterColor;
+ 			filterTextColor: self filterTextColor.
  		firstAddition ifNil: [firstAddition := priorMorph].
  		morphList add: priorMorph.
  		((item hasEquivalentIn: expandedItems) or: [priorMorph isExpanded]) ifTrue: [
  			priorMorph isExpanded: true.
  			priorMorph 
  				addChildrenForList: self 
  				addingTo: morphList
  				withExpandedItems: expandedItems.
  		].
  	].
  	^firstAddition
  	
  !

Item was changed:
  ----- Method: SimpleHierarchicalListMorph>>addSubmorphsAfter:fromCollection:allowSorting: (in category 'private') -----
  addSubmorphsAfter: parentMorph fromCollection: aCollection allowSorting: sortBoolean
  
  	| priorMorph morphList newCollection |
  	priorMorph := nil.
  	newCollection := (sortBoolean and: [sortingSelector notNil]) ifTrue: [
  		(aCollection asSortedCollection: [ :a :b | 
  			(a perform: sortingSelector) <= (b perform: sortingSelector)]) asOrderedCollection
  	] ifFalse: [
  		aCollection
  	].
  	morphList := OrderedCollection new.
  	newCollection do: [:item | 
  		priorMorph := self indentingItemClass basicNew 
  			initWithContents: item 
  			prior: priorMorph 
  			forList: self
  			indentLevel: parentMorph indentLevel + 1.
+ 		priorMorph
+ 			color: self textColor;
+ 			font: self font;
+ 			selectionColor: self selectionColor;
+ 			selectionTextColor: self selectionTextColor;
+ 			hoverColor: self hoverColor;
+ 			highlightTextColor: self highlightTextColor;
+ 			filterColor: self filterColor;
+ 			filterTextColor: self filterTextColor.
  		morphList add: priorMorph.
  	].
  	scroller addAllMorphs: morphList after: parentMorph.
  	^morphList
  	
  !

Item was added:
+ ----- Method: SimpleHierarchicalListMorph>>applyUserInterfaceTheme (in category 'updating') -----
+ applyUserInterfaceTheme
+ 
+ 	super applyUserInterfaceTheme.!

Item was changed:
  ----- Method: SimpleHierarchicalListMorph>>drawHoverOn: (in category 'drawing') -----
  drawHoverOn: aCanvas 
  
  	self hoveredMorph ifNil: [^ self].
  	PluggableListMorph highlightHoveredRow ifFalse: [^ self].
  	
  	aCanvas
+ 		transformBy: scroller transform
+ 		clippingTo: scroller innerBounds
+ 		during: [:c | self hoveredMorph drawHoverOn: c].!
- 		fillRectangle: (((scroller transformFrom: self)
- 				invertBoundsRect: self hoveredMorph bounds)
- 				intersect: scroller bounds)
- 		color: (LazyListMorph listSelectionColor darker alpha: 0.3).!

Item was changed:
  ----- Method: SimpleHierarchicalListMorph>>drawSelectionOn: (in category 'drawing') -----
  drawSelectionOn: aCanvas 
  
+ 	self selectedMorph ifNotNil: [:m |
+ 		aCanvas
+ 			transformBy: scroller transform
+ 			clippingTo: scroller innerBounds
+ 			during: [:c | m drawSelectionOn: c] ].!
- 	self selectedMorph ifNil: [^ self].
- 	
- 	aCanvas
- 		fillRectangle: (((scroller transformFrom: self)
- 				invertBoundsRect: selectedMorph bounds)
- 				intersect: scroller bounds)
- 		color: LazyListMorph listSelectionColor.!

Item was added:
+ ----- Method: SimpleHierarchicalListMorph>>filterColor (in category 'accessing') -----
+ filterColor
+ 
+ 	^ self valueOfProperty: #filterColor ifAbsent: [Color yellow]!

Item was added:
+ ----- Method: SimpleHierarchicalListMorph>>filterColor: (in category 'accessing') -----
+ filterColor: aColor
+ 
+ 	self setProperty: #filterColor toValue: aColor.
+ 	scroller submorphsDo: [:ea | ea filterColor: aColor].!

Item was added:
+ ----- Method: SimpleHierarchicalListMorph>>filterTextColor (in category 'accessing') -----
+ filterTextColor
+ 
+ 	^ self valueOfProperty: #filterTextColor ifAbsent: [Color black]!

Item was added:
+ ----- Method: SimpleHierarchicalListMorph>>filterTextColor: (in category 'accessing') -----
+ filterTextColor: aColor
+ 
+ 	self setProperty: #filterTextColor toValue: aColor.
+ 	scroller submorphsDo: [:ea | ea filterTextColor: aColor].!

Item was added:
+ ----- Method: SimpleHierarchicalListMorph>>font (in category 'accessing') -----
+ font
+ 	^ font ifNil: [TextStyle defaultFont]!

Item was added:
+ ----- Method: SimpleHierarchicalListMorph>>font: (in category 'accessing') -----
+ font: aFont
+ 	font := aFont.
+ 	scroller submorphsDo: [:ea | ea font: font].!

Item was added:
+ ----- Method: SimpleHierarchicalListMorph>>highlightTextColor (in category 'accessing') -----
+ highlightTextColor
+ 
+ 	^ self valueOfProperty: #highlightTextColor ifAbsent: [Color red]!

Item was added:
+ ----- Method: SimpleHierarchicalListMorph>>highlightTextColor: (in category 'accessing') -----
+ highlightTextColor: aColor
+ 
+ 	self setProperty: #highlightTextColor toValue: aColor.
+ 	scroller submorphsDo: [:ea | ea highlightTextColor: aColor].!

Item was added:
+ ----- Method: SimpleHierarchicalListMorph>>hoverColor (in category 'accessing') -----
+ hoverColor
+ 
+ 	^ self valueOfProperty: #hoverColor ifAbsent: [Color veryLightGray]!

Item was added:
+ ----- Method: SimpleHierarchicalListMorph>>hoverColor: (in category 'accessing') -----
+ hoverColor: aColor
+ 
+ 	self setProperty: #hoverColor toValue: aColor.
+ 	scroller submorphsDo: [:ea | ea setProperty: #hoverColor toValue: aColor].!

Item was added:
+ ----- Method: SimpleHierarchicalListMorph>>selectionColor (in category 'accessing') -----
+ selectionColor
+ 
+ 	^ self valueOfProperty: #selectionColor ifAbsent: [Color blue]!

Item was added:
+ ----- Method: SimpleHierarchicalListMorph>>selectionColor: (in category 'accessing') -----
+ selectionColor: aColor
+ 
+ 	self setProperty: #selectionColor toValue: aColor.
+ 	scroller submorphsDo: [:ea | ea selectionColor: aColor].!

Item was added:
+ ----- Method: SimpleHierarchicalListMorph>>selectionTextColor (in category 'accessing') -----
+ selectionTextColor
+ 
+ 	^ self valueOfProperty: #selectionTextColor ifAbsent: [Color white]!

Item was added:
+ ----- Method: SimpleHierarchicalListMorph>>selectionTextColor: (in category 'accessing') -----
+ selectionTextColor: aColor
+ 
+ 	self setProperty: #selectionTextColor toValue: aColor.
+ 	scroller submorphsDo: [:ea | ea selectionTextColor: aColor].!

Item was added:
+ ----- Method: SimpleHierarchicalListMorph>>setDefaultParameters (in category 'initialization') -----
+ setDefaultParameters
+ 
+ 	super setDefaultParameters.
+ 	
+ 	self
+ 		font: (self userInterfaceTheme font ifNil: [TextStyle defaultFont]);
+ 		textColor: (self userInterfaceTheme textColor ifNil: [Color black]).
+ 		
+ 	self
+ 		selectionColor: (self userInterfaceTheme selectionColor ifNil: [Color r: 0.72 g: 0.72 b: 0.9]);
+ 		selectionTextColor: (self userInterfaceTheme selectionTextColor ifNil: [Color black]);
+ 		filterColor: (self userInterfaceTheme filterColor ifNil: [Color yellow paler]);
+ 		filterTextColor: (self userInterfaceTheme filterTextColor ifNil: [Color black]);
+ 		lineColor: (self userInterfaceTheme lineColor ifNil: [Color veryLightGray]);
+ 		hoverColor: ((self userInterfaceTheme hoverSelectionModifier ifNil: [ [:c | c darker alpha: 0.3] ]) value: self selectionColor);
+ 		highlightTextColor: (self userInterfaceTheme highlightTextColor ifNil: [Color red]).!

Item was added:
+ ----- Method: SimpleHierarchicalListMorph>>textColor (in category 'accessing') -----
+ textColor
+ 	^ textColor ifNil: [Color black]!

Item was added:
+ ----- Method: SimpleHierarchicalListMorph>>textColor: (in category 'accessing') -----
+ textColor: aColor
+ 	textColor := aColor.
+ 	scroller submorphsDo: [:ea | ea color: textColor].!

Item was added:
+ ----- Method: Slider class>>themeProperties (in category 'preferences') -----
+ themeProperties
+ 
+ 	^ super themeProperties, {
+ 		{ #borderColor. 'Colors'. 'Color of the slider''s border.' }.
+ 		{ #borderWidth. 'Borders'. 'Width of the slider''s border.' }.
+ 		{ #color. 'Colors'. 'Background color of the slider.' }.
+ 
+ 		{ #thumbBorderColor. 'Colors'. 'Color of the slider thumb''s border.' }.
+ 		{ #thumbBorderWidth. 'Borders'. 'Width of the slider thumb''s border.' }.
+ 		{ #thumbColor. 'Colors'. 'Background color of the slider thumb.' }.
+ 		
+ 		{ #thumbShadowModifier. 'Colors'. 'How to modify the thumb color to get the shadow color.' }.
+ 	}!

Item was changed:
  ----- Method: Slider>>adoptPaneColor: (in category 'accessing - ui') -----
  adoptPaneColor: paneColor
  
  	super adoptPaneColor: paneColor.
+ 	paneColor ifNotNil: [:c | self sliderColor: c].!
- 
- 	paneColor ifNotNil: [:c |
- 		self color: c.
- 		self thumb color: c].!

Item was added:
+ ----- Method: Slider>>applyUserInterfaceTheme (in category 'updating') -----
+ applyUserInterfaceTheme
+ 
+ 	super applyUserInterfaceTheme.
+ 	
+ 	self setDefaultParameters.!

Item was removed:
- ----- Method: Slider>>defaultBorderColor (in category 'initialization') -----
- defaultBorderColor
- 	"answer the default border color/fill style for the receiver"
- 	^ #inset!

Item was removed:
- ----- Method: Slider>>defaultBorderWidth (in category 'initialization') -----
- defaultBorderWidth
- 	"answer the default border width for the receiver"
- 	^ 1!

Item was removed:
- ----- Method: Slider>>defaultColor (in category 'initialization') -----
- defaultColor
- 	"answer the default color/fill style for the receiver"
- 	^ Color lightGray!

Item was added:
+ ----- Method: Slider>>hideSliderShadow (in category 'other events') -----
+ hideSliderShadow
+ 
+ 	sliderShadow hide.!

Item was changed:
  ----- Method: Slider>>initialize (in category 'initialization') -----
  initialize
+ 
- 	"initialize the state of the receiver"
  	super initialize.
+ 
- 	""
  	value := 0.0.
  	descending := false.
+ 	
+ 	self initializeSlider.
+ 	self setDefaultParameters.!
- 	self initializeSlider!

Item was changed:
  ----- Method: Slider>>initializeSlider (in category 'initialization') -----
  initializeSlider
+ 
+ 	slider := RectangleMorph
+ 		newBounds: self totalSliderArea
+ 		color: self thumbColor.
+ 	
+ 	sliderShadow := RectangleMorph
+ 		newBounds: self totalSliderArea
+ 		color: self pagingArea color.
+ 	
- 	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.
+ 
+ 	self addMorphFront: sliderShadow.
+ 	self addMorphFront: slider.
+ 
- 	slider setBorderWidth: 1 borderColor: Color lightGray..
- 	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 hideSliderShadow.!
- !

Item was changed:
  ----- Method: Slider>>mouseDownInSlider: (in category 'other events') -----
  mouseDownInSlider: event 
  
  	slider borderStyle style == #raised
  		ifTrue: [slider borderColor: #inset].
  	
+ 	self showSliderShadow.!
- 	sliderShadow color: self sliderShadowColor.
- 	sliderShadow cornerStyle: slider cornerStyle.
- 	sliderShadow bounds: slider bounds.
- 	sliderShadow show!

Item was changed:
  ----- Method: Slider>>mouseUpInSlider: (in category 'other events') -----
  mouseUpInSlider: event 
  
  	slider borderStyle style == #inset
  		ifTrue: [slider borderColor: #raised].
  	
+ 	self hideSliderShadow.!
- 	sliderShadow hide!

Item was added:
+ ----- Method: Slider>>setDefaultParameters (in category 'initialization') -----
+ setDefaultParameters
+ 	"change the receiver's appareance parameters"
+ 
+ 	self
+ 		color: (self userInterfaceTheme color ifNil: [Color lightGray]);
+ 		borderColor: (self userInterfaceTheme borderColor ifNil: [Color gray]);
+ 		borderWidth: (self userInterfaceTheme borderWidth ifNil: [1]).
+ 	
+ 	slider
+ 		color: (self userInterfaceTheme thumbColor ifNil: [Color veryVeryLightGray]);
+ 		borderColor: (self userInterfaceTheme thumbBorderColor ifNil: [Color gray: 0.6]);
+ 		borderWidth: (self userInterfaceTheme thumbBorderWidth ifNil: [0]).
+ 
+ 	sliderShadow
+ 		borderWidth: slider borderWidth;
+ 		borderColor: Color transparent.
+ 
+ 	sliderColor := slider color.
+ 	self updateSliderColor: slider color.!

Item was added:
+ ----- Method: Slider>>showSliderShadow (in category 'other events') -----
+ showSliderShadow
+ 
+ 	sliderShadow color: self sliderShadowColor.
+ 	sliderShadow cornerStyle: slider cornerStyle.
+ 	sliderShadow bounds: slider bounds.
+ 	sliderShadow show.!

Item was changed:
  ----- Method: Slider>>sliderColor (in category 'accessing - ui') -----
  sliderColor
  	"color scheme for the whole slider widget"
+ 	
+ 	^ sliderColor ifNil: [self userInterfaceTheme thumbColor ifNil: [Color veryVeryLightGray]]!
- 	sliderColor ifNil: [^ (color alphaMixed: 0.7 with: Color white) slightlyLighter].
- 	^ sliderColor!

Item was changed:
  ----- Method: Slider>>sliderColor: (in category 'accessing - ui') -----
  sliderColor: newColor
  
  	sliderColor := newColor.
+ 	self updateSliderColor: sliderColor.!
- 	slider ifNotNil: [slider color: sliderColor]!

Item was changed:
  ----- Method: Slider>>sliderShadowColor (in category 'accessing - ui') -----
  sliderShadowColor
+ 
+ 	^ ((self userInterfaceTheme thumbShadowModifier
+ 			ifNil: [ [:c | c alpha: 0.7 ] ]) value: self sliderColor)!
- 	^ self sliderColor alphaMixed: 0.2 with: self pagingArea color!

Item was changed:
+ ----- Method: Slider>>updateSlider (in category 'updating') -----
- ----- Method: Slider>>updateSlider (in category 'initialization') -----
  updateSlider
  	"Updates layout properties of the slider."
  	
  	slider bounds: self totalSliderArea.
  	sliderShadow bounds: slider bounds.
  	
  	self computeSlider.
  !

Item was added:
+ ----- Method: Slider>>updateSliderColor: (in category 'updating') -----
+ updateSliderColor: aColor
+ 
+ 	slider color: aColor.
+ 	sliderShadow color: self sliderShadowColor.!

Item was added:
+ ----- Method: TextMorph>>createParagraph (in category 'private') -----
+ createParagraph
+ 
+ 	self setProperty: #CreatingParagraph toValue: true.
+ 
+ 	[
+ 		self setDefaultContentsIfNil.
+ 
+ 		"...Code here to recreate the paragraph..."
+ 		paragraph := (self paragraphClass new textOwner: self owner).
+ 		paragraph wantsColumnBreaks: successor notNil.
+ 		paragraph
+ 			compose: text
+ 			style: textStyle copy
+ 			from: self startingIndex
+ 			in: self container.
+ 		wrapFlag ifFalse:
+ 			["Was given huge container at first... now adjust"
+ 			paragraph adjustRightX].
+ 		paragraph focused: (self currentHand keyboardFocus == self).
+ 	
+ 		self fit.
+ 	] ensure: [self removeProperty: #CreatingParagraph].
+ 
+ 	^ paragraph!

Item was changed:
  ----- Method: TextMorph>>paragraph (in category 'private') -----
  paragraph
  	"Paragraph instantiation is lazy -- create it only when needed"
- 	paragraph ifNotNil: [^ paragraph].
  
+ 	^ paragraph ifNil: [self createParagraph]!
- self setProperty: #CreatingParagraph toValue: true.
- 
- 	self setDefaultContentsIfNil.
- 
- 	"...Code here to recreate the paragraph..."
- 	paragraph := (self paragraphClass new textOwner: self owner).
- 	paragraph wantsColumnBreaks: successor notNil.
- 	paragraph
- 		compose: text
- 		style: textStyle copy
- 		from: self startingIndex
- 		in: self container.
- 	wrapFlag ifFalse:
- 		["Was given huge container at first... now adjust"
- 		paragraph adjustRightX].
- 	paragraph focused: (self currentHand keyboardFocus == self).
- 	self fit.
- self removeProperty: #CreatingParagraph.
- 
- 
- 	^ paragraph!

Item was added:
+ ----- Method: TextMorphForEditView>>caretColor (in category 'accessing') -----
+ caretColor
+ 	^ self valueOfProperty: #caretColor ifAbsent: [Color red]!

Item was added:
+ ----- Method: TextMorphForEditView>>createParagraph (in category 'private') -----
+ createParagraph
+ 
+ 	super createParagraph.
+ 	
+ 	paragraph
+ 		caretColor: self caretColor;
+ 		selectionColor: self selectionColor;
+ 		unfocusedSelectionColor: self unfocusedSelectionColor.
+ 		
+ 	^ paragraph!

Item was added:
+ ----- Method: TextMorphForEditView>>selectionColor (in category 'accessing') -----
+ selectionColor
+ 	^ self valueOfProperty: #selectionColor ifAbsent: [Color blue muchLighter]!

Item was added:
+ ----- Method: TextMorphForEditView>>unfocusedSelectionColor (in category 'accessing') -----
+ unfocusedSelectionColor
+ 	^ self valueOfProperty: #unfocusedSelectionColor ifAbsent: [Color blue muchLighter]!

Item was changed:
+ (PackageInfo named: 'Morphic') postscript: 'ScrollBar initializeImagesCache.
+ LazyListMorph allSubInstancesDo: [:ea | ea resetFilterOffsets].
+ PluggableTextMorph flushAdornmentCache.'!
- (PackageInfo named: 'Morphic') postscript: 'SystemProgressMorph reset.'!



More information about the Squeak-dev mailing list