'From Cuis 1.0 of 4 September 2009 [latest update: #290] on 16 September 2009 at 9:55:17 am'!
!classDefinition: #MorphWithModel category: #'Morphic-Kernel'!
BorderedMorph subclass: #MorphWithModel
	instanceVariableNames: 'model slotName open '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Morphic-Kernel'!
!classDefinition: #PluggableButtonMorph category: #'Morphic-Windows'!
MorphWithModel subclass: #PluggableButtonMorph
	instanceVariableNames: ' label font getStateSelector actionSelector getLabelSelector getMenuSelector shortcutCharacter askBeforeChanging triggerOnMouseDown offColor onColor feedbackColor showSelectionFeedback allButtons arguments argumentsProvider argumentsSelector '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Morphic-Windows'!

!ImageSegment methodsFor: 'testing' stamp: 'jmv 9/16/2009 09:49'!
findRogueRootsPrep
	"Part of the tool to track down unwanted pointers into the segment.  Break all owner pointers in submorphs, scripts, and viewers in flaps."

| wld morphs |
wld _ arrayOfRoots detect: [:obj | 
	obj isMorph ifTrue: [obj isWorldMorph] ifFalse: [false]] ifNone: [nil].
wld ifNil: [wld _ arrayOfRoots detect: [:obj | obj isMorph] 
				ifNone: [^ self error: 'can''t find a root morph']].
