[squeak-dev] The Trunk: Tools-topa.579.mcz

commits at source.squeak.org commits at source.squeak.org
Tue Apr 7 12:28:01 UTC 2015


Tobias Pape uploaded a new version of Tools to project The Trunk:
http://source.squeak.org/trunk/Tools-topa.579.mcz

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

Name: Tools-topa.579
Author: topa
Time: 7 April 2015, 2:27:40.196 pm
UUID: c9f6d7a8-8a37-43ea-aff6-d0f8f19ed815
Ancestors: Tools-tfel.578

IndentingListItemMorph belongs to Morphic

=============== Diff against Tools-tfel.578 ===============

Item was removed:
- StringMorph subclass: #IndentingListItemMorph
- 	instanceVariableNames: 'indentLevel isExpanded complexContents firstChild container nextSibling icon backgroundColor'
- 	classVariableNames: ''
- 	poolDictionaries: ''
- 	category: 'Tools-Explorer'!
- 
- !IndentingListItemMorph commentStamp: '<historical>' prior: 0!
- An IndentingListItemMorph is a StringMorph that draws itself with an optional toggle at its left, as part of the display of the SimpleHierarchicalListMorph.
- 
- It will also display lines around the toggle if the #showLinesInHierarchyViews Preference is set.
- 
- Instance variables:
- 
- indentLevel <SmallInteger> 	the indent level, from 0 at the root and increasing by 1 at each level of the hierarchy.
- 
- isExpanded <Boolean>		true if this item is expanded (showing its children)
- 
- complexContents <ListItemWrapper>	an adapter wrapping my represented item that can answer its children, etc.
- 	
- firstChild <IndentingListItemMorph|nil>	my first child, or nil if none
- 	
- container <SimpleHierarchicalListMorph>	my container
- 	
- nextSibling <IndentingListItemMorph|nil>	the next item in the linked list of siblings, or nil if none.
- 
- Contributed by Bob Arning as part of the ObjectExplorer package.
- Don't blame him if it's not perfect.  We wanted to get it out for people to play with.!

Item was removed:
- ----- Method: IndentingListItemMorph class>>iconColumnIndex (in category 'defaults') -----
- iconColumnIndex
- 	"Hack. For now, say who gets the icon here. We need a generic solution for icons in multi-column trees. PluggableTreeMorph does something in that direction."
- 	^ 2!

Item was removed:
- ----- Method: IndentingListItemMorph>>acceptDroppingMorph:event: (in category 'drag and drop') -----
- acceptDroppingMorph: toDrop event: evt
- 	complexContents acceptDroppingObject: toDrop complexContents.
- 	toDrop delete.
- 	self highlightForDrop: false.!

Item was removed:
- ----- Method: IndentingListItemMorph>>addChildrenForList:addingTo:withExpandedItems: (in category 'container protocol - private') -----
- addChildrenForList: hostList addingTo: morphList withExpandedItems: expandedItems
- 
- 	firstChild ifNotNil: [
- 		firstChild withSiblingsDo: [ :aNode | aNode delete].
- 	].
- 	firstChild := nil.
- 	complexContents hasContents ifFalse: [^self].
- 	firstChild := hostList 
- 		addMorphsTo: morphList
- 		from: complexContents contents 
- 		allowSorting: true
- 		withExpandedItems: expandedItems
- 		atLevel: indentLevel + 1.
- 	!

Item was removed:
- ----- Method: IndentingListItemMorph>>applyFilter: (in category 'filtering') -----
- applyFilter: filter
- 
- 	self
- 		applyFilter: filter
- 		depthOffset: self indentLevel.!

Item was removed:
- ----- Method: IndentingListItemMorph>>applyFilter:depthOffset: (in category 'filtering') -----
- applyFilter: filter depthOffset: offset
- 
- 	| selfMatch childMatch |
- 	self isExpanded ifTrue: [self toggleExpandedState].
- 	
- 	selfMatch := self matches: filter.
- 	childMatch := self matchesAnyChild: filter depthOffset: offset.
- 	
- 	selfMatch | childMatch ifFalse: [^ self hide].
- 	
- 	selfMatch ifTrue: [
- 		self backgroundColor: ((Color gray: 0.85) alpha: 0.5)].
- 	childMatch ifTrue: [
- 		self toggleExpandedState.
- 		self childrenDo: [:child | child applyFilter: filter depthOffset: offset]].!

