[squeak-dev] The Inbox: System-fbs.595.mcz

commits at source.squeak.org commits at source.squeak.org
Thu Sep 19 21:28:34 UTC 2013


A new version of System was added to project The Inbox:
http://source.squeak.org/inbox/System-fbs.595.mcz

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

Name: System-fbs.595
Author: fbs
Time: 19 September 2013, 10:28:26.089 pm
UUID: ce3d56a2-594f-764a-9abf-37009e28b231
Ancestors: System-fbs.594

Remove all tracking of recent method submission from Utilities, putting it into a separate RecentMessages object.

Leave some deprecated stubs in place for things still expecting the Utilities facilities.

Note the stubby Environment awareness in ChangeRecord and friends. These preserve the behaviour of #fileIn putting things in Smalltalk globals, while still allowing you to specify an Environment. (This seemed less invasive than throwing EnvironmentRequests.) We need this because recent method submissions should not cross Environment boundaries - when we make a method submission, we should track in which Environment you made the change (through AbstractEvent >> #environment:)

=============== Diff against System-fbs.594 ===============

Item was changed:
+ (PackageInfo named: 'System') preamble: '"Prepare for removing the recent-message-tracking from Utilities."
+ SystemChangeNotifier uniqueInstance noMoreNotificationsFor: Utilities.
- (PackageInfo named: 'System') preamble: 'Smalltalk forgetDoIts. "Just to be sure we don''t have any behind."
  