morphs _ IdentitySet new: 400.
wld allMorphsDo: [ :m |  morphs add: m ].
morphs do: [:mm | 	"break the back pointers"
	mm isInMemory ifTrue: [
	(mm respondsTo: #target) ifTrue: [
		mm nearestOwnerThat: [:ow | ow == mm target 
			ifTrue: [mm target: nil. true]
			ifFalse: [false]]].
	(mm respondsTo: #arguments) ifTrue: [
		mm arguments do: [:arg | arg ifNotNil: [
			mm nearestOwnerThat: [:ow | ow == arg
				ifTrue: [mm arguments at: (mm arguments indexOf: arg) put: nil. true]
				ifFalse: [false]]]]].
	mm eventHandler ifNotNil: ["recipients point back up"
		(morphs includesAllOf: (mm eventHandler allRecipients)) ifTrue: [
			mm eventHandler: nil]].
]].
(Smalltalk includesKey: #Owners) ifTrue: [Smalltalk at: #Owners put: nil].
	"in case findOwnerMap: is commented out"
"self findOwnerMap: morphs."
morphs do: [:mm | 	"break the back pointers"
	mm isInMemory ifTrue: [mm privateOwner: nil]].
"more in extensions?"
! !


!LightWidget methodsFor: 'debug and other' stamp: 'jmv 9/16/2009 09:49'!
buildDebugMenu: aHand 
	"Answer a debugging menu for the receiver.  The hand argument is seemingly historical and plays no role presently"

	| aMenu |
	aMenu := MenuMorph new defaultTarget: self.
	aMenu addStayUpIcons.
	self isKnownFailing
		ifTrue: 
			[aMenu add: 'start drawing again' translated action: #resumeAfterDrawError.
			aMenu addLine].
	(self hasProperty: #errorOnStep) 
		ifTrue: 
			[aMenu add: 'start stepping again' translated action: #resumeAfterStepError.
			aMenu addLine].
	aMenu add: 'inspect morph' translated action: #inspectInMorphic:.
	aMenu add: 'inspect owner chain' translated action: #inspectOwnerChain.
	aMenu 
		add: 'explore morph' translated
		target: self
		selector: #explore.
	aMenu addLine.
	aMenu 
		add: 'browse morph class' translated
		target: self
		selector: #browseHierarchy.
	aMenu addLine.
	aMenu
		add: 'control-menu...' translated
			target: self
			selector: #invokeMetaMenu:;
		add: 'edit balloon help' translated action: #editBalloonHelpText.
	^aMenu! !


!Morph methodsFor: 'debug and other' stamp: 'jmv 9/16/2009 09:50'!
buildDebugMenu: aHand 
	"Answer a debugging menu for the receiver.  The hand argument is seemingly historical and plays no role presently"

	| aMenu |
	aMenu := MenuMorph new defaultTarget: self.
	aMenu addStayUpIcons.
	self isKnownFailing
		ifTrue: 
			[aMenu add: 'start drawing again' translated action: #resumeAfterDrawError.
			aMenu addLine].
	(self hasProperty: #errorOnStep) 
		ifTrue: 
			[aMenu add: 'start stepping again' translated action: #resumeAfterStepError.
			aMenu addLine].
	aMenu add: 'inspect morph' translated action: #inspectInMorphic:.
	aMenu add: 'inspect owner chain' translated action: #inspectOwnerChain.
	self hasModel 
		ifTrue: 
			[aMenu 
				add: 'inspect model' translated
				target: self model
				action: #inspect].
	aMenu 
		add: 'explore morph' translated
		target: self
		selector: #explore.
	aMenu addLine.
	aMenu 
		add: 'browse morph class' translated
		target: self
		selector: #browseHierarchy.
	self hasModel 
		ifTrue: 
			[aMenu 
				add: 'browse model class'
				target: self model
				selector: #browseHierarchy].
	aMenu addLine.
	aMenu
		add: 'control-menu...' translated
			target: self
			selector: #invokeMetaMenu:;
		add: 'edit balloon help' translated action: #editBalloonHelpText.
	^aMenu! !

!Morph methodsFor: 'testing' stamp: 'jmv 9/16/2009 09:50'!
hasModel
	^false! !


!MorphWithModel methodsFor: 'classification' stamp: 'jmv 9/16/2009 09:50'!
hasModel
	^true! !

!MorphWithModel methodsFor: 'initialization' stamp: 'jmv 9/16/2009 09:41'!
model: thang slotName: nameOfThisPart
	model _ thang.
	slotName _ nameOfThisPart! !

ScrollPane removeSelector: #wantsSlot!
ScrollBar removeSelector: #wantsSlot!
PluggableButtonMorph removeSelector: #model:!
!classDefinition: #PluggableButtonMorph category: #'Morphic-Windows'!
MorphWithModel subclass: #PluggableButtonMorph
	instanceVariableNames: 'label font getStateSelector actionSelector getLabelSelector getMenuSelector shortcutCharacter askBeforeChanging triggerOnMouseDown offColor onColor feedbackColor showSelectionFeedback allButtons arguments argumentsProvider argumentsSelector'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Morphic-Windows'!
MorphWithModel class removeSelector: #acceptsLoggingOfCompilation!
MorphWithModel class removeSelector: #compileAccessorsFor:!
MorphWithModel class removeSelector: #compilePropagationForVarName:slotName:!
MorphWithModel class removeSelector: #wantsChangeSetLogging!
MorphWithModel removeSelector: #addCustomMenuItems:hand:!
MorphWithModel removeSelector: #addPartNameLike:withValue:!
MorphWithModel removeSelector: #closeToEdits!
MorphWithModel removeSelector: #compileAccessForSlot:!
MorphWithModel removeSelector: #compileInitMethods!
MorphWithModel removeSelector: #compilePropagationMethods!
MorphWithModel removeSelector: #delete!
MorphWithModel removeSelector: #initString!
MorphWithModel removeSelector: #initialize!
MorphWithModel removeSelector: #isMorphicModel!
MorphWithModel removeSelector: #isOpen!
MorphWithModel removeSelector: #nameFor:!
MorphWithModel removeSelector: #openToEdits!
MorphWithModel removeSelector: #slotName!
MorphWithModel removeSelector: #slotSelectorFor:!
MorphWithModel removeSelector: #wantsSlot!
!classDefinition: #MorphWithModel category: #'Morphic-Kernel'!
BorderedMorph subclass: #MorphWithModel
	instanceVariableNames: 'model slotName'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Morphic-Kernel'!
Morph removeSelector: #initString!
Object removeSelector: #isMorphicModel!