Item was removed:
- ----- Method: IndentingListItemMorph>>backgroundColor (in category 'accessing') -----
- backgroundColor
- 	^ backgroundColor!

Item was removed:
- ----- Method: IndentingListItemMorph>>backgroundColor: (in category 'accessing') -----
- backgroundColor: aColor
- 	backgroundColor := aColor.
- 	self changed.!

Item was removed:
- ----- Method: IndentingListItemMorph>>balloonText (in category 'accessing') -----
- balloonText
- 
- 	^complexContents balloonText ifNil: [super balloonText]!

Item was removed:
- ----- Method: IndentingListItemMorph>>boundsForBalloon (in category 'halos and balloon help') -----
- boundsForBalloon
- 
- 	"some morphs have bounds that are way too big"
- 	container ifNil: [^super boundsForBalloon].
- 	^self boundsInWorld intersect: container boundsInWorld!

Item was removed:
- ----- Method: IndentingListItemMorph>>canExpand (in category 'testing') -----
- canExpand
- 
- 	^complexContents hasContents!

Item was removed:
- ----- Method: IndentingListItemMorph>>charactersOccluded (in category 'private') -----
- charactersOccluded
- 	"Answer the number of characters occluded in my #visibleList by my right edge."
- 	| listIndex leftEdgeOfRightmostColumn eachString indexOfLastVisible iconWidth totalWidth |
- 	listIndex := 0.
- 	leftEdgeOfRightmostColumn := container columns
- 		ifNil: [ 0 ]
- 		ifNotNil:
- 			[ : cols | (1 to: cols size - 1)
- 				inject: 0
- 				into:
- 					[ : sum : each | sum + (self widthOfColumn: each) ] ].
- 	eachString := container columns
- 		ifNil: [ self complexContents asString ]
- 		ifNotNil:
- 			[ : cols | self contentsAtColumn: container columns size ].
- 	iconWidth := self icon
- 		ifNil: [ 0 ]
- 		ifNotNil:
- 			[ : icon | icon width + 2 ].
- 	totalWidth := self toggleBounds right.
- 	indexOfLastVisible := ((1 to: eachString size)
- 		detect:
- 			[ : stringIndex | (totalWidth:=totalWidth+(self fontToUse widthOf: (eachString at: stringIndex))) >
- 				(container width -
- 					(container vIsScrollbarShowing
- 						ifTrue: [ container scrollBar width ]
- 						ifFalse: [ 0 ]) - iconWidth - leftEdgeOfRightmostColumn) ]
- 		ifNone: [ eachString size + 1 ]) - 1.
- 	^ eachString size - indexOfLastVisible!

Item was removed:
- ----- Method: IndentingListItemMorph>>children (in category 'accessing') -----
- children
- 	| children |
- 	children := OrderedCollection new.
- 	self childrenDo: [:each | children add: each].
- 	^children!

Item was removed:
- ----- Method: IndentingListItemMorph>>childrenDo: (in category 'enumeration') -----
- childrenDo: aBlock
- 
- 	firstChild ifNotNil: [
- 		firstChild withSiblingsDo: aBlock ]!

Item was removed:
- ----- Method: IndentingListItemMorph>>collapse (in category 'container protocol') -----
- collapse
- 
- 	self isExpanded ifFalse: [^ self].
- 	
- 	self isExpanded: false.
- 	
- 	firstChild ifNotNil: [:collapsingNode |
- 	 	| toDelete |
- 		toDelete := OrderedCollection new.
- 		collapsingNode withSiblingsDo: [:aNode | aNode recursiveAddTo: toDelete].
- 		container noteRemovalOfAll: toDelete].
- 	
- 	self changed.!

Item was removed:
- ----- Method: IndentingListItemMorph>>complexContents (in category 'accessing') -----
- complexContents
- 
- 	^complexContents!

Item was removed:
- ----- Method: IndentingListItemMorph>>contentsAtColumn: (in category 'accessing - columns') -----
- contentsAtColumn: index
- 	"Split string contents at <tab> character."
- 	
- 	| column scanner cell |
- 	column := 0.
- 	scanner := ReadStream on: contents asString.
- 	[(cell := scanner upTo: Character tab) notEmpty]
- 		whileTrue: [column := column + 1. column = index ifTrue: [^ cell]].
- 	^ ''!

Item was removed:
- ----- Method: IndentingListItemMorph>>contentsSplitByColumns (in category 'accessing - columns') -----
- contentsSplitByColumns
- 	"Split string contents at <tab> character."
- 	
- 	| result scanner cell |
- 	result := OrderedCollection new.
- 	scanner := ReadStream on: contents asString.
- 	[(cell := scanner upTo: Character tab) notEmpty]
- 		whileTrue: [result add: cell].
- 	^ result!

Item was removed:
- ----- Method: IndentingListItemMorph>>defaultColor (in category 'initialization') -----
- defaultColor
- 
- 	^complexContents
- 		ifNil: [ super defaultColor ]
- 		ifNotNil: [ complexContents preferredColor ]!

Item was removed:
- ----- Method: IndentingListItemMorph>>drawLineToggleToTextOn:lineColor:hasToggle: (in category 'drawing') -----
- drawLineToggleToTextOn: aCanvas lineColor: lineColor hasToggle: hasToggle
- 	"If I am not the only item in my container, draw the line between:
- 		- my toggle (if any) or my left edge (if no toggle)
- 		- and my text left edge"
- 
- 	| myBounds myCenter hLineY hLineLeft |
- 	self isSoleItem ifTrue: [ ^self ].
- 	myBounds := self toggleBounds.
- 	myCenter := myBounds center.
- 	hLineY := myCenter y.
- 	hLineLeft := myCenter x - 1.
- 	"Draw line from toggle to text"
- 	aCanvas
- 		line: hLineLeft @ hLineY
- 		to: myBounds right + 0 @ hLineY
- 		width: 1
- 		color: lineColor!

Item was removed:
- ----- Method: IndentingListItemMorph>>drawLinesOn:lineColor: (in category 'drawing') -----
- drawLinesOn: aCanvas lineColor: lineColor 
- 	| hasToggle |
- 	hasToggle := self hasToggle.
- 	"Draw line from toggle to text"
- 	self drawLineToggleToTextOn: aCanvas lineColor: lineColor hasToggle: hasToggle.
- 
- 	"Draw the line from my toggle to the nextSibling's toggle"
- 	self nextVisibleSibling ifNotNil: [ self drawLinesToNextSiblingOn: aCanvas lineColor: lineColor hasToggle: hasToggle ].
- 
- 	"If I have children and am expanded, draw a line to my first child"
- 	(self firstVisibleChild notNil and: [ self isExpanded ])
- 		ifTrue: [ self drawLinesToFirstChildOn: aCanvas lineColor: lineColor]!

Item was removed:
- ----- Method: IndentingListItemMorph>>drawLinesToFirstChildOn:lineColor: (in category 'drawing') -----
- drawLinesToFirstChildOn: aCanvas lineColor: lineColor 
- 	"Draw line from me to next sibling"
- 
- 	| child vLineX vLineTop vLineBottom childBounds childCenter |
- 	child := self firstVisibleChild.
- 	childBounds := child toggleBounds.
- 	childCenter := childBounds center.
- 	vLineX := childCenter x - 1.
- 	vLineTop := bounds bottom.
- 	child hasToggle
- 		ifTrue: [vLineBottom := childCenter y - 7]
- 		ifFalse: [vLineBottom := childCenter y].
- 	aCanvas
- 		line: vLineX @ vLineTop
- 		to: vLineX @ vLineBottom
- 		width: 1
- 		color: lineColor!

Item was removed:
- ----- Method: IndentingListItemMorph>>drawLinesToNextSiblingOn:lineColor:hasToggle: (in category 'drawing') -----
- drawLinesToNextSiblingOn: aCanvas lineColor: lineColor hasToggle: hasToggle
- 	| myBounds nextSibBounds vLineX myCenter vLineTop vLineBottom |
- 	myBounds := self toggleBounds.
- 	nextSibBounds := self nextVisibleSibling toggleBounds.
- 	myCenter := myBounds center.
- 	vLineX := myCenter x - 1.
- 	vLineTop := myCenter y.
- 	vLineBottom := nextSibBounds center y.
- 	"Draw line from me to next sibling"
- 	aCanvas
- 		line: vLineX @ vLineTop
- 		to: vLineX @ vLineBottom
- 		width: 1
- 		color: lineColor!

Item was removed:
- ----- 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 + 4.
- 	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: 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: color].
- 
- 			"Compute next column offset."			
- 			columnLeft := columnRect right + 5.
- 			column = 1 ifTrue: [columnLeft := columnLeft - tRect right + self left].
- 			
- 		].
- 	]!

