'From Squeak6.0alpha of 19 January 586155 [latest update: #19601] on 23 April 2020 at 12:14:01 pm'!
Error subclass: #ModificationForbidden
	instanceVariableNames: 'mirror object fieldIndex newValue retrySelector resumptionValue '
	classVariableNames: 'ManagedObjects '
	poolDictionaries: ''
	category: 'Kernel-Exceptions'!

!ModificationForbidden methodsFor: 'printing' stamp: 'mt 4/23/2020 11:38'!
printObject: obj on: s
	[obj printOn: s]
		ifError: [ s << '<cannot print object>' ]! !

!ModificationForbidden methodsFor: 'handling - private' stamp: 'mt 4/23/2020 12:07'!
defaultAction

	^ (ManagedObjects notNil and: [ManagedObjects includesKey: self object])
		ifTrue: [(ManagedObjects at: self object) cull: self object cull: self]
		ifFalse: [super defaultAction]! !

!ModificationForbidden methodsFor: 'handling - private' stamp: 'mt 4/23/2020 11:39'!
isResumable

	^ true! !


!ModificationForbidden class methodsFor: 'managed objects' stamp: 'mt 4/23/2020 12:12'!
for: anObjectToManage send: aMessageSend
	"Re-direct an unhandled modification-forbidden error on a per-object basis."

	ManagedObjects ifNil: [ManagedObjects := WeakIdentityKeyDictionary new].
	
	aMessageSend
		ifNil: [ManagedObjects removeKey: anObjectToManage ifAbsent: []]
		ifNotNil: [ManagedObjects at: anObjectToManage put: aMessageSend].! !

!ModificationForbidden class methodsFor: 'managed objects' stamp: 'mt 4/23/2020 12:10'!
for: anObjectToManage send: messageOrSymbol to: aReceiver
	"For convenience."
	
	| messageSend |
	messageSend := messageOrSymbol isSymbol
		ifTrue: [MessageSend receiver: aReceiver selector: messageOrSymbol]
		ifFalse: [messageOrSymbol copy receiver: aReceiver].
	
	self for: anObjectToManage send: messageSend.! !

!ModificationForbidden class methodsFor: 'managed objects' stamp: 'mt 4/23/2020 11:53'!
ignore: anObjectNotToManage
	"Do not re-direct unhandled modification-forbidden errors for a specific object anymore."
	
	self for: anObjectNotToManage send: nil.! !

Error subclass: #ModificationForbidden
	instanceVariableNames: 'mirror object fieldIndex newValue retrySelector resumptionValue'
	classVariableNames: 'ManagedObjects'
	poolDictionaries: ''
	category: 'Kernel-Exceptions'!

!ModificationForbidden reorganize!
('initialization' mirror:object:index:newValue:resumptionValue:retrySelector: mirror:object:index:newValue:retrySelector:)
('accessing' fieldIndex mirror newValue object resumptionValue resumptionValue: retrySelector)
('printing' indexedMessageText messageText nonIndexedMessageText printObject:on: standardMessageText)
('handling - retrying' retryModification retryModificationNoResume)
('handling' resume)
('handling - private' defaultAction isResumable)
!