[BUG][FIX][ENH] ObjectExplorer & SimpleHierarchicalListMorph miscellania

Bob Arning arning at charm.net
Mon Sep 6 16:40:12 UTC 1999


The enclosed filein provides a number of fixes and enhancements to ObjectExplorer & SimpleHierarchicalListMorph. One question is: Is the ObjectExplorer sufficiently popular that we might consider using it instead of #inspect for cmd-i?

Cheers,
Bob

======================
'From Squeak 2.5 of August 6, 1999 on 6 September 1999 at 11:49:06 am'!
"Change Set:		HListUpdates
Date:			6 September 1999
Author:			Bob Arning

Some fixes/enhancements to the hierarchical list gizmos

1. When collapsing an item removes the selected item, remove the selection and so notify the model.
2. Handle yellow button presses (as opposed to using the menu button) in the list pane correctly.
3. Allow individual list items to specify a highlighting color (including none) so that color-coding schemes do not get trampled.
4. Allow program controlled expansion and selection of hierarchical items to an arbitrary depth.
5. Modify the triangle forms to Display depth so that weak colors will work.
6. Add an 'explore' item to the menu used by Inspector and Debugger.
7. Fix problem with items representing <nil> being erroneously selected."!


!Object methodsFor: 'converting' stamp: 'RAA 8/2/1999 12:41'!
complexContents

	^self! !


!IndentingListItemMorph methodsFor: 'mouse events' stamp: 'RAA 8/5/1999 19:28'!
handlesMouseDown: evt

	"if user wants a menu, let the pane handle it"

	^evt yellowButtonPressed not! !

!IndentingListItemMorph methodsFor: 'drawing' stamp: 'RAA 8/3/1999 09:47'!
highlight

	complexContents highlightingColor ifNotNil: [self color: complexContents highlightingColor].
	self changed.
	
! !

!IndentingListItemMorph methodsFor: 'drawing' stamp: 'RAA 8/3/1999 09:46'!
unhighlight

	complexContents highlightingColor ifNotNil: [self color: Color black].
	self changed.
	
	
! !

!IndentingListItemMorph methodsFor: 'as yet unclassified' stamp: 'RAA 8/2/1999 16:48'!
firstChild

	^firstChild! !

!IndentingListItemMorph methodsFor: 'as yet unclassified' stamp: 'RAA 8/4/1999 17:40'!
openPath: anArray

	anArray isEmpty ifTrue: [^container setSelectedMorph: nil].
	self withSiblingsDo: [:each | 
		(each complexContents asString = anArray first or: [anArray first isNil]) ifTrue: [
			each isExpanded ifFalse: [
				each toggleExpandedState.
				container adjustSubmorphPositions.
			].
			each changed.
			anArray size = 1 ifTrue: [
				^container setSelectedMorph: each
			].
			each firstChild ifNil: [^container setSelectedMorph: nil].
			^each firstChild openPath: anArray allButFirst.
		].
	].
	^container setSelectedMorph: nil

! !

!IndentingListItemMorph methodsFor: 'as yet unclassified' stamp: 'RAA 8/2/1999 12:38'!
toggleExpandedState

 	| newChildren toDelete |

	isExpanded _ isExpanded not.
	toDelete _ OrderedCollection new.
	firstChild ifNotNil: [
		firstChild withSiblingsDo: [ :aNode | aNode recursiveAddTo: toDelete].
	].
	container noteRemovalOfAll: toDelete.
	(isExpanded and: [complexContents hasContents]) ifFalse: [
		^self changed
	].
	newChildren _ container 
		addSubmorphsAfter: self 
		fromCollection: complexContents contents 
		allowSorting: true.
	firstChild _ newChildren first.
	firstChild withSiblingsDo: [ :aNode |
		aNode indentLevel: indentLevel + 1.
	].
! !