Item was removed:
- ----- Method: IndentingListItemMorph>>drawToggleOn:in: (in category 'drawing') -----
- drawToggleOn: aCanvas in: aRectangle
- 
- 	| aForm centeringOffset |
- 	complexContents hasContents ifFalse: [^self].
- 	aForm := isExpanded 
- 		ifTrue: [container expandedForm]
- 		ifFalse: [container notExpandedForm].
- 	centeringOffset := ((aRectangle height - aForm extent y) / 2.0) rounded.
- 	^aCanvas 
- 		paintImage: aForm 
- 		at: (aRectangle topLeft translateBy: 0 @ centeringOffset).
- !

Item was removed:
- ----- Method: IndentingListItemMorph>>expand (in category 'container protocol') -----
- expand
- 
-  	| newChildren c |
- 
- 	(self isExpanded or: [self canExpand not])
- 		ifTrue: [^ self].
- 	
- 	(c := self getChildren) ifEmpty: [
- 		"Due to the guessing in #canExpand, it may still fail here."
- 		^ self].
- 
- 	self isExpanded: true.
- 
- 	newChildren := container 
- 		addSubmorphsAfter: self 
- 		fromCollection: c 
- 		allowSorting: true.
- 
- 	firstChild := newChildren first.!

Item was removed:
- ----- Method: IndentingListItemMorph>>firstChild (in category 'accessing') -----
- firstChild
- 
- 	^firstChild!

Item was removed:
- ----- Method: IndentingListItemMorph>>firstVisibleChild (in category 'accessing') -----
- firstVisibleChild
- 
- 	^ self firstChild ifNotNil: [:c |
- 		c visible ifTrue: [c] ifFalse: [c nextVisibleSibling]]!

Item was removed:
- ----- Method: IndentingListItemMorph>>getChildren (in category 'model access') -----
- getChildren
- 
- 	^ self getChildrenFor: complexContents!

Item was removed:
- ----- Method: IndentingListItemMorph>>getChildrenFor: (in category 'model access') -----
- getChildrenFor: model
- 
- 	^ model contents!

Item was removed:
- ----- Method: IndentingListItemMorph>>getIcon (in category 'model access') -----
- getIcon
- 
- 	^ complexContents icon!

Item was removed:
- ----- Method: IndentingListItemMorph>>getLabel (in category 'model access') -----
- getLabel
- 
- 	^ self getLabelFor: complexContents!

Item was removed:
- ----- Method: IndentingListItemMorph>>getLabelFor: (in category 'model access') -----
- getLabelFor: model
- 
- 	^ model asString!

Item was removed:
- ----- Method: IndentingListItemMorph>>hMargin (in category 'accessing') -----
- hMargin
- 
- 	^ 3!

Item was removed:
- ----- Method: IndentingListItemMorph>>hasIcon (in category 'testing') -----
- hasIcon
- 	"Answer whether the receiver has an icon."
- 	^ icon notNil!

Item was removed:
- ----- Method: IndentingListItemMorph>>hasToggle (in category 'private') -----
- hasToggle
- 	^ complexContents hasContents!

Item was removed:
- ----- 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 removed:
- ----- Method: IndentingListItemMorph>>icon (in category 'accessing') -----
- icon
- 	"answer the receiver's icon"
- 	^ icon!

Item was removed:
- ----- Method: IndentingListItemMorph>>inToggleArea: (in category 'mouse events') -----
- inToggleArea: aPoint
- 
- 	^self toggleRectangle containsPoint: aPoint!

Item was removed:
- ----- Method: IndentingListItemMorph>>indentLevel (in category 'accessing') -----
- indentLevel
- 
- 	^indentLevel!

Item was removed:
- ----- Method: IndentingListItemMorph>>initWithContents:prior:forList:indentLevel: (in category 'initialization') -----
- initWithContents: anObject prior: priorMorph forList: hostList indentLevel: newLevel
- 
- 	container := hostList.
- 	
- 	complexContents := anObject.
- 	anObject addDependent: self.
- 	
- 	self initWithContents: self getLabel font: Preferences standardListFont emphasis: nil.
- 	indentLevel := 0.
- 	isExpanded := false.
-  	nextSibling := firstChild := nil.
- 	priorMorph ifNotNil: [
- 		priorMorph nextSibling: self.
- 	].
- 	indentLevel := newLevel.
- 	icon := self getIcon.
- 	self extent: self minWidth @ self minHeight!

Item was removed:
- ----- Method: IndentingListItemMorph>>initialize (in category 'initialization') -----
- initialize
- "initialize the state of the receiver"
- 	super initialize.
- ""
- 	indentLevel := 0.
- 	isExpanded := false!

Item was removed:
- ----- Method: IndentingListItemMorph>>isExpanded (in category 'accessing') -----
- isExpanded
- 
- 	^isExpanded!

Item was removed:
- ----- Method: IndentingListItemMorph>>isExpanded: (in category 'accessing') -----
- isExpanded: aBoolean
- 
- 	isExpanded := aBoolean!

Item was removed:
- ----- Method: IndentingListItemMorph>>isFirstItem (in category 'testing') -----
- isFirstItem
- 	^owner submorphs first == self!

Item was removed:
- ----- Method: IndentingListItemMorph>>isSoleItem (in category 'testing') -----
- isSoleItem
- 	^self isFirstItem and: [ owner submorphs size = 1 ]!

Item was removed:
- ----- Method: IndentingListItemMorph>>matches: (in category 'filtering') -----
- matches: pattern
- 
- 	^ self matches: pattern in: complexContents!

Item was removed:
- ----- Method: IndentingListItemMorph>>matches:in: (in category 'filtering') -----
- matches: pattern in: model 
- 	^ ((PluggableTreeMorph filterByLabelsOnly
- 		ifTrue: [ model itemName ]
- 		ifFalse: [ self getLabelFor: model ])
- 			findString: pattern
- 			startingAt: 1
- 			caseSensitive: false) > 0!

Item was removed:
- ----- Method: IndentingListItemMorph>>matchesAnyChild:depthOffset: (in category 'filtering') -----
- matchesAnyChild: pattern depthOffset: offset
- 
- 	| maxDepth next current |
- 	maxDepth := PluggableTreeMorph maximumSearchDepth - self indentLevel + offset.
- 	maxDepth <= 0 ifTrue: [^ false].
- 	
- 	next := (self getChildren collect: [:obj | 1 -> obj]) asOrderedCollection.
- 	[next notEmpty] whileTrue: [
- 		current := next removeFirst.
- 		
- 		(self matches: pattern in: current value)
- 			ifTrue: [^ true].
- 		
- 		current key < maxDepth ifTrue: [
- 			next addAll: ((self getChildrenFor: current value) collect: [:obj | (current key + 1) -> obj])].
- 		].
- 	
- 	^ false!

Item was removed:
- ----- Method: IndentingListItemMorph>>minHeight (in category 'layout') -----
- minHeight
- 	| iconHeight |
- 	iconHeight := self hasIcon
- 				ifTrue: [self icon height + 2]
- 				ifFalse: [0].
- 	^ self fontToUse height max: iconHeight !

Item was removed:
- ----- Method: IndentingListItemMorph>>minWidth (in category 'layout') -----
- minWidth
- 	| iconWidth |
- 	iconWidth := self hasIcon
- 				ifTrue: [self icon width + 2]
- 				ifFalse: [0].
- 	^ (self fontToUse widthOfString: contents)
- 		+ iconWidth !

Item was removed:
- ----- Method: IndentingListItemMorph>>nextSibling (in category 'accessing') -----
- nextSibling
- 
- 	^nextSibling!

Item was removed:
- ----- Method: IndentingListItemMorph>>nextSibling: (in category 'accessing') -----
- nextSibling: anotherMorph
- 
- 	nextSibling := anotherMorph!

Item was removed:
- ----- Method: IndentingListItemMorph>>nextVisibleSibling (in category 'accessing') -----
- nextVisibleSibling
- 
- 	| m |
- 	m := self nextSibling.
- 	[m isNil or: [m visible]] whileFalse: [
- 		m := m nextSibling].
- 	^ m!

Item was removed:
- ----- Method: IndentingListItemMorph>>openPath: (in category 'container protocol - private') -----
- openPath: anArray 
- 	| found |
- 	anArray isEmpty
- 		ifTrue: [^ container setSelectedMorph: nil].
- 	found := nil.
- 	self
- 		withSiblingsDo: [:each | found
- 				ifNil: [(each complexContents asString = anArray first
- 							or: [anArray first isNil])
- 						ifTrue: [found := each]]].
- 	found
- 		ifNil: ["try again with no case sensitivity"
- 			self
- 				withSiblingsDo: [:each | found
- 						ifNil: [(each complexContents asString sameAs: anArray first)
- 								ifTrue: [found := each]]]].
- 	found
- 		ifNotNil: [found isExpanded
- 				ifFalse: [found toggleExpandedState.
- 					container adjustSubmorphPositions].
- 			found changed.
- 			anArray size = 1
- 				ifTrue: [^ container setSelectedMorph: found].
- 			^ found firstChild
- 				ifNil: [container setSelectedMorph: nil]
- 				ifNotNil: [found firstChild openPath: anArray allButFirst]].
- 	^ container setSelectedMorph: nil!