+ Smalltalk forgetDoIts. "Just to be sure we don''t have any behind."
+ 
  "Remove line feed characters from methods. MC doesn''t see them changed, so it''s not possible to fix them without changing their timestamp."
   {{BlockContext . #durationToRun} . {BlockContext . #forkAt:named:} . {BlockContext . #forkNamed:} . {BreakpointManager class . #clear} . {CompiledMethodInspector . #contentsIsString} . {CompiledMethodInspector . #selectionUnmodifiable} . {Delay class . #forDuration:} . {DigitalSignatureAlgorithm . #initRandomNonInteractively} . {DummySoundSystem . #randomBitsFromSoundInput:} . {EToyVocabulary . #categoryListForInstance:ofClass:limitClass:} . {FormCanvas class . #extent:depth:origin:clipRect:} . {HTTPClient class . #isRunningInBrowser:} . {Integer . #asYear} . {KeyedSet . #addAll:} . {KeyedSet . #at:ifAbsentPut:} . {KeyedSet . #keysDo:} . {KeyedSet class . #keyBlock:} . {MCMcmReader . #configuration} . {MCMcmReader . #loadConfiguration} . {MCMcmReader . #loadVersionInfo} . {MCMcmReader . #version} . {MethodWithInterface . #allScriptActivationButtons} . {Month class . #indexOfMonth:} . {Number . #asDuration} . {Number . #day} . {Number . #days} . {Number . #hour} . {Number . #hours} . {Number . #milliSecond} . {Number . #milliSeconds} . {Number . #minute} . {Number . #minutes} . {Number . #nanoSecond} . {Number . #nanoSeconds} . {Number . #second} . {Number . #seconds} . {Number . #week} . {Number . #weeks} . {Object . #fixUponLoad:seg:} . {Object class . #categoryForUniclasses} . {PasteUpMorph . #drawSubmorphsOn:} . {PasteUpMorph . #handsDo:} . {PasteUpMorph . #handsReverseDo:} . {PasteUpMorph . #morphsInFrontOf:overlapping:do:} . {PasteUpMorph . #putUpNewMorphMenu} . {PasteUpMorph . #undoOrRedoCommand} . {Pen . #putDotOfDiameter:at:} . {Player . #getCount} . {Player . #getDotSize} . {Player . #getStringContents} . {Player . #getTrailStyle} . {Player . #insertCharacters:} . {Player . #insertContentsOf:} . {Player . #setDotSize:} . {Player . #setTrailStyle:} . {Player . #tellAllContents:} . {Player . #trailStyleForAllPens:} . {PreDebugWindow . #storeLog} . {Preferences class . #standaloneSecurityChecksEnabled} . {Process . #name} . {RecordingControlsMorph . #playback} . {RecordingControlsMorph . #trim} . {RunArray . #reversed} . {SampledSound class . #assimilateSoundsFrom:} . {SampledSound class . #universalSoundKeys} . {ScriptActivationButton . #addCustomMenuItems:hand:} . {SearchingViewer . #doSearchFrom:} . {SecurityManager . #printStateOn:} . {SoundReadoutTile . #handlerForMouseDown:} . {SoundReadoutTile . #setLiteral:} . {SoundReadoutTile . #updateLiteralLabel} . {SoundRecorder . #hasRecordedSound} . {SoundRecorder . #verifyExistenceOfRecordedSound} . {SoundTile . #handlerForMouseDown:} . {StackMorph . #addPageControlMorph:} . {StackMorph . #naturalPaneOrder} . {Stream . #isTypeHTTP} . {String . #asDateAndTime} . {String . #asDuration} . {String . #asTimeStamp} . {String . #asVersion} . {StringMorphEditor . #initialize} . {TextMorph . #cursorWrapped:} . {TextMorph . #elementCount} . {VersionHistory . #addNewVersionBasedOn:} . {VersionHistory . #allVersionsAfter:} . {VersionHistory . #allVersionsBefore:} . {VersionHistory . #canRemove:} . {VersionHistory . #firstVersion} . {VersionHistory . #includesVersion:} . {VersionHistory . #initializeVersionsAt:} . {VersionHistory . #mainLineStartingAt:} . {VersionHistory . #remove:} . {VersionHistory . #remove:ifAbsent:} . {VersionHistory . #removeBranch:} . {VersionHistory . #treeString} . {VersionHistory . #treeStringOn:startingAt:} . {VersionHistory . #treeStringStartingAt:} . {VersionHistory . #versionBefore:} . {VersionHistory . #versionsAfter:} . {VersionHistory class . #startingAt1} . {VersionHistory class . #startingAt:} . {VersionNumber . #<} . {VersionNumber . #=} . {VersionNumber . #branchNext} . {VersionNumber . #commonBase:} . {VersionNumber . #hash} . {VersionNumber . #inSameBranchAs:} . {VersionNumber . #initializeNumbers:} . {VersionNumber . #next} . {VersionNumber . #numbers} . {VersionNumber . #previous} . {VersionNumber . #printOn:} . {VersionNumber . #storeOn:} . {VersionNumber class . #first} . {VersionNumber class . #fromCollection:} . {VersionNumber class . #fromString:} . {ViewerLine . #removeGetterFeedback} . {ViewerLine . #removeHighlightFeedback} . {ViewerLine . #removeSetterFeedback} . {Vocabulary class . #initializeSilently}}	do: [ :each |
  	| class selector method |
  	class := each first.
  	selector := each second.
  	method := class >> selector.
  	SystemChangeNotifier uniqueInstance doSilently: [ "No dirty packages please!!"
  		class
  			compile: method getSource asString withSqueakLineEndings
  			classified: (class organization categoryOfElement: selector)
  			withStamp: method timeStamp
  			notifying: nil ] ].'!

Item was added:
+ ----- Method: AbstractEvent>>environment (in category 'accessing') -----
+ environment
+ 	^ environment.!

Item was changed:
  ----- Method: ChangeRecord>>fileIn (in category 'initialization') -----
  fileIn
+ 	^ self fileIn: Smalltalk globals.!
- 	"File the receiver in.  If I represent a method or a class-comment, file the method in and make a note of it in the recent-submissions list; if I represent a do-it, then, well, do it; if I represent a reorganization then get organized!!"
- 
- 	Cursor read showWhile:
- 		[| s cls aSelector |
- 		type == #doIt
- 			ifTrue:
- 				[((s := self string) beginsWith: '----') ifFalse: [Compiler evaluate: s]]
- 			ifFalse:
- 				[cls := self methodClass.
- 				 type == #method ifTrue:
- 					[cls compile: self text classified: category withStamp: stamp notifying: nil.
- 					(aSelector := self methodSelector) ifNotNil:
- 						[Utilities noteMethodSubmission: aSelector forClass: cls]].
- 				 type == #classComment ifTrue:
- 					[cls comment: self text stamp: stamp.
- 					Utilities noteMethodSubmission: #Comment forClass: cls ].
- 				 type == #reorganize ifTrue:
- 					[cls organization changeFromString: self text]]]!

Item was added:
+ ----- Method: ChangeRecord>>fileIn: (in category 'initialization') -----
+ fileIn: anEnvironment
+ 	"File the receiver in.  If I represent a method or a class-comment, file the method in and make a note of it in the recent-submissions list; if I represent a do-it, then, well, do it; if I represent a reorganization then get organized!!"
+ 
+ 	Cursor read showWhile:
+ 		[| s cls aSelector |
+ 		type == #doIt
+ 			ifTrue:
+ 				[((s := self string) beginsWith: '----') ifFalse: [Compiler evaluate: s]]
+ 			ifFalse:
+ 				[cls := self methodClass.
+ 				 type == #method ifTrue:
+ 					[[cls compile: self text classified: category withStamp: stamp notifying: nil]
+ 					on: EnvironmentRequest do: [:e | e resume: anEnvironment].
+ 					(aSelector := self methodSelector) ifNotNil:
+ 						[RecentMessages default recordSelector: aSelector forClass: cls inEnvironment: anEnvironment]].
+ 				 type == #classComment ifTrue:
+ 					[cls comment: self text stamp: stamp.
+ 					RecentMessages default recordSelector: #Comment forClass: cls inEnvironment: anEnvironment].
+ 				 type == #reorganize ifTrue:
+ 					[cls organization changeFromString: self text]]]!

Item was changed:
  ----- Method: ChangeRecord>>methodClass (in category 'access') -----
  methodClass
+ 	^ self methodClass: Smalltalk globals.!
- 	| methodClassName methodClass |
- 	(#(method #classComment) includes: type) ifFalse: [ ^ nil ].
- 	methodClassName := class subStrings
- 		ifEmpty: [ ^ nil ]
- 		ifNotEmptyDo:
- 			[ : parts | parts first asSymbol ].
- 	(Smalltalk globals includesKey: methodClassName) ifFalse: [ ^ nil ].
- 	methodClass := Smalltalk at: methodClassName.
- 	^ meta
- 		ifTrue: [ methodClass class ]
- 		ifFalse: [ methodClass ]!

Item was added:
+ ----- Method: ChangeRecord>>methodClass: (in category 'access') -----
+ methodClass: anEnvironment
+ 	| methodClassName methodClass |
+ 	(#(method #classComment) includes: type) ifFalse: [ ^ nil ].
+ 	methodClassName := class subStrings
+ 		ifEmpty: [ ^ nil ]
+ 		ifNotEmptyDo:
+ 			[ : parts | parts first asSymbol ].
+ 	(anEnvironment includesKey: methodClassName) ifFalse: [ ^ nil ].
+ 	methodClass := anEnvironment at: methodClassName.
+ 	^ meta
+ 		ifTrue: [ methodClass class ]
+ 		ifFalse: [ methodClass ]!

Item was changed:
  Object subclass: #ClassChangeRecord
  	instanceVariableNames: 'inForce revertable changeTypes thisDefinition priorDefinition thisName priorName thisOrganization priorOrganization thisComment priorComment thisMD priorMD methodChanges'
  	classVariableNames: ''
  	poolDictionaries: ''
  	category: 'System-Changes'!
  
+ !ClassChangeRecord commentStamp: 'fbs 9/6/2013 17:32' prior: 0!
+ A ClassChangeRecorder keeps track of most substantive changes permissible in a project, isolated or not.
- !ClassChangeRecord commentStamp: '<historical>' prior: 0!
- A ClassChangeRecorder keeps track of most substantive changes premissible in a project, isolated or not.
  
  Structure:
  inForce		a boolean
  			Tells whether these changes are in effect.
  			true for all changeSets in and above the current project.
  			It should be sufficient only to record this for the changeSet
  			as a whole, but this redundancy could help in error recovery.
  classIsLocal	a boolean
  			True if and only if this class is defined in this layer of the
  			project structure.
  changeTypes an identitySet
  			Summarizes which changes have been made in this class.
  			Values include #comment, #reorganize, #rename,
  			and the four more summarized below.
  thisName	a string
  			Retains the class name for this layer.
  priorName	a string
  			Preserves the prior name.
  thisComment	a text
  			Retains the class comment for this layer.
  priorComment	a text
  			Preserves the prior comment.
  thisOrganization	a classOrganizer
  			Retains the class organization for this layer.
  priorOrganization	a classOrganizer
  			Preserves the prior organization.
  thisMD	a methodDictionary
  			Used to prepare changes for nearly atomic invocation
  			of this layer (see below).
  priorMD	a methodDictionary
  			Preserves the state of an altered class as it exists in the next
  			outer layer of the project structure.
  methodChanges		a dictionary of classChangeRecords
  			Retains all the method changes for this layer.
  
  Four of the possible changeTypes are maintained in a mutually exclusive set, analogously to MethodChangeRecords.  Here is a simple summary of the relationship between these four changeType symbols and the recording of prior state
  			|	prior == nil			|	prior not nil	
  	---------	|----------------------------	|--------------------
  	add		|	add					|	change
  	---------	|----------------------------	|--------------------
  	remove	|	addedThenRemoved	|	remove
  
  A classChangeRecorder is notified of changes by the method
  		noteMethodChange: <ClassChangeRecord>.
  ClassChangeRecorders are designed to invoke a set of changes relative to the definition of a class in an prior layer.  It is important that both invocation and revocation of these changes take place in a nearly atomic fashion so that interdependent changes will be adopted as a whole, and so that only one flush of the method cache should be necessary.  A further reason for revocation to be simple is that it may be requested as an attempt to recover from an error in a project that is failing.!

Item was changed:
  ----- Method: ClassChangeRecord>>realClass (in category 'isolation layers') -----
  realClass
+ 	^ self realClass: Smalltalk globals.!
- 	"Return the actual class (or meta), as determined from my name."
- 
- 	thisName ifNil: [^ nil].
- 	(thisName endsWith: ' class')
- 		ifTrue: [^ (Smalltalk at: (thisName copyFrom: 1 to: thisName size - 6) asSymbol
- 						ifAbsent: [^ nil]) class]
- 		ifFalse: [^ Smalltalk at: thisName ifAbsent: [^ nil]]!

Item was added:
+ ----- Method: ClassChangeRecord>>realClass: (in category 'isolation layers') -----
+ realClass: anEnvironment
+ 	"Return the actual class (or meta), as determined from my name."
+ 	thisName ifNil: [^ nil].
+ 	(thisName endsWith: ' class')
+ 		ifTrue: [^ (anEnvironment at: (thisName copyFrom: 1 to: thisName size - 6) asSymbol
+ 						ifAbsent: [nil]) class]
+ 		ifFalse: [^ anEnvironment at: thisName ifAbsent: [nil]]!

Item was added:
+ Object subclass: #RecentMessages
+ 	instanceVariableNames: 'methodReferences size maximumSubmissionCount'
+ 	classVariableNames: 'Default NumberOfRecentSubmissionsToStore'
+ 	poolDictionaries: ''
+ 	category: 'System-Support'!

Item was added:
+ ----- Method: RecentMessages class>>default (in category 'accessing') -----
+ default
+ 	^ Default ifNil: [Default := RecentMessages newRemembering: self numberOfRecentSubmissionsToStore].!

Item was added:
+ ----- Method: RecentMessages class>>newRemembering: (in category 'instance creation') -----
+ newRemembering: anInteger
+ 	^ self basicNew initializeWithSize: anInteger.!

Item was added:
+ ----- Method: RecentMessages class>>numberOfRecentSubmissionsToStore (in category 'preferences') -----
+ numberOfRecentSubmissionsToStore
+ 	<preference: 'Number of recent submissions to store'
+ 		category: 'Tools'
+ 		description: 'Answer how many methods back the ''recent method submissions'' history should store'
+ 		type: #Number>
+ 	^NumberOfRecentSubmissionsToStore
+ 		ifNil: [NumberOfRecentSubmissionsToStore := 30].!

Item was added:
+ ----- Method: RecentMessages class>>numberOfRecentSubmissionsToStore: (in category 'preferences') -----
+ numberOfRecentSubmissionsToStore: anInteger
+ 	NumberOfRecentSubmissionsToStore := anInteger.!

Item was added:
+ ----- Method: RecentMessages class>>setRecentHistorySize (in category 'preferences') -----
+ setRecentHistorySize
+ 	"Let the user specify the recent history size"
+ 
+ 	| aReply aNumber |
+ 	aReply := UIManager default request: 'How many recent methods
+ should be maintained?' initialAnswer: self numberOfRecentSubmissionsToStore asString.
+ 	aReply isEmptyOrNil ifFalse:
+ 		[aNumber := aReply asNumber rounded.
+ 		(aNumber > 1 and: [aNumber <= 1000])
+ 			ifTrue:
+ 				[self numberOfRecentSubmissionsToStore: aNumber.
+ 				self inform: 'Okay, ', aNumber asString, ' is the new size of the recent method history']
+ 			ifFalse:
+ 				[self inform: 'Sorry, must be a number between 2 & 1000']]!

Item was added:
+ ----- Method: RecentMessages class>>startUp (in category 'system startup') -----
+ startUp
+ 	SystemChangeNotifier uniqueInstance
+ 		notify: self default
+ 		ofAllSystemChangesUsing: #event:.!

Item was added:
+ ----- Method: RecentMessages>>defaultSize (in category 'private') -----
+ defaultSize
+ 	^ 10.!

Item was added:
+ ----- Method: RecentMessages>>event: (in category 'change logging') -----
+ event: anEvent
+ 	"Hook for SystemChangeNotifier"
+ 
+ 	(anEvent isCommented and: [anEvent itemKind = SystemChangeNotifier classKind])
+ 		ifTrue: [self recordSelector: #Comment forClass: anEvent item inEnvironment: anEvent environment].
+ 	((anEvent isAdded or: [anEvent isModified]) and: [anEvent itemKind = SystemChangeNotifier methodKind])
+ 		ifTrue: [
+ 			anEvent itemRequestor
+ 				ifNotNil: [self recordSelector: anEvent itemSelector forClass: anEvent itemClass inEnvironment: anEvent environment].
+ 			InMidstOfFileinNotification signal
+ 				ifFalse: [Utilities changed: #recentMethodSubmissions]].!

Item was added:
+ ----- Method: RecentMessages>>initialize (in category 'initialize-release') -----
+ initialize
+ 	maximumSubmissionCount := self defaultSize.
+ 	methodReferences := OrderedCollection new.!

Item was added:
+ ----- Method: RecentMessages>>initializeWithSize: (in category 'initialize-release') -----
+ initializeWithSize: anInteger
+ 	maximumSubmissionCount := anInteger.
+ 	methodReferences := OrderedCollection new.!

Item was added:
+ ----- Method: RecentMessages>>isEmpty (in category 'testing') -----
+ isEmpty
+ 	^ methodReferences isEmpty.!

Item was added:
+ ----- Method: RecentMessages>>maximumSubmissionCount (in category 'accessing') -----
+ maximumSubmissionCount
+ 	^ maximumSubmissionCount.!

Item was added:
+ ----- Method: RecentMessages>>maximumSubmissionCount: (in category 'accessing') -----
+ maximumSubmissionCount: anInteger
+ 	maximumSubmissionCount := anInteger.
+ 	[self size > self maximumSubmissionCount]
+ 		whileTrue: [methodReferences removeFirst].!

Item was added:
+ ----- Method: RecentMessages>>methodReferences (in category 'accessing') -----
+ methodReferences
+ 	"Return A COPY of all method references."
+ 	^ Array withAll: methodReferences.!

Item was added:
+ ----- Method: RecentMessages>>mostRecent (in category 'accessing') -----
+ mostRecent
+ 	[methodReferences notEmpty and: [methodReferences last isValid not]]
+ 	whileTrue: [methodReferences removeLast].
+ 	^ methodReferences last.!

Item was added:
+ ----- Method: RecentMessages>>oldest (in category 'accessing') -----
+ oldest
+ 	^ methodReferences
+ 		ifEmpty: [nil]
+ 		ifNotEmpty: [methodReferences first].!

Item was added:
+ ----- Method: RecentMessages>>purge: (in category 'accessing') -----
+ purge: aMethodReference 
+ 	methodReferences remove: aMethodReference.!

Item was added:
+ ----- Method: RecentMessages>>purgeMissingMethods (in category 'accessing') -----
+ purgeMissingMethods
+ 	methodReferences := methodReferences select: [:mref | |cls|
+ 		cls := mref actualClass.
+ 		cls notNil
+ 			and: [cls isInMemory]
+ 			and: [mref selector == #Comment or: [(cls compiledMethodAt: mref selector ifAbsent: [nil]) notNil]]].!

Item was added:
+ ----- Method: RecentMessages>>recordSelector:forClass:inEnvironment: (in category 'accessing') -----
+ recordSelector: aSelector forClass: aClass inEnvironment: anEnvironment
+ 	| ref |
+ 	ref := MethodReference
+ 			class: aClass
+ 			selector: aSelector
+ 			environment: anEnvironment.
+ 	aClass wantsChangeSetLogging ifFalse: [^ ref].
+ 	^ methodReferences
+ 		detect: [:mref | mref = ref]
+ 		ifNone: [methodReferences addLast: ref.
+ 			self size > self maximumSubmissionCount
+ 				ifTrue: [methodReferences removeFirst].
+ 			ref].!

Item was added:
+ ----- Method: RecentMessages>>revertLast (in category 'accessing') -----
+ revertLast
+ 	"If the most recent method submission was a method change, revert
+ 	that change, and if it was a submission of a brand-new method, 
+ 	remove that method."
+ 	| changeRecords lastSubmission theClass theSelector |
+ 
+ 	methodReferences ifEmpty: [^ Beeper beep].
+ 	lastSubmission := methodReferences last.
+ 	theClass := lastSubmission actualClass ifNil: [^ Beeper beep].
+ 	theSelector := lastSubmission methodSymbol.
+ 	changeRecords := theClass changeRecordsAt: theSelector.
+ 	changeRecords isEmptyOrNil ifTrue: [^ Beeper beep].
+ 	changeRecords size = 1
+ 		ifTrue:
+ 			["method has no prior version, so reverting in this case means removing"
+ 			theClass removeSelector: theSelector]
+ 		ifFalse:
+ 			[changeRecords second fileIn].!

Item was added:
+ ----- Method: RecentMessages>>size (in category 'accessing') -----
+ size
+ 	^ methodReferences size.!

Item was changed:
  Object subclass: #Utilities
  	instanceVariableNames: ''
+ 	classVariableNames: 'AuthorInitials AuthorName CommonRequestStrings LastStats UpdateDownloader UpdateUrlLists'
- 	classVariableNames: 'AuthorInitials AuthorName CommonRequestStrings LastStats RecentSubmissions UpdateDownloader UpdateUrlLists'
  	poolDictionaries: ''
  	category: 'System-Support'!
  
  !Utilities commentStamp: '<historical>' prior: 0!
  A repository for general and miscellaneous utilities; much of what is here are in effect global methods that don't naturally attach to anything else.  1/96 sw!

Item was removed:
- ----- Method: Utilities class>>assureMostRecentSubmissionExists (in category 'recent method submissions') -----
- assureMostRecentSubmissionExists
- 	"Make certain that the most recent submission exists"
- 
- 	[RecentSubmissions size > 0 and:
- 		[RecentSubmissions last isValid not]] whileTrue:
- 			[RecentSubmissions removeLast].!

Item was removed:
- ----- Method: Utilities class>>dumpAnyOldStyleRecentSubmissions (in category 'recent method submissions') -----
- dumpAnyOldStyleRecentSubmissions
- 
- 	"simplify conversion by purging those recent submissions which are still Strings"
- 
- 	RecentSubmissions := self recentMethodSubmissions reject: [ :each |
- 		each isString
- 	].!

Item was removed:
- ----- Method: Utilities class>>event: (in category 'recent method submissions') -----
- event: anEvent
- 	"Hook for SystemChangeNotifier"
- 
- 	(anEvent isCommented and: [anEvent itemKind = SystemChangeNotifier classKind])
- 		ifTrue: [self noteMethodSubmission: #Comment forClass: anEvent item].
- 	((anEvent isAdded or: [anEvent isModified]) and: [anEvent itemKind = SystemChangeNotifier methodKind])
- 		ifTrue: [anEvent itemRequestor ifNotNil: [self noteMethodSubmission: anEvent itemSelector forClass: anEvent itemClass]].
- 	((anEvent isAdded or: [anEvent isModified]) and: [anEvent itemKind = SystemChangeNotifier methodKind]) ifTrue:[
- 		InMidstOfFileinNotification signal
- 			ifFalse: [Utilities changed: #recentMethodSubmissions].
- 	].!

Item was changed:
  ----- Method: Utilities class>>mostRecentlySubmittedMessage (in category 'recent method submissions') -----
  mostRecentlySubmittedMessage
+ 	self deprecated: 'Use RecentMessages default mostRecent'.
+ 	^ RecentMessages default mostRecent.!
- 	"Answer a string indicating the most recently submitted method that is still extant"
- 
- 	self flag: #mref.	"fix for faster references to methods"
- 
- 	self assureMostRecentSubmissionExists.
- 	^ RecentSubmissions last asStringOrText asString!

Item was removed:
- ----- Method: Utilities class>>noteMethodSubmission:forClass: (in category 'recent method submissions') -----
- noteMethodSubmission: selectorName forClass: class
- 
- 	| submission |
- 
- 	self flag: #mref.	"fix for faster references to methods"
- 
- 	self recentMethodSubmissions.	"ensure it is valid"
- 	class wantsChangeSetLogging ifFalse: [^ self].
- 	self purgeRecentSubmissionsOfMissingMethods.
- 	submission := class name asString, ' ', selectorName.
- 	RecentSubmissions removeAllSuchThat: [ :each |
- 		each asStringOrText = submission
- 	].
- 	RecentSubmissions size >= self numberOfRecentSubmissionsToStore ifTrue: [
- 		RecentSubmissions removeFirst
- 	].
- 	RecentSubmissions addLast: (
- 		MethodReference new
- 			setClass: class 
- 			methodSymbol: selectorName 
- 			stringVersion: submission
- 	) 
- !

Item was changed:
  ----- Method: Utilities class>>numberOfRecentSubmissionsToStore (in category 'recent method submissions') -----
  numberOfRecentSubmissionsToStore
+ 	self deprecated: 'Use RecentMessages >> #numberOfRecentSubmissionsToStore'.
+ 	^ RecentMessages numberOfRecentSubmissionsToStore.!
- 	"Answer how many methods back the 'recent method submissions' history should store"
- 
- 	^ Preferences parameterAt: #numberOfRecentSubmissionsToStore ifAbsentPut: [30]!

Item was changed:
  ----- Method: Utilities class>>numberOfRecentSubmissionsToStore: (in category 'recent method submissions') -----
  numberOfRecentSubmissionsToStore: aNumber
+ 	self deprecated: 'Use RecentMessages >> #numberOfRecentSubmissionsToStore'.
+ 	RecentMessages numberOfRecentSubmissionsToStore: aNumber.!
- 	"Set the number of Recent Submissions to store"
- 
- 	Preferences setParameter: #numberOfRecentSubmissionsToStore to: aNumber!

Item was removed:
- ----- Method: Utilities class>>purgeFromRecentSubmissions: (in category 'recent method submissions') -----
- purgeFromRecentSubmissions: aMethodReference
- 	"Purge any reference found in RecentSubmissions to the method supplied"
- 
- 	RecentSubmissions := RecentSubmissions select:
- 		[:aSubmission |
- 			Utilities setClassAndSelectorFrom: aSubmission in:
- 				[:aClass :aSelector | (aClass ~~ aMethodReference actualClass) or: [aSelector ~~ aMethodReference methodSymbol]]]!

Item was removed:
- ----- Method: Utilities class>>purgeRecentSubmissionsOfMissingMethods (in category 'recent method submissions') -----
- purgeRecentSubmissionsOfMissingMethods
- 	"Utilities purgeRecentSubmissionsOfMissingMethods"
- 
- 	
- 	self flag: #mref.	"fix for faster references to methods"
- 	RecentSubmissions := RecentSubmissions select:
- 		[:aSubmission | | keep | 
- 			Utilities setClassAndSelectorFrom: aSubmission in:
- 				[:aClass :aSelector |
- 					keep := (aClass == nil) not
- 						and: [aClass isInMemory
- 						and: [aSelector == #Comment or: [(aClass compiledMethodAt: aSelector ifAbsent: [nil]) notNil]]]].
- 			keep]!

Item was changed:
  ----- Method: Utilities class>>recentMethodSubmissions (in category 'recent method submissions') -----
  recentMethodSubmissions
  	"Answer the list of recent method submissions, in order.  5/16/96 sw"
+ 	self deprecated: 'Use RecentMessages default methodReferences'.
+ 	^ RecentMessages default methodReferences.!
- 
- 
- 	self flag: #mref.	"fix for faster references to methods"
- 
- 	RecentSubmissions == nil ifTrue: [RecentSubmissions := OrderedCollection new].
- 	^ RecentSubmissions!

Item was changed:
  ----- Method: Utilities class>>revertLastMethodSubmission (in category 'recent method submissions') -----
  revertLastMethodSubmission
+ 	self deprecated: 'Use RecentMessages default revertLastMethodSubmission'.
+ 	RecentMessages default revertLastMethodSubmission.!
- 	| changeRecords lastSubmission theClass theSelector |
- 	"If the most recent method submission was a method change, revert
- 	that change, and if it was a submission of a brand-new method, 
- 	remove that method."
- 
- 	RecentSubmissions isEmptyOrNil ifTrue: [^ Beeper beep].
- 	lastSubmission := RecentSubmissions last.
- 	theClass := lastSubmission actualClass ifNil: [^ Beeper beep].
- 	theSelector := lastSubmission methodSymbol.
- 	changeRecords := theClass changeRecordsAt: theSelector.
- 	changeRecords isEmptyOrNil ifTrue: [^ Beeper beep].
- 	changeRecords size = 1
- 		ifTrue:
- 			["method has no prior version, so reverting in this case means removing"
- 			theClass removeSelector: theSelector]
- 		ifFalse:
- 			[changeRecords second fileIn].
- 
- "Utilities revertLastMethodSubmission"!

Item was removed:
- ----- Method: Utilities class>>startUp (in category 'class initialization') -----
- startUp
- 	SystemChangeNotifier uniqueInstance notify: self ofAllSystemChangesUsing: #event:.!



More information about the Squeak-dev mailing list