!Inspector methodsFor: 'menu commands' stamp: 'RAA 9/6/1999 11:36'!
exploreSelection
	"Open an ObjectExplorer on the receiver's model's currently selected object."

	self selectionIndex = 0 ifTrue: [^ self changed: #flash].
	^ self selection explore! !

!Inspector methodsFor: 'menu commands' stamp: 'RAA 9/6/1999 11:36'!
fieldListMenu: aMenu

	^ aMenu labels: 'inspect
explore
method refs to this inst var
objects pointing to this value
copy name
browse full
browse class
inst var refs...
inst var defs...
class var refs...
class variables
class refs
basic inspect'
	lines: #(2 4 5  7 9 12 )
	selections: #(inspectSelection exploreSelection referencesToSelection objectReferencesToSelection copyName  browseMethodFull browseClass browseInstVarRefs browseInstVarDefs classVarRefs browseClassVariables browseClassRefs inspectBasic).
! !


!ListItemWrapper methodsFor: 'as yet unclassified' stamp: 'RAA 8/3/1999 09:40'!
highlightingColor

	^Color red! !


!SimpleHierarchicalListMorph methodsFor: 'drawing' stamp: 'RAA 8/3/1999 09:44'!
highlightSelection

	selectedMorph ifNotNil: [selectedMorph highlight]! !

!SimpleHierarchicalListMorph methodsFor: 'drawing' stamp: 'RAA 8/3/1999 09:44'!
unhighlightSelection
	selectedMorph ifNotNil: [selectedMorph unhighlight]! !

!SimpleHierarchicalListMorph methodsFor: 'selection' stamp: 'RAA 8/31/1999 08:36'!
selection: item
	"Called from outside to request setting a new selection.
	Assumes scroller submorphs is exactly our list.
	Note: MAY NOT work right if list includes repeated items"

	| i |
	item ifNil: [^self selectionIndex: 0].
	i _ scroller submorphs findFirst: [:m | m complexContents == item].
	i > 0 ifTrue: [^self selectionIndex: i].
	i _ scroller submorphs findFirst: [:m | m withoutListWrapper = item withoutListWrapper].
	self selectionIndex: i! !

!SimpleHierarchicalListMorph methodsFor: 'updating' stamp: 'RAA 8/4/1999 17:39'!
update: aSymbol 

	aSymbol == getSelectionSelector ifTrue:
		[self selection: self getCurrentSelectionItem.
		^ self].
	aSymbol == getListSelector ifTrue: 
		[self list: self getList.
		^ self].
	((aSymbol isKindOf: Array) and: [aSymbol size > 0 and: [aSymbol first == #openPath]]) ifTrue: [
		^(scroller submorphs at: 1 ifAbsent: [^self]) openPath: aSymbol allButFirst
	].

! !

!SimpleHierarchicalListMorph methodsFor: 'as yet unclassified' stamp: 'RAA 8/30/1999 10:19'!
expandedForm

	^expandedForm ifNil: [expandedForm _ 
(Form
	extent: 10 at 10
	depth: 8
	fromArray: #( 4294967295 4294967295 4294901760 4294967295 4294967295 4294901760 4294967295 4294967295 4294901760 4278255873 16843009 16842752 4294902089 1229539657 33488896 4294967041 1229539585 4294901760 4294967295 21561855 4294901760 4294967295 4278321151 4294901760 4294967295 4294967295 4294901760 4294967295 4294967295 4294901760)
	offset: 0 at 0) asFormOfDepth: Display depth.
	expandedForm replaceColor: Color white withColor: color.
	expandedForm
	].
! !

!SimpleHierarchicalListMorph methodsFor: 'as yet unclassified' stamp: 'RAA 8/30/1999 10:19'!
notExpandedForm

	^notExpandedForm ifNil: [notExpandedForm _ 
(Form
	extent: 10 at 10
	depth: 8
	fromArray: #( 4294967295 4294967295 4294901760 4294967041 4294967295 4294901760 4294967041 33554431 4294901760 4294967041 1224867839 4294901760 4294967041 1229521407 4294901760 4294967041 1229539585 4294901760 4294967041 1229521407 4294901760 4294967041 1224867839 4294901760 4294967041 33554431 4294901760 4294967041 4294967295 4294901760)
	offset: 0 at 0) asFormOfDepth: Display depth.
	notExpandedForm replaceColor: Color white withColor: color.
	notExpandedForm

]! !

!SimpleHierarchicalListMorph methodsFor: 'as yet unclassified' stamp: 'RAA 8/2/1999 12:42'!
noteRemovalOfAll: aCollection

	scroller removeAllMorphsIn: aCollection.
	(aCollection includes: selectedMorph) ifTrue: [self setSelectedMorph: nil].! !





More information about the Squeak-dev mailing list