Item was removed:
- ----- Method: IndentingListItemMorph>>preferredColumnCount (in category 'accessing - columns') -----
- preferredColumnCount
- 
- 	^ self contentsSplitByColumns size!

Item was removed:
- ----- Method: IndentingListItemMorph>>preferredWidthOfColumn: (in category 'accessing - columns') -----
- preferredWidthOfColumn: index
- 
- 	^ (self fontToUse widthOfString: (self contentsAtColumn: index)) + 
- 		(index = 1 ifTrue: [self toggleRectangle right - self left] ifFalse: [0])!

Item was removed:
- ----- Method: IndentingListItemMorph>>recursiveAddTo: (in category 'container protocol - private') -----
- recursiveAddTo: aCollection
- 
- 	firstChild ifNotNil: [
- 		firstChild withSiblingsDo: [ :aNode | aNode recursiveAddTo: aCollection].
- 	].
- 	aCollection add: self
- 	!

Item was removed:
- ----- Method: IndentingListItemMorph>>recursiveDelete (in category 'container protocol - private') -----
- recursiveDelete
- 
- 	firstChild ifNotNil: [
- 		firstChild withSiblingsDo: [ :aNode | aNode recursiveDelete].
- 	].
- 	self delete
- 	!

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

Item was removed:
- ----- Method: IndentingListItemMorph>>toggleBounds (in category 'private') -----
- toggleBounds
- 	^self toggleRectangle!

Item was removed:
- ----- Method: IndentingListItemMorph>>toggleExpandedState (in category 'container protocol') -----
- toggleExpandedState
- 
- 	self isExpanded
- 		ifTrue: [self collapse]
- 		ifFalse: [self expand].!

Item was removed:
- ----- Method: IndentingListItemMorph>>toggleRectangle (in category 'private') -----
- toggleRectangle
- 
- 	| h |
- 	h := bounds height.
- 	^(bounds left + self hMargin + (12 * indentLevel)) @ bounds top extent: 12 at h!

Item was removed:
- ----- 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 removed:
- ----- Method: IndentingListItemMorph>>update: (in category 'updating') -----
- update: aspect
- 	"See ListItemWrapper and subclasses for possible change aspects."
- 	
- 	aspect = #contents ifTrue: [
- 		self isExpanded ifTrue: [
- 			self toggleExpandedState].
- 			self canExpand ifTrue: [self toggleExpandedState]].
- 		
- 	super update: aspect.!

Item was removed:
- ----- Method: IndentingListItemMorph>>userString (in category 'accessing') -----
- userString
- 	"Add leading tabs to my userString"
- 	^ (String new: indentLevel withAll: Character tab), super userString
- !

Item was removed:
- ----- Method: IndentingListItemMorph>>widthOfColumn: (in category 'accessing - columns') -----
- widthOfColumn: columnIndex 
- 	| widthOrSpec |
- 	container columns ifNil: [ ^ self width ].
- 	widthOrSpec := container columns at: columnIndex.
- 	^ widthOrSpec isNumber
- 		ifTrue: [ widthOrSpec ]
- 		ifFalse:
- 			[ widthOrSpec isBlock
- 				ifTrue:
- 					[ widthOrSpec
- 						cull: container
- 						cull: self ]
- 				ifFalse:
- 					[ widthOrSpec
- 						ifNil: [ self width ]
- 						ifNotNil: [ "Fall back"
- 							50 ] ] ]!

Item was removed:
- ----- Method: IndentingListItemMorph>>withSiblingsDo: (in category 'private') -----
- withSiblingsDo: aBlock
- 
- 	| node |
- 	node := self.
- 	[node isNil] whileFalse: [
- 		aBlock value: node.
- 		node := node nextSibling
- 	].!

Item was removed:
- ----- Method: IndentingListItemMorph>>withoutListWrapper (in category 'converting') -----
- withoutListWrapper
- 
- 	^complexContents withoutListWrapper!



More information about the Squeak-dev mailing list