'From Pharo3.0 of 18 March 2013 [Latest update: #30258] on 9 July 2013 at 4:28:46 pm'!

!TClassDescription methodsFor: 'accessing comment' stamp: 'SebastianTleye 7/9/2013 16:24'!
hasComment
	"return whether this class truly has a comment other than the default"
	| org |
	org := self instanceSide organization.
	^org classComment isEmptyOrNil not! !

!TClassDescription methodsFor: 'accessing comment' stamp: 'SebastianTleye 7/9/2013 16:24'!
comment: aStringOrText
	"Set the receiver's comment to be the argument, aStringOrText."

	self instanceSide classComment: aStringOrText.! !

!TClassDescription methodsFor: 'accessing comment' stamp: 'SebastianTleye 7/9/2013 16:24'!
comment
	"Answer the receiver's comment. (If missing, supply a template) "
	| aString |
	aString := self instanceSide organization classComment.
	aString isEmpty ifFalse: [^ aString].
	^self classCommentBlank! !

!TClassDescription methodsFor: 'accessing comment' stamp: 'SebastianTleye 7/9/2013 16:24'!
comment: aStringOrText stamp: aStamp
	"Set the receiver's comment to be the argument, aStringOrText."

	self instanceSide classComment: aStringOrText stamp: aStamp.! !

!TClassDescription methodsFor: 'printing' stamp: 'SebastianTleye 7/9/2013 16:24'!
storeOn: aStream
	"Classes and Metaclasses have global names."

	aStream nextPutAll: self name! !

!TClassDescription methodsFor: 'printing' stamp: 'SebastianTleye 7/9/2013 16:24'!
printOn: aStream 
	aStream nextPutAll: self name! !

!TClassDescription methodsFor: 'filein/out' stamp: 'SebastianTleye 7/9/2013 16:24'!
commentStamp: changeStamp
	self organization commentStamp: changeStamp.
	^ self commentStamp: changeStamp prior: 0! !

!TClassDescription methodsFor: 'filein/out' stamp: 'SebastianTleye 7/9/2013 16:24'!
fileOutOn: aFileStream moveSource: moveSource toFile: fileIndex
	"File a description of the receiver on aFileStream. If the boolean 
	argument, moveSource, is true, then set the trailing bytes to the position 
	of aFileStream and to fileIndex in order to indicate where to find the 
	source code."

	aFileStream nextChunkPut: self definition.

	self organization
		putCommentOnFile: aFileStream
		numbered: fileIndex
		moveSource: moveSource
		forClass: self.
	self organization categories do: 
		[:heading |
		self fileOutCategory: heading
			on: aFileStream
			moveSource: moveSource
			toFile: fileIndex]! !

!TClassDescription methodsFor: 'filein/out' stamp: 'SebastianTleye 7/9/2013 16:24'!
fileOutCategory: catName 

	| internalStream |
	internalStream := (String new: 1000) writeStream.
	internalStream header; timeStamp.
	self fileOutCategory: catName on: internalStream moveSource: false toFile: 0.
	internalStream trailer.

	^ FileStream writeSourceCodeFrom: internalStream baseName: (self name , '-' , catName) isSt: true.! !

!TClassDescription methodsFor: 'filein/out' stamp: 'SebastianTleye 7/9/2013 16:24'!
fileOutChangedMessages: aSet on: aFileStream 
	"File a description of the messages of the receiver that have been 
	changed (i.e., are entered into the argument, aSet) onto aFileStream."

	self fileOutChangedMessages: aSet
		on: aFileStream
		moveSource: false
		toFile: 0! !

!TClassDescription methodsFor: 'filein/out' stamp: 'SebastianTleye 7/9/2013 16:24'!
fileOutCategory: aSymbol on: aFileStream moveSource: moveSource toFile: fileIndex 
	"File a description of the receiver's category, aString, onto aFileStream. If 
	moveSource, is true, then set the method source pointer to the new file position.
	Note when this method is called with moveSource=true, it is condensing the
	.sources file, and should only write one preamble per method category."

	| selectors |
	aFileStream cr.
	selectors := self selectorsToFileOutCategory: aSymbol.

	"Overridden to preserve author stamps in sources file regardless"
	selectors do: [:sel |
		self printMethodChunk: sel 
			withPreamble: true
			on: aFileStream 
			moveSource: moveSource 
			toFile: fileIndex].
	^ self! !

!TClassDescription methodsFor: 'filein/out' stamp: 'SebastianTleye 7/9/2013 16:24'!
fileOutChangedMessages: aSet on: aFileStream moveSource: moveSource toFile: fileIndex 
	"File a description of the messages of this class that have been 
	changed (i.e., are entered into the argument, aSet) onto aFileStream.  If 
	moveSource, is true, then set the method source pointer to the new file position.
	Note when this method is called with moveSource=true, it is condensing the
	.changes file, and should only write a preamble for every method."
	| org |
	(org := self organization) categories do: 
		[:cat | | sels | 
		sels := (org listAtCategoryNamed: cat) select: [:sel | aSet includes: sel].
		sels do:
			[:sel |  self printMethodChunk: sel withPreamble: true on: aFileStream
							moveSource: moveSource toFile: fileIndex]]! !

!TClassDescription methodsFor: 'filein/out' stamp: 'SebastianTleye 7/9/2013 16:24'!
putClassCommentToCondensedChangesFile: aFileStream
	"Called when condensing changes.  If the receiver has a class comment, and if that class comment does not reside in the .sources file, then write it to the given filestream, with the resulting RemoteString being reachable from the source file #2.  Note that any existing backpointer into the .sources file is lost by this process -- a situation that maybe should be fixed someday."

	| header aStamp aCommentRemoteStr |
	self isMeta ifTrue: [^ self].  "bulletproofing only"
	((aCommentRemoteStr := self organization commentRemoteStr) isNil or:
		[aCommentRemoteStr sourceFileNumber = 1]) ifTrue: [^ self].

	aFileStream cr; nextPut: $!!.
	header := String streamContents: [:strm | strm nextPutAll: self name;
		nextPutAll: ' commentStamp: '.
		(aStamp := self organization commentStamp ifNil: ['<historical>']) storeOn: strm.
		strm nextPutAll: ' prior: 0'].
	aFileStream nextChunkPut: header.
	aFileStream cr.
	self organization classComment: (RemoteString newString: self organization classComment onFileNumber: 2 toFile: aFileStream) stamp: aStamp! !

!TClassDescription methodsFor: 'filein/out' stamp: 'SebastianTleye 7/9/2013 16:24'!
definition
	"Answer a String that defines the receiver"

	^String streamContents: [:stream |
		stream nextPutAll: self class name.
		stream nextPutAll: ' named: ';
				store: self name.
		stream cr; tab; nextPutAll: 'uses: ';
				nextPutAll: self traitCompositionString.
		stream cr; tab; nextPutAll: 'category: ';
				store: self category asString].! !

!TClassDescription methodsFor: 'filein/out' stamp: 'SebastianTleye 7/9/2013 16:24'!
localMethods
	"returns the methods of classes including the ones of the traits that the class uses" 
	 
	^ self methods select: [:each | self includesLocalSelector: each selector].! !

!TClassDescription methodsFor: 'filein/out' stamp: 'SebastianTleye 7/9/2013 16:24'!
commentStamp: changeStamp prior: indexAndOffset
	"Prior source link ignored when filing in."

	^ ClassCommentReader new setClass: self
				category: #Comment
				changeStamp: changeStamp! !

!TClassDescription methodsFor: 'filein/out' stamp: 'SebastianTleye 7/9/2013 16:24'!
classComment: aString
	"Store the comment, aString or Text or RemoteString, associated with the class we are orgainzing.  Empty string gets stored only if had a non-empty one before."
	^ self classComment: aString stamp: '<historical>'! !

!TClassDescription methodsFor: 'filein/out' stamp: 'SebastianTleye 7/9/2013 16:24'!
selectorsToFileOutCategory: aSymbol
	^ self organization listAtCategoryNamed: aSymbol! !

!TClassDescription methodsFor: 'filein/out' stamp: 'SebastianTleye 7/9/2013 16:24'!
printMethodChunk: selector withPreamble: doPreamble on: outStream moveSource: moveSource toFile: fileIndex
	"Copy the source code for the method associated with selector onto the fileStream.  If moveSource true, then also set the source code pointer of the method."

	| preamble method oldPos newPos sourceFile endPos |
	doPreamble
		ifTrue: [ preamble := self name , ' methodsFor: ' , (self organization categoryOfElement: selector) asString printString ]
		ifFalse: [ preamble := '' ].
	method := self methodDict
		at: selector
		ifAbsent: [ 
			outStream
				nextPutAll: selector;
				cr.
			outStream
				tab;
				nextPutAll: '** ERROR!!  THIS SCRIPT IS MISSING ** ' translated;
				cr;
				cr.
			outStream nextPutAll: '  '.
			^ outStream ].
		oldPos := method filePosition.
			sourceFile := SourceFiles at: method fileIndex.
			preamble size > 0
				ifTrue: [ 
					"Copy the preamble"
					outStream copyPreamble: preamble from: sourceFile at: oldPos ]
				ifFalse: [ sourceFile position: oldPos ].	"Copy the method chunk"
			newPos := outStream position.
			outStream copyMethodChunkFrom: sourceFile.
			sourceFile skipSeparators.	"The following chunk may have ]style["
			sourceFile peek == $]
				ifTrue: [ 
					outStream
						cr;
						copyMethodChunkFrom: sourceFile ].
			moveSource
				ifTrue: [ 
					"Set the new method source pointer"
					endPos := outStream position.
					method setSourcePosition: newPos inFile: fileIndex ].
	preamble size > 0
		ifTrue: [ outStream nextChunkPut: ' ' ].
	^ outStream cr! !

!TClassDescription methodsFor: 'filein/out' stamp: 'SebastianTleye 7/9/2013 16:24'!
fileOutOrganizationOn: aFileStream
	"File a description of the receiver's organization on aFileStream."

	aFileStream cr; nextPut: $!!.
	aFileStream nextChunkPut: self name, ' reorganize'; cr.
	aFileStream nextChunkPut: self organization stringForFileOut ; cr! !

!TClassDescription methodsFor: 'filein/out' stamp: 'SebastianTleye 7/9/2013 16:24'!
classComment: aString stamp: aStamp
	"Store the comment, aString or Text or RemoteString, associated with the class we are organizing.  Empty string gets stored only if had a non-empty one before."

	| ptr header file oldCommentRemoteStr oldComment oldStamp |
	oldComment := self organization classComment.
	oldStamp := self organization commentStamp.
	(aString isKindOf: RemoteString) ifTrue:
		[SystemAnnouncer uniqueInstance class: self oldComment: oldComment newComment: aString string oldStamp: oldStamp newStamp: aStamp.
		^ self organization classComment: aString stamp: aStamp].

	oldCommentRemoteStr := self organization commentRemoteStr.
	(aString size = 0) & (oldCommentRemoteStr isNil) ifTrue: [^ self organization classComment: nil].
		"never had a class comment, no need to write empty string out"

	ptr := oldCommentRemoteStr ifNil: [0] ifNotNil: [oldCommentRemoteStr sourcePointer].
	SourceFiles ifNotNil: [(file := SourceFiles at: 2) ifNotNil:
		[file setToEnd; cr; nextPut: $!!.	"directly"
		"Should be saying (file command: 'H3') for HTML, but ignoring it here"
		header := String streamContents: [:strm | strm nextPutAll: self name;
			nextPutAll: ' commentStamp: '.
			aStamp storeOn: strm.
			strm nextPutAll: ' prior: '; nextPutAll: ptr printString].
		file nextChunkPut: header]].
	self organization classComment: (RemoteString newString: aString onFileNumber: 2) stamp: aStamp.
	SystemAnnouncer uniqueInstance class: self oldComment: oldComment newComment: aString oldStamp: oldStamp newStamp: aStamp! !

!TClassDescription methodsFor: 'filein/out' stamp: 'SebastianTleye 7/9/2013 16:24'!
printCategoryChunk: category on: aFileStream withStamp: changeStamp priorMethod: priorMethod 
	"Print a method category preamble.  This must have a category name.
	It may have an author/date stamp, and it may have a prior source link.
	If it has a prior source link, it MUST have a stamp, even if it is empty."

"The current design is that changeStamps and prior source links are preserved in the changes file.  All fileOuts include changeStamps.  Condensing sources, however, eliminates all stamps (and links, natch)."

	aFileStream cr; nextPut: $!!.
	aFileStream nextChunkPut: (String streamContents:
		[:strm |
		strm nextPutAll: self name; nextPutAll: ' methodsFor: '; print: category asString.
		(changeStamp ~~ nil and:
			[changeStamp size > 0 or: [priorMethod ~~ nil]]) ifTrue:
			[strm nextPutAll: ' stamp: '; print: changeStamp].
		priorMethod ~~ nil ifTrue:
			[strm nextPutAll: ' prior: '; print: priorMethod sourcePointer]]).
	! !

!TClassDescription methodsFor: 'filein/out' stamp: 'SebastianTleye 7/9/2013 16:24'!
fileOutMethod: selector
	"Write source code of a single method on a file.  Make up a name for the file."
	
	| internalStream |
	internalStream := (String new: 1000) writeStream.
	self fileOutMethod: selector on: internalStream.
	FileStream writeSourceCodeFrom: internalStream baseName: (self name , '-' , (selector copyReplaceAll: ':' with: '')) isSt: true.! !

!TClassDescription methodsFor: 'filein/out' stamp: 'SebastianTleye 7/9/2013 16:24'!
methodsFor: categoryName 
	"Answer a ClassCategoryReader for compiling the messages in the category, categoryName, of the receiver."

	^ ClassCategoryReader new setClass: self category: categoryName asSymbol

	"(False methodsFor: 'logical operations') inspect"! !

!TClassDescription methodsFor: 'filein/out' stamp: 'SebastianTleye 7/9/2013 16:24'!
moveChangesTo: newFile 
	"Used in the process of condensing changes, this message requests that 
	the source code of all methods of the receiver that have been changed 
	should be moved to newFile."

	| changes |
	changes := self selectors select: [:sel | (self compiledMethodAt: sel) fileIndex > 1 ].
	self
		fileOutChangedMessages: changes
		on: newFile
		moveSource: true
		toFile: 2! !

!TClassDescription methodsFor: 'filein/out' stamp: 'SebastianTleye 7/9/2013 16:24'!
fileOutOn: aFileStream 
	"File a description of the receiver on aFileStream."

	self fileOutOn: aFileStream
		moveSource: false
		toFile: 0! !

!TClassDescription methodsFor: 'organization' stamp: 'SebastianTleye 7/9/2013 16:24'!
zapOrganization
	"Remove the organization of this class by message categories.
	This is typically done to save space in small systems.  Classes and methods
	created or filed in subsequently will, nonetheless, be organized"

	self organization: nil.
	self isClassSide ifFalse: [self classSide zapOrganization]! !

!TClassDescription methodsFor: 'organization' stamp: 'SebastianTleye 7/9/2013 16:24'!
addCategory: newName before: aCategory

	^ self organization addCategory: newName before: aCategory ! !

!TClassDescription methodsFor: 'organization' stamp: 'SebastianTleye 7/9/2013 16:24'!
whichCategoryIncludesSelector: aSelector 
	"Answer the category of the argument, aSelector, in the organization of 
	the receiver, or answer nil if the receiver does not inlcude this selector."

	(self includesSelector: aSelector)
		ifTrue: [^ self organization categoryOfElement: aSelector]
		ifFalse: [^nil]! !

!TClassDescription methodsFor: 'organization' stamp: 'SebastianTleye 7/9/2013 16:24'!
reorganize
	"During fileIn, !!Rectangle reorganize!! allows Rectangle to seize control and treat the next chunk as its organization.  See the transfer of control where ReadWriteStream fileIn calls scanFrom:"

	^self organization! !

!TClassDescription methodsFor: '*NautilusCommon' stamp: 'SebastianTleye 7/9/2013 16:24'!
correspondingForTest
	"Return the unit test that correspond to me. If it does not exist, it returns myself. 
	 Return the tested class if sent to a class"
	
	| className |
	className := (self inheritsFrom: TestCase)
		ifTrue: [ self name copyReplaceAll: 'Test' with: '' ]
		ifFalse: [ self name, 'Test' ].
	^ Smalltalk 
		at: className asSymbol 
		ifAbsent: [ self ]
	! !

!TClassDescription methodsFor: 'private' stamp: 'SebastianTleye 7/9/2013 16:24'!
errorCategoryName
	self error: 'Category name must be a String'! !

!TClassDescription methodsFor: 'organization updating' stamp: 'SebastianTleye 7/9/2013 16:24'!
notifyOfRecategorizedSelector: element from: oldCategory to: newCategory
	SystemAnnouncer uniqueInstance selector: element recategorizedFrom: oldCategory to: newCategory inClass: self.
	SystemAnnouncer uniqueInstance 
		suspendAllWhile: [self notifyUsersOfRecategorizedSelector: element from: oldCategory to: newCategory].! !

!TClassDescription methodsFor: 'organization updating' stamp: 'SebastianTleye 7/9/2013 16:24'!
noteRecategorizedSelectors: aCollection oldComposition: aTraitComposition
	
	aCollection do: [:each | | oldCategory newCategory | 
		oldCategory := self organization categoryOfElement: each.
		newCategory := (self traitComposition methodDescriptionForSelector: each) effectiveMethodCategory.
		self noteRecategorizedSelector: each from: oldCategory to: newCategory]! !

!TClassDescription methodsFor: 'organization updating' stamp: 'SebastianTleye 7/9/2013 16:24'!
noteRecategorizedSelector: aSymbol from: oldCategoryOrNil to: newCategoryOrNil
	| changedCategories |
	changedCategories := self updateOrganizationSelector: aSymbol oldCategory: oldCategoryOrNil newCategory: newCategoryOrNil.
	changedCategories do: [:each |
		(self organization isEmptyCategoryNamed: each) ifTrue: [self organization removeCategory: each]]! !

!TClassDescription methodsFor: 'organization updating' stamp: 'SebastianTleye 7/9/2013 16:24'!
applyChangesOfNewTraitCompositionReplacing: oldComposition
	| changedSelectors oldMethodDict |
	oldMethodDict := self methodDict copy.
	changedSelectors := super applyChangesOfNewTraitCompositionReplacing: oldComposition.
	self noteRecategorizedSelectors: changedSelectors oldComposition: oldComposition.
	self noteChangesFrom: oldMethodDict.
	^ changedSelectors.! !

!TClassDescription methodsFor: 'organization updating' stamp: 'SebastianTleye 7/9/2013 16:24'!
updateOrganizationDescription: each oldCategory: newCategoryOrNil newCategory: oldCategoryOrNil changed: changedCategories
	| sel effectiveCategory currentCategory |
	
	sel := each selector.
	(self includesLocalSelector: sel) ifTrue: [ ^ self ].
	
	currentCategory := self organization categoryOfElement: sel.
	effectiveCategory := each 
		effectiveMethodCategoryCurrent: currentCategory 
		new: newCategoryOrNil.
	
	effectiveCategory isNil
		ifTrue: [ 
			currentCategory ifNotNil: [ changedCategories add: currentCategory ].
			self organization removeElement: sel.
			^ self ].
		
	(currentCategory isNil 
		or: [ currentCategory == Protocol ambiguous 
		or: [ currentCategory == oldCategoryOrNil ] ])
	ifFalse: [ ^ self ].
	
	(currentCategory ~~ effectiveCategory)
		ifTrue: [ 
			currentCategory ifNotNil: [ changedCategories add: currentCategory ].
			self organization classify: sel under: effectiveCategory suppressIfDefault: false ]! !

!TClassDescription methodsFor: 'copying' stamp: 'SebastianTleye 7/9/2013 16:24'!
copyAll: selArray from: class 
	"Install all the methods found in the method dictionary of the second 
	argument, class, as the receiver's methods. Classify the messages under 
	-As yet not classified-."

	self copyAll: selArray
		from: class
		classified: nil! !

!TClassDescription methodsFor: 'copying' stamp: 'SebastianTleye 7/9/2013 16:24'!
copyAll: selArray from: class classified: cat 
	"Install all the methods found in the method dictionary of the second 
	argument, class, as the receiver's methods. Classify the messages under 
	the third argument, cat."

	selArray do: [:s |
		(class includesLocalSelector: s) ifTrue: [
			self copy: s
				from: class
				classified: cat ] ]! !

!TClassDescription methodsFor: 'copying' stamp: 'SebastianTleye 7/9/2013 16:24'!
copyMethodDictionaryFrom: donorClass
	"Copy the method dictionary of the donor class over to the receiver"

	self methodDict: donorClass copyOfMethodDictionary.
	self organization: donorClass organization deepCopy.! !

!TClassDescription methodsFor: 'copying' stamp: 'SebastianTleye 7/9/2013 16:24'!
copy: sel from: class 
	"Install the method associated with the first argument, sel, a message 
	selector, found in the method dictionary of the second argument, class, 
	as one of the receiver's methods. Classify the message under -As yet not 
	classified-."

	self copy: sel
		from: class
		classified: nil! !

!TClassDescription methodsFor: 'copying' stamp: 'SebastianTleye 7/9/2013 16:24'!
copyCategory: cat from: aClass classified: newCat 
	"Specify that one of the categories of messages for the receiver is the 
	third argument, newCat. Copy each message found in the category cat in 
	class aClass into this new category."

	self copyAll: (aClass organization listAtCategoryNamed: cat)
		from: aClass
		classified: newCat! !

!TClassDescription methodsFor: 'copying' stamp: 'SebastianTleye 7/9/2013 16:24'!
copy: sel from: class classified: cat 
	"Install the method associated with the first arugment, sel, a message 
	selector, found in the method dictionary of the second argument, class, 
	as one of the receiver's methods. Classify the message under the third 
	argument, cat."

	| code category |
	"Useful when modifying an existing class"
	code := class sourceCodeAt: sel.
	code ifNotNil: 
			[cat
				ifNil: [category := class organization categoryOfElement: sel]
				ifNotNil: [category := cat].
			(self includesLocalSelector: sel)
				ifTrue: [code asString = (self sourceCodeAt: sel) asString 
							ifFalse: [self error: self name 
										, ' ' 
										, sel 
										, ' will be redefined if you proceed.']].
			self compile: code classified: category]! !

!TClassDescription methodsFor: 'copying' stamp: 'SebastianTleye 7/9/2013 16:24'!
copyCategory: cat from: class 
	"Specify that one of the categories of messages for the receiver is cat, as 
	found in the class, class. Copy each message found in this category."

	self copyCategory: cat
		from: class
		classified: cat! !

!TClassDescription methodsFor: 'copying' stamp: 'SebastianTleye 7/9/2013 16:24'!
copyAllCategoriesFrom: aClass 
	"Specify that the categories of messages for the receiver include all of 
	those found in the class, aClass. Install each of the messages found in 
	these categories into the method dictionary of the receiver, classified 
	under the appropriate categories."

	aClass organization categories do: [:cat | self copyCategory: cat from: aClass]! !

!TClassDescription methodsFor: 'accessing parallel hierarchy' stamp: 'SebastianTleye 7/9/2013 16:24'!
isMeta
	^self isClassSide! !

!TClassDescription methodsFor: 'accessing parallel hierarchy' stamp: 'SebastianTleye 7/9/2013 16:24'!
isInstanceSide
	^self isClassSide not! !

!TClassDescription methodsFor: 'accessing parallel hierarchy' stamp: 'SebastianTleye 7/9/2013 16:24'!
isClassSide
	^self == self classSide! !

!TClassDescription methodsFor: '*FuelTests' stamp: 'SebastianTleye 7/9/2013 16:24'!
duringTestCompileSilently: code classified: aCategory

	^ Author 
		useAuthor: 'TestsAuthor'
		during: [ 
			SystemAnnouncer uniqueInstance 
				suspendAllWhile: [self compile: code classified: aCategory withStamp: nil notifying: nil logSource: true].
			 ]! !

!TClassDescription methodsFor: '*FuelTests' stamp: 'SebastianTleye 7/9/2013 16:24'!
duringTestCompileSilently: code
	^ Author 
		useAuthor: 'TestsAuthor'
		during: [ 
			 [self compile: code classified: '' withStamp: nil notifying: nil logSource: true] 				fuelValueWithoutNotifications
			 ]! !

!TClassDescription methodsFor: 'compiling' stamp: 'SebastianTleye 7/9/2013 16:24'!
reformatAll
	"Reformat all methods in this class"
	self methods do: [:method | method reformat]! !

!TClassDescription methodsFor: 'compiling' stamp: 'SebastianTleye 7/9/2013 16:24'!
logMethodSource: aText forMethod: aCompiledMethod inCategory: category withStamp: changeStamp
	aCompiledMethod
		putSource: aText
		class: self
		category: category
		withStamp: changeStamp 
		inFile: 2
		priorMethod: (self
					compiledMethodAt: aCompiledMethod selector
					ifAbsent: [])! !

!TClassDescription methodsFor: 'compiling' stamp: 'SebastianTleye 7/9/2013 16:24'!
noteCompilationOf: aSelector meta: isMeta
	"A hook allowing some classes to react to recompilation of certain selectors"! !

!TClassDescription methodsFor: 'compiling' stamp: 'SebastianTleye 7/9/2013 16:24'!
compile: code notifying: requestor 
	"Refer to the comment in Behavior|compile:notifying:." 

	^self compile: code
		 classified: Protocol unclassified
		 notifying: requestor! !

!TClassDescription methodsFor: 'compiling' stamp: 'SebastianTleye 7/9/2013 16:24'!
doneCompiling
	"A ClassBuilder has finished the compilation of the receiver.
	This message is a notification for a class that needs to do some
	cleanup / reinitialization after it has been recompiled."! !

!TClassDescription methodsFor: 'compiling' stamp: 'SebastianTleye 7/9/2013 16:24'!
compile: text classified: category withStamp: changeStamp notifying: requestor
	^ self
		compile: text
		classified: category
		withStamp: changeStamp
		notifying: requestor
		logSource: self acceptsLoggingOfCompilation! !

!TClassDescription methodsFor: 'compiling' stamp: 'SebastianTleye 7/9/2013 16:24'!
wantsChangeSetLogging
	"Answer whether code submitted for the receiver should be remembered by the changeSet mechanism."

	^ true! !

!TClassDescription methodsFor: 'compiling' stamp: 'SebastianTleye 7/9/2013 16:24'!
acceptsLoggingOfCompilation
	"Answer whether the receiver's method submisions and class defintions should be logged to the changes file and to the current change set.  The metaclass follows the rule of the class itself
	Weird name is so that it will come lexically before #compile, so that a clean build can make it through."

	^ true! !

!TClassDescription methodsFor: 'compiling' stamp: 'SebastianTleye 7/9/2013 16:24'!
wantsRecompilationProgressReported
	"Answer whether the receiver would like progress of its recompilation reported interactively to the user."

	^ true! !

!TClassDescription methodsFor: 'compiling' stamp: 'SebastianTleye 7/9/2013 16:24'!
compile: code classified: heading 
	"Compile the argument, code, as source code in the context of the 
	receiver and install the result in the receiver's method dictionary under 
	the classification indicated by the second argument, heading. nil is to be 
	notified if an error occurs. The argument code is either a string or an 
	object that converts to a string or a PositionableStream on an object that 
	converts to a string."

	^self
		compile: code
		classified: heading
		notifying: nil! !

!TClassDescription methodsFor: 'compiling' stamp: 'SebastianTleye 7/9/2013 16:24'!
compileSilently: code classified: category
	"Compile the code and classify the resulting method in the given category, leaving no trail in the system log, nor in any change set, nor in the 'recent submissions' list. This should only be used when you know for sure that the compilation will succeed."

	^ self compileSilently: code classified: category notifying: nil.! !

!TClassDescription methodsFor: 'compiling' stamp: 'SebastianTleye 7/9/2013 16:24'!
compileSilently: code classified: category notifying: requestor
	"Compile the code and classify the resulting method in the given category, leaving no trail in the system log, nor in any change set, nor in the 'recent submissions' list. This should only be used when you know for sure that the compilation will succeed."

	^ SystemAnnouncer uniqueInstance 
		suspendAllWhile: [self compile: code classified: category notifying: requestor].! !

!TClassDescription methodsFor: 'compiling' stamp: 'SebastianTleye 7/9/2013 16:24'!
compile: text classified: category withStamp: changeStamp notifying: requestor logSource: logSource

	| method |

	method := self
		compile: text 
		classified: category
		notifying: requestor
		trailer: self defaultMethodTrailer
		ifFail: [ ^nil ].
		
	logSource ifTrue: [
		self 
			logMethodSource: (requestor ifNotNil: [ :r | r text ] ifNil: [ text ]) "the requestor text might have been changed by the compiler and may be different thant text argument"
			forMethod: method
			inCategory: category 
			withStamp: changeStamp].
		
	self 
		addAndClassifySelector: method selector 
		withMethod: method 
		inProtocol: category 
		notifying: requestor.
			
	self instanceSide 
		noteCompilationOf: method selector 
		meta: self isClassSide.

	^ method selector! !

!TClassDescription methodsFor: 'compiling' stamp: 'SebastianTleye 7/9/2013 16:24'!
compile: text classified: category notifying: requestor
	| stamp |
	stamp := self acceptsLoggingOfCompilation
		ifTrue: [ Author changeStamp ]
		ifFalse: [ nil ].
	^ self
		compile: text
		classified: category
		withStamp: stamp
		notifying: requestor! !

!TClassDescription methodsFor: 'compiling' stamp: 'SebastianTleye 7/9/2013 16:24'!
compileSilently: code
	"Compile the code and classify the resulting method in the given category, leaving no trail in the system log, nor in any change set, nor in the 'recent submissions' list. This should only be used when you know for sure that the compilation will succeed."

	^ self compileSilently: code classified: '' notifying: nil.! !

!TClassDescription methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 7/9/2013 16:24'!
removeCategory: aString 
	"Remove each of the messages categorized under aString in the method 
	dictionary of the receiver. Then remove the category aString."
	| categoryName |
	categoryName := aString asSymbol.
	(self organization listAtCategoryNamed: categoryName) do:
		[:sel | self removeSelector: sel].
	self organization removeCategory: categoryName! !

!TClassDescription methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 7/9/2013 16:24'!
removeSelector: selector 
	"Remove the message whose selector is given from the method 
	dictionary of the receiver, if it is there. Answer nil otherwise."
	
	| priorMethod priorProtocol origin | 
	priorMethod := self compiledMethodAt: selector ifAbsent: [^ nil].
	origin := priorMethod origin.
	priorProtocol := self whichCategoryIncludesSelector: selector.
	super removeSelector: selector.
	SystemAnnouncer uniqueInstance 
		suspendAllWhile: [self updateOrganizationSelector: selector oldCategory: priorProtocol newCategory: nil].
	SystemAnnouncer uniqueInstance 
			methodRemoved: priorMethod selector: selector inProtocol: priorProtocol class: self origin: origin.! !

!TClassDescription methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 7/9/2013 16:24'!
uncategorizedMethods
	^ self methodsInCategory: Protocol unclassified! !

!TClassDescription methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 7/9/2013 16:24'!
addSelectorSilently: selector withMethod: compiledMethod
	super addSelectorSilently: selector withMethod: compiledMethod.
	self instanceSide noteAddedSelector: selector meta: self isMeta.! !

!TClassDescription methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 7/9/2013 16:24'!
addSelector: selector withMethod: compiledMethod notifying: requestor
	| priorMethodOrNil |
	priorMethodOrNil := self compiledMethodAt: selector ifAbsent: [nil].
	self addSelectorSilently: selector withMethod: compiledMethod.
	priorMethodOrNil isNil
		ifTrue: [SystemAnnouncer uniqueInstance methodAdded: compiledMethod selector: selector inClass: self requestor: requestor]
		ifFalse: [SystemAnnouncer uniqueInstance methodChangedFrom: priorMethodOrNil to: compiledMethod selector: selector inClass: self requestor: requestor].! !

!TClassDescription methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 7/9/2013 16:24'!
noteAddedSelector: aSelector meta: isMeta
	"A hook allowing some classes to react to adding of certain selectors"! !

!TClassDescription methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 7/9/2013 16:24'!
methodsInCategory: aName 
	"Answer a list of the methods of the receiver that are in category named aName"
	
	| aColl |
	aColl := Set withAll: (self organization listAtCategoryNamed: aName).
	^ aColl asArray sort! !

!TClassDescription methodsFor: 'accessing comment' stamp: 'SebastianTleye 7/9/2013 16:24'!
hasComment
	"return whether this class truly has a comment other than the default"
	| org |
	org := self instanceSide organization.
	^org classComment isEmptyOrNil not! !

!TClassDescription methodsFor: 'accessing comment' stamp: 'SebastianTleye 7/9/2013 16:24'!
comment: aStringOrText
	"Set the receiver's comment to be the argument, aStringOrText."

	self instanceSide classComment: aStringOrText.! !

!TClassDescription methodsFor: 'accessing comment' stamp: 'SebastianTleye 7/9/2013 16:24'!
comment
	"Answer the receiver's comment. (If missing, supply a template) "
	| aString |
	aString := self instanceSide organization classComment.
	aString isEmpty ifFalse: [^ aString].
	^self classCommentBlank! !

!TClassDescription methodsFor: 'accessing comment' stamp: 'SebastianTleye 7/9/2013 16:24'!
comment: aStringOrText stamp: aStamp
	"Set the receiver's comment to be the argument, aStringOrText."

	self instanceSide classComment: aStringOrText stamp: aStamp.! !

!TClassDescription methodsFor: 'printing' stamp: 'SebastianTleye 7/9/2013 16:24'!
storeOn: aStream
	"Classes and Metaclasses have global names."

	aStream nextPutAll: self name! !

!TClassDescription methodsFor: 'printing' stamp: 'SebastianTleye 7/9/2013 16:24'!
printOn: aStream 
	aStream nextPutAll: self name! !

!TClassDescription methodsFor: 'filein/out' stamp: 'SebastianTleye 7/9/2013 16:24'!
commentStamp: changeStamp
	self organization commentStamp: changeStamp.
	^ self commentStamp: changeStamp prior: 0! !

!TClassDescription methodsFor: 'filein/out' stamp: 'SebastianTleye 7/9/2013 16:24'!
fileOutOn: aFileStream moveSource: moveSource toFile: fileIndex
	"File a description of the receiver on aFileStream. If the boolean 
	argument, moveSource, is true, then set the trailing bytes to the position 
	of aFileStream and to fileIndex in order to indicate where to find the 
	source code."

	aFileStream nextChunkPut: self definition.

	self organization
		putCommentOnFile: aFileStream
		numbered: fileIndex
		moveSource: moveSource
		forClass: self.
	self organization categories do: 
		[:heading |
		self fileOutCategory: heading
			on: aFileStream
			moveSource: moveSource
			toFile: fileIndex]! !

!TClassDescription methodsFor: 'filein/out' stamp: 'SebastianTleye 7/9/2013 16:24'!
fileOutCategory: catName 

	| internalStream |
	internalStream := (String new: 1000) writeStream.
	internalStream header; timeStamp.
	self fileOutCategory: catName on: internalStream moveSource: false toFile: 0.
	internalStream trailer.

	^ FileStream writeSourceCodeFrom: internalStream baseName: (self name , '-' , catName) isSt: true.! !

!TClassDescription methodsFor: 'filein/out' stamp: 'SebastianTleye 7/9/2013 16:24'!
fileOutChangedMessages: aSet on: aFileStream 
	"File a description of the messages of the receiver that have been 
	changed (i.e., are entered into the argument, aSet) onto aFileStream."

	self fileOutChangedMessages: aSet
		on: aFileStream
		moveSource: false
		toFile: 0! !

!TClassDescription methodsFor: 'filein/out' stamp: 'SebastianTleye 7/9/2013 16:24'!
fileOutCategory: aSymbol on: aFileStream moveSource: moveSource toFile: fileIndex 
	"File a description of the receiver's category, aString, onto aFileStream. If 
	moveSource, is true, then set the method source pointer to the new file position.
	Note when this method is called with moveSource=true, it is condensing the
	.sources file, and should only write one preamble per method category."

	| selectors |
	aFileStream cr.
	selectors := self selectorsToFileOutCategory: aSymbol.

	"Overridden to preserve author stamps in sources file regardless"
	selectors do: [:sel |
		self printMethodChunk: sel 
			withPreamble: true
			on: aFileStream 
			moveSource: moveSource 
			toFile: fileIndex].
	^ self! !

!TClassDescription methodsFor: 'filein/out' stamp: 'SebastianTleye 7/9/2013 16:24'!
fileOutChangedMessages: aSet on: aFileStream moveSource: moveSource toFile: fileIndex 
	"File a description of the messages of this class that have been 
	changed (i.e., are entered into the argument, aSet) onto aFileStream.  If 
	moveSource, is true, then set the method source pointer to the new file position.
	Note when this method is called with moveSource=true, it is condensing the
	.changes file, and should only write a preamble for every method."
	| org |
	(org := self organization) categories do: 
		[:cat | | sels | 
		sels := (org listAtCategoryNamed: cat) select: [:sel | aSet includes: sel].
		sels do:
			[:sel |  self printMethodChunk: sel withPreamble: true on: aFileStream
							moveSource: moveSource toFile: fileIndex]]! !

!TClassDescription methodsFor: 'filein/out' stamp: 'SebastianTleye 7/9/2013 16:24'!
putClassCommentToCondensedChangesFile: aFileStream
	"Called when condensing changes.  If the receiver has a class comment, and if that class comment does not reside in the .sources file, then write it to the given filestream, with the resulting RemoteString being reachable from the source file #2.  Note that any existing backpointer into the .sources file is lost by this process -- a situation that maybe should be fixed someday."

	| header aStamp aCommentRemoteStr |
	self isMeta ifTrue: [^ self].  "bulletproofing only"
	((aCommentRemoteStr := self organization commentRemoteStr) isNil or:
		[aCommentRemoteStr sourceFileNumber = 1]) ifTrue: [^ self].

	aFileStream cr; nextPut: $!!.
	header := String streamContents: [:strm | strm nextPutAll: self name;
		nextPutAll: ' commentStamp: '.
		(aStamp := self organization commentStamp ifNil: ['<historical>']) storeOn: strm.
		strm nextPutAll: ' prior: 0'].
	aFileStream nextChunkPut: header.
	aFileStream cr.
	self organization classComment: (RemoteString newString: self organization classComment onFileNumber: 2 toFile: aFileStream) stamp: aStamp! !

!TClassDescription methodsFor: 'filein/out' stamp: 'SebastianTleye 7/9/2013 16:24'!
definition
	"Answer a String that defines the receiver"

	^String streamContents: [:stream |
		stream nextPutAll: self class name.
		stream nextPutAll: ' named: ';
				store: self name.
		stream cr; tab; nextPutAll: 'uses: ';
				nextPutAll: self traitCompositionString.
		stream cr; tab; nextPutAll: 'category: ';
				store: self category asString].! !

!TClassDescription methodsFor: 'filein/out' stamp: 'SebastianTleye 7/9/2013 16:24'!
localMethods
	"returns the methods of classes including the ones of the traits that the class uses" 
	 
	^ self methods select: [:each | self includesLocalSelector: each selector].! !

!TClassDescription methodsFor: 'filein/out' stamp: 'SebastianTleye 7/9/2013 16:24'!
commentStamp: changeStamp prior: indexAndOffset
	"Prior source link ignored when filing in."

	^ ClassCommentReader new setClass: self
				category: #Comment
				changeStamp: changeStamp! !

!TClassDescription methodsFor: 'filein/out' stamp: 'SebastianTleye 7/9/2013 16:24'!
classComment: aString
	"Store the comment, aString or Text or RemoteString, associated with the class we are orgainzing.  Empty string gets stored only if had a non-empty one before."
	^ self classComment: aString stamp: '<historical>'! !

!TClassDescription methodsFor: 'filein/out' stamp: 'SebastianTleye 7/9/2013 16:24'!
selectorsToFileOutCategory: aSymbol
	^ self organization listAtCategoryNamed: aSymbol! !

!TClassDescription methodsFor: 'filein/out' stamp: 'SebastianTleye 7/9/2013 16:24'!
printMethodChunk: selector withPreamble: doPreamble on: outStream moveSource: moveSource toFile: fileIndex
	"Copy the source code for the method associated with selector onto the fileStream.  If moveSource true, then also set the source code pointer of the method."

	| preamble method oldPos newPos sourceFile endPos |
	doPreamble
		ifTrue: [ preamble := self name , ' methodsFor: ' , (self organization categoryOfElement: selector) asString printString ]
		ifFalse: [ preamble := '' ].
	method := self methodDict
		at: selector
		ifAbsent: [ 
			outStream
				nextPutAll: selector;
				cr.
			outStream
				tab;
				nextPutAll: '** ERROR!!  THIS SCRIPT IS MISSING ** ' translated;
				cr;
				cr.
			outStream nextPutAll: '  '.
			^ outStream ].
		oldPos := method filePosition.
			sourceFile := SourceFiles at: method fileIndex.
			preamble size > 0
				ifTrue: [ 
					"Copy the preamble"
					outStream copyPreamble: preamble from: sourceFile at: oldPos ]
				ifFalse: [ sourceFile position: oldPos ].	"Copy the method chunk"
			newPos := outStream position.
			outStream copyMethodChunkFrom: sourceFile.
			sourceFile skipSeparators.	"The following chunk may have ]style["
			sourceFile peek == $]
				ifTrue: [ 
					outStream
						cr;
						copyMethodChunkFrom: sourceFile ].
			moveSource
				ifTrue: [ 
					"Set the new method source pointer"
					endPos := outStream position.
					method setSourcePosition: newPos inFile: fileIndex ].
	preamble size > 0
		ifTrue: [ outStream nextChunkPut: ' ' ].
	^ outStream cr! !

!TClassDescription methodsFor: 'filein/out' stamp: 'SebastianTleye 7/9/2013 16:24'!
fileOutOrganizationOn: aFileStream
	"File a description of the receiver's organization on aFileStream."

	aFileStream cr; nextPut: $!!.
	aFileStream nextChunkPut: self name, ' reorganize'; cr.
	aFileStream nextChunkPut: self organization stringForFileOut ; cr! !

!TClassDescription methodsFor: 'filein/out' stamp: 'SebastianTleye 7/9/2013 16:24'!
classComment: aString stamp: aStamp
	"Store the comment, aString or Text or RemoteString, associated with the class we are organizing.  Empty string gets stored only if had a non-empty one before."

	| ptr header file oldCommentRemoteStr oldComment oldStamp |
	oldComment := self organization classComment.
	oldStamp := self organization commentStamp.
	(aString isKindOf: RemoteString) ifTrue:
		[SystemAnnouncer uniqueInstance class: self oldComment: oldComment newComment: aString string oldStamp: oldStamp newStamp: aStamp.
		^ self organization classComment: aString stamp: aStamp].

	oldCommentRemoteStr := self organization commentRemoteStr.
	(aString size = 0) & (oldCommentRemoteStr isNil) ifTrue: [^ self organization classComment: nil].
		"never had a class comment, no need to write empty string out"

	ptr := oldCommentRemoteStr ifNil: [0] ifNotNil: [oldCommentRemoteStr sourcePointer].
	SourceFiles ifNotNil: [(file := SourceFiles at: 2) ifNotNil:
		[file setToEnd; cr; nextPut: $!!.	"directly"
		"Should be saying (file command: 'H3') for HTML, but ignoring it here"
		header := String streamContents: [:strm | strm nextPutAll: self name;
			nextPutAll: ' commentStamp: '.
			aStamp storeOn: strm.
			strm nextPutAll: ' prior: '; nextPutAll: ptr printString].
		file nextChunkPut: header]].
	self organization classComment: (RemoteString newString: aString onFileNumber: 2) stamp: aStamp.
	SystemAnnouncer uniqueInstance class: self oldComment: oldComment newComment: aString oldStamp: oldStamp newStamp: aStamp! !

!TClassDescription methodsFor: 'filein/out' stamp: 'SebastianTleye 7/9/2013 16:24'!
printCategoryChunk: category on: aFileStream withStamp: changeStamp priorMethod: priorMethod 
	"Print a method category preamble.  This must have a category name.
	It may have an author/date stamp, and it may have a prior source link.
	If it has a prior source link, it MUST have a stamp, even if it is empty."

"The current design is that changeStamps and prior source links are preserved in the changes file.  All fileOuts include changeStamps.  Condensing sources, however, eliminates all stamps (and links, natch)."

	aFileStream cr; nextPut: $!!.
	aFileStream nextChunkPut: (String streamContents:
		[:strm |
		strm nextPutAll: self name; nextPutAll: ' methodsFor: '; print: category asString.
		(changeStamp ~~ nil and:
			[changeStamp size > 0 or: [priorMethod ~~ nil]]) ifTrue:
			[strm nextPutAll: ' stamp: '; print: changeStamp].
		priorMethod ~~ nil ifTrue:
			[strm nextPutAll: ' prior: '; print: priorMethod sourcePointer]]).
	! !

!TClassDescription methodsFor: 'filein/out' stamp: 'SebastianTleye 7/9/2013 16:24'!
fileOutMethod: selector
	"Write source code of a single method on a file.  Make up a name for the file."
	
	| internalStream |
	internalStream := (String new: 1000) writeStream.
	self fileOutMethod: selector on: internalStream.
	FileStream writeSourceCodeFrom: internalStream baseName: (self name , '-' , (selector copyReplaceAll: ':' with: '')) isSt: true.! !

!TClassDescription methodsFor: 'filein/out' stamp: 'SebastianTleye 7/9/2013 16:24'!
methodsFor: categoryName 
	"Answer a ClassCategoryReader for compiling the messages in the category, categoryName, of the receiver."

	^ ClassCategoryReader new setClass: self category: categoryName asSymbol

	"(False methodsFor: 'logical operations') inspect"! !

!TClassDescription methodsFor: 'filein/out' stamp: 'SebastianTleye 7/9/2013 16:24'!
moveChangesTo: newFile 
	"Used in the process of condensing changes, this message requests that 
	the source code of all methods of the receiver that have been changed 
	should be moved to newFile."

	| changes |
	changes := self selectors select: [:sel | (self compiledMethodAt: sel) fileIndex > 1 ].
	self
		fileOutChangedMessages: changes
		on: newFile
		moveSource: true
		toFile: 2! !

!TClassDescription methodsFor: 'filein/out' stamp: 'SebastianTleye 7/9/2013 16:24'!
fileOutOn: aFileStream 
	"File a description of the receiver on aFileStream."

	self fileOutOn: aFileStream
		moveSource: false
		toFile: 0! !

!TClassDescription methodsFor: 'organization' stamp: 'SebastianTleye 7/9/2013 16:24'!
zapOrganization
	"Remove the organization of this class by message categories.
	This is typically done to save space in small systems.  Classes and methods
	created or filed in subsequently will, nonetheless, be organized"

	self organization: nil.
	self isClassSide ifFalse: [self classSide zapOrganization]! !

!TClassDescription methodsFor: 'organization' stamp: 'SebastianTleye 7/9/2013 16:24'!
addCategory: newName before: aCategory

	^ self organization addCategory: newName before: aCategory ! !

!TClassDescription methodsFor: 'organization' stamp: 'SebastianTleye 7/9/2013 16:24'!
whichCategoryIncludesSelector: aSelector 
	"Answer the category of the argument, aSelector, in the organization of 
	the receiver, or answer nil if the receiver does not inlcude this selector."

	(self includesSelector: aSelector)
		ifTrue: [^ self organization categoryOfElement: aSelector]
		ifFalse: [^nil]! !

!TClassDescription methodsFor: 'organization' stamp: 'SebastianTleye 7/9/2013 16:24'!
reorganize
	"During fileIn, !!Rectangle reorganize!! allows Rectangle to seize control and treat the next chunk as its organization.  See the transfer of control where ReadWriteStream fileIn calls scanFrom:"

	^self organization! !

!TClassDescription methodsFor: '*NautilusCommon' stamp: 'SebastianTleye 7/9/2013 16:24'!
correspondingForTest
	"Return the unit test that correspond to me. If it does not exist, it returns myself. 
	 Return the tested class if sent to a class"
	
	| className |
	className := (self inheritsFrom: TestCase)
		ifTrue: [ self name copyReplaceAll: 'Test' with: '' ]
		ifFalse: [ self name, 'Test' ].
	^ Smalltalk 
		at: className asSymbol 
		ifAbsent: [ self ]
	! !

!TClassDescription methodsFor: 'private' stamp: 'SebastianTleye 7/9/2013 16:24'!
errorCategoryName
	self error: 'Category name must be a String'! !

!TClassDescription methodsFor: 'organization updating' stamp: 'SebastianTleye 7/9/2013 16:24'!
notifyOfRecategorizedSelector: element from: oldCategory to: newCategory
	SystemAnnouncer uniqueInstance selector: element recategorizedFrom: oldCategory to: newCategory inClass: self.
	SystemAnnouncer uniqueInstance 
		suspendAllWhile: [self notifyUsersOfRecategorizedSelector: element from: oldCategory to: newCategory].! !

!TClassDescription methodsFor: 'organization updating' stamp: 'SebastianTleye 7/9/2013 16:24'!
noteRecategorizedSelectors: aCollection oldComposition: aTraitComposition
	
	aCollection do: [:each | | oldCategory newCategory | 
		oldCategory := self organization categoryOfElement: each.
		newCategory := (self traitComposition methodDescriptionForSelector: each) effectiveMethodCategory.
		self noteRecategorizedSelector: each from: oldCategory to: newCategory]! !

!TClassDescription methodsFor: 'organization updating' stamp: 'SebastianTleye 7/9/2013 16:24'!
noteRecategorizedSelector: aSymbol from: oldCategoryOrNil to: newCategoryOrNil
	| changedCategories |
	changedCategories := self updateOrganizationSelector: aSymbol oldCategory: oldCategoryOrNil newCategory: newCategoryOrNil.
	changedCategories do: [:each |
		(self organization isEmptyCategoryNamed: each) ifTrue: [self organization removeCategory: each]]! !

!TClassDescription methodsFor: 'organization updating' stamp: 'SebastianTleye 7/9/2013 16:24'!
applyChangesOfNewTraitCompositionReplacing: oldComposition
	| changedSelectors oldMethodDict |
	oldMethodDict := self methodDict copy.
	changedSelectors := super applyChangesOfNewTraitCompositionReplacing: oldComposition.
	self noteRecategorizedSelectors: changedSelectors oldComposition: oldComposition.
	self noteChangesFrom: oldMethodDict.
	^ changedSelectors.! !

!TClassDescription methodsFor: 'organization updating' stamp: 'SebastianTleye 7/9/2013 16:24'!
updateOrganizationDescription: each oldCategory: newCategoryOrNil newCategory: oldCategoryOrNil changed: changedCategories
	| sel effectiveCategory currentCategory |
	
	sel := each selector.
	(self includesLocalSelector: sel) ifTrue: [ ^ self ].
	
	currentCategory := self organization categoryOfElement: sel.
	effectiveCategory := each 
		effectiveMethodCategoryCurrent: currentCategory 
		new: newCategoryOrNil.
	
	effectiveCategory isNil
		ifTrue: [ 
			currentCategory ifNotNil: [ changedCategories add: currentCategory ].
			self organization removeElement: sel.
			^ self ].
		
	(currentCategory isNil 
		or: [ currentCategory == Protocol ambiguous 
		or: [ currentCategory == oldCategoryOrNil ] ])
	ifFalse: [ ^ self ].
	
	(currentCategory ~~ effectiveCategory)
		ifTrue: [ 
			currentCategory ifNotNil: [ changedCategories add: currentCategory ].
			self organization classify: sel under: effectiveCategory suppressIfDefault: false ]! !

!TClassDescription methodsFor: 'copying' stamp: 'SebastianTleye 7/9/2013 16:24'!
copyAll: selArray from: class 
	"Install all the methods found in the method dictionary of the second 
	argument, class, as the receiver's methods. Classify the messages under 
	-As yet not classified-."

	self copyAll: selArray
		from: class
		classified: nil! !

!TClassDescription methodsFor: 'copying' stamp: 'SebastianTleye 7/9/2013 16:24'!
copyAll: selArray from: class classified: cat 
	"Install all the methods found in the method dictionary of the second 
	argument, class, as the receiver's methods. Classify the messages under 
	the third argument, cat."

	selArray do: [:s |
		(class includesLocalSelector: s) ifTrue: [
			self copy: s
				from: class
				classified: cat ] ]! !

!TClassDescription methodsFor: 'copying' stamp: 'SebastianTleye 7/9/2013 16:24'!
copyMethodDictionaryFrom: donorClass
	"Copy the method dictionary of the donor class over to the receiver"

	self methodDict: donorClass copyOfMethodDictionary.
	self organization: donorClass organization deepCopy.! !

!TClassDescription methodsFor: 'copying' stamp: 'SebastianTleye 7/9/2013 16:24'!
copy: sel from: class 
	"Install the method associated with the first argument, sel, a message 
	selector, found in the method dictionary of the second argument, class, 
	as one of the receiver's methods. Classify the message under -As yet not 
	classified-."

	self copy: sel
		from: class
		classified: nil! !

!TClassDescription methodsFor: 'copying' stamp: 'SebastianTleye 7/9/2013 16:24'!
copyCategory: cat from: aClass classified: newCat 
	"Specify that one of the categories of messages for the receiver is the 
	third argument, newCat. Copy each message found in the category cat in 
	class aClass into this new category."

	self copyAll: (aClass organization listAtCategoryNamed: cat)
		from: aClass
		classified: newCat! !

!TClassDescription methodsFor: 'copying' stamp: 'SebastianTleye 7/9/2013 16:24'!
copy: sel from: class classified: cat 
	"Install the method associated with the first arugment, sel, a message 
	selector, found in the method dictionary of the second argument, class, 
	as one of the receiver's methods. Classify the message under the third 
	argument, cat."

	| code category |
	"Useful when modifying an existing class"
	code := class sourceCodeAt: sel.
	code ifNotNil: 
			[cat
				ifNil: [category := class organization categoryOfElement: sel]
				ifNotNil: [category := cat].
			(self includesLocalSelector: sel)
				ifTrue: [code asString = (self sourceCodeAt: sel) asString 
							ifFalse: [self error: self name 
										, ' ' 
										, sel 
										, ' will be redefined if you proceed.']].
			self compile: code classified: category]! !

!TClassDescription methodsFor: 'copying' stamp: 'SebastianTleye 7/9/2013 16:24'!
copyCategory: cat from: class 
	"Specify that one of the categories of messages for the receiver is cat, as 
	found in the class, class. Copy each message found in this category."

	self copyCategory: cat
		from: class
		classified: cat! !

!TClassDescription methodsFor: 'copying' stamp: 'SebastianTleye 7/9/2013 16:24'!
copyAllCategoriesFrom: aClass 
	"Specify that the categories of messages for the receiver include all of 
	those found in the class, aClass. Install each of the messages found in 
	these categories into the method dictionary of the receiver, classified 
	under the appropriate categories."

	aClass organization categories do: [:cat | self copyCategory: cat from: aClass]! !

!TClassDescription methodsFor: 'accessing parallel hierarchy' stamp: 'SebastianTleye 7/9/2013 16:24'!
isMeta
	^self isClassSide! !

!TClassDescription methodsFor: 'accessing parallel hierarchy' stamp: 'SebastianTleye 7/9/2013 16:24'!
isInstanceSide
	^self isClassSide not! !

!TClassDescription methodsFor: 'accessing parallel hierarchy' stamp: 'SebastianTleye 7/9/2013 16:24'!
isClassSide
	^self == self classSide! !

!TClassDescription methodsFor: '*FuelTests' stamp: 'SebastianTleye 7/9/2013 16:24'!
duringTestCompileSilently: code classified: aCategory

	^ Author 
		useAuthor: 'TestsAuthor'
		during: [ 
			SystemAnnouncer uniqueInstance 
				suspendAllWhile: [self compile: code classified: aCategory withStamp: nil notifying: nil logSource: true].
			 ]! !

!TClassDescription methodsFor: '*FuelTests' stamp: 'SebastianTleye 7/9/2013 16:24'!
duringTestCompileSilently: code
	^ Author 
		useAuthor: 'TestsAuthor'
		during: [ 
			 [self compile: code classified: '' withStamp: nil notifying: nil logSource: true] 				fuelValueWithoutNotifications
			 ]! !

!TClassDescription methodsFor: 'compiling' stamp: 'SebastianTleye 7/9/2013 16:24'!
reformatAll
	"Reformat all methods in this class"
	self methods do: [:method | method reformat]! !

!TClassDescription methodsFor: 'compiling' stamp: 'SebastianTleye 7/9/2013 16:24'!
logMethodSource: aText forMethod: aCompiledMethod inCategory: category withStamp: changeStamp
	aCompiledMethod
		putSource: aText
		class: self
		category: category
		withStamp: changeStamp 
		inFile: 2
		priorMethod: (self
					compiledMethodAt: aCompiledMethod selector
					ifAbsent: [])! !

!TClassDescription methodsFor: 'compiling' stamp: 'SebastianTleye 7/9/2013 16:24'!
noteCompilationOf: aSelector meta: isMeta
	"A hook allowing some classes to react to recompilation of certain selectors"! !

!TClassDescription methodsFor: 'compiling' stamp: 'SebastianTleye 7/9/2013 16:24'!
compile: code notifying: requestor 
	"Refer to the comment in Behavior|compile:notifying:." 

	^self compile: code
		 classified: Protocol unclassified
		 notifying: requestor! !

!TClassDescription methodsFor: 'compiling' stamp: 'SebastianTleye 7/9/2013 16:24'!
doneCompiling
	"A ClassBuilder has finished the compilation of the receiver.
	This message is a notification for a class that needs to do some
	cleanup / reinitialization after it has been recompiled."! !

!TClassDescription methodsFor: 'compiling' stamp: 'SebastianTleye 7/9/2013 16:24'!
compile: text classified: category withStamp: changeStamp notifying: requestor
	^ self
		compile: text
		classified: category
		withStamp: changeStamp
		notifying: requestor
		logSource: self acceptsLoggingOfCompilation! !

!TClassDescription methodsFor: 'compiling' stamp: 'SebastianTleye 7/9/2013 16:24'!
wantsChangeSetLogging
	"Answer whether code submitted for the receiver should be remembered by the changeSet mechanism."

	^ true! !

!TClassDescription methodsFor: 'compiling' stamp: 'SebastianTleye 7/9/2013 16:24'!
acceptsLoggingOfCompilation
	"Answer whether the receiver's method submisions and class defintions should be logged to the changes file and to the current change set.  The metaclass follows the rule of the class itself
	Weird name is so that it will come lexically before #compile, so that a clean build can make it through."

	^ true! !

!TClassDescription methodsFor: 'compiling' stamp: 'SebastianTleye 7/9/2013 16:24'!
wantsRecompilationProgressReported
	"Answer whether the receiver would like progress of its recompilation reported interactively to the user."

	^ true! !

!TClassDescription methodsFor: 'compiling' stamp: 'SebastianTleye 7/9/2013 16:24'!
compile: code classified: heading 
	"Compile the argument, code, as source code in the context of the 
	receiver and install the result in the receiver's method dictionary under 
	the classification indicated by the second argument, heading. nil is to be 
	notified if an error occurs. The argument code is either a string or an 
	object that converts to a string or a PositionableStream on an object that 
	converts to a string."

	^self
		compile: code
		classified: heading
		notifying: nil! !

!TClassDescription methodsFor: 'compiling' stamp: 'SebastianTleye 7/9/2013 16:24'!
compileSilently: code classified: category
	"Compile the code and classify the resulting method in the given category, leaving no trail in the system log, nor in any change set, nor in the 'recent submissions' list. This should only be used when you know for sure that the compilation will succeed."

	^ self compileSilently: code classified: category notifying: nil.! !

!TClassDescription methodsFor: 'compiling' stamp: 'SebastianTleye 7/9/2013 16:24'!
compileSilently: code classified: category notifying: requestor
	"Compile the code and classify the resulting method in the given category, leaving no trail in the system log, nor in any change set, nor in the 'recent submissions' list. This should only be used when you know for sure that the compilation will succeed."

	^ SystemAnnouncer uniqueInstance 
		suspendAllWhile: [self compile: code classified: category notifying: requestor].! !

!TClassDescription methodsFor: 'compiling' stamp: 'SebastianTleye 7/9/2013 16:24'!
compile: text classified: category withStamp: changeStamp notifying: requestor logSource: logSource

	| method |

	method := self
		compile: text 
		classified: category
		notifying: requestor
		trailer: self defaultMethodTrailer
		ifFail: [ ^nil ].
		
	logSource ifTrue: [
		self 
			logMethodSource: (requestor ifNotNil: [ :r | r text ] ifNil: [ text ]) "the requestor text might have been changed by the compiler and may be different thant text argument"
			forMethod: method
			inCategory: category 
			withStamp: changeStamp].
		
	self 
		addAndClassifySelector: method selector 
		withMethod: method 
		inProtocol: category 
		notifying: requestor.
			
	self instanceSide 
		noteCompilationOf: method selector 
		meta: self isClassSide.

	^ method selector! !

!TClassDescription methodsFor: 'compiling' stamp: 'SebastianTleye 7/9/2013 16:24'!
compile: text classified: category notifying: requestor
	| stamp |
	stamp := self acceptsLoggingOfCompilation
		ifTrue: [ Author changeStamp ]
		ifFalse: [ nil ].
	^ self
		compile: text
		classified: category
		withStamp: stamp
		notifying: requestor! !

!TClassDescription methodsFor: 'compiling' stamp: 'SebastianTleye 7/9/2013 16:24'!
compileSilently: code
	"Compile the code and classify the resulting method in the given category, leaving no trail in the system log, nor in any change set, nor in the 'recent submissions' list. This should only be used when you know for sure that the compilation will succeed."

	^ self compileSilently: code classified: '' notifying: nil.! !

!TClassDescription methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 7/9/2013 16:24'!
removeCategory: aString 
	"Remove each of the messages categorized under aString in the method 
	dictionary of the receiver. Then remove the category aString."
	| categoryName |
	categoryName := aString asSymbol.
	(self organization listAtCategoryNamed: categoryName) do:
		[:sel | self removeSelector: sel].
	self organization removeCategory: categoryName! !

!TClassDescription methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 7/9/2013 16:24'!
removeSelector: selector 
	"Remove the message whose selector is given from the method 
	dictionary of the receiver, if it is there. Answer nil otherwise."
	
	| priorMethod priorProtocol origin | 
	priorMethod := self compiledMethodAt: selector ifAbsent: [^ nil].
	origin := priorMethod origin.
	priorProtocol := self whichCategoryIncludesSelector: selector.
	super removeSelector: selector.
	SystemAnnouncer uniqueInstance 
		suspendAllWhile: [self updateOrganizationSelector: selector oldCategory: priorProtocol newCategory: nil].
	SystemAnnouncer uniqueInstance 
			methodRemoved: priorMethod selector: selector inProtocol: priorProtocol class: self origin: origin.! !

!TClassDescription methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 7/9/2013 16:24'!
uncategorizedMethods
	^ self methodsInCategory: Protocol unclassified! !

!TClassDescription methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 7/9/2013 16:24'!
addSelectorSilently: selector withMethod: compiledMethod
	super addSelectorSilently: selector withMethod: compiledMethod.
	self instanceSide noteAddedSelector: selector meta: self isMeta.! !

!TClassDescription methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 7/9/2013 16:24'!
addSelector: selector withMethod: compiledMethod notifying: requestor
	| priorMethodOrNil |
	priorMethodOrNil := self compiledMethodAt: selector ifAbsent: [nil].
	self addSelectorSilently: selector withMethod: compiledMethod.
	priorMethodOrNil isNil
		ifTrue: [SystemAnnouncer uniqueInstance methodAdded: compiledMethod selector: selector inClass: self requestor: requestor]
		ifFalse: [SystemAnnouncer uniqueInstance methodChangedFrom: priorMethodOrNil to: compiledMethod selector: selector inClass: self requestor: requestor].! !

!TClassDescription methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 7/9/2013 16:24'!
noteAddedSelector: aSelector meta: isMeta
	"A hook allowing some classes to react to adding of certain selectors"! !

!TClassDescription methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 7/9/2013 16:24'!
methodsInCategory: aName 
	"Answer a list of the methods of the receiver that are in category named aName"
	
	| aColl |
	aColl := Set withAll: (self organization listAtCategoryNamed: aName).
	^ aColl asArray sort! !

Smalltalk removeClassNamed: #TClassAndTraitDescription!


!TClassDescription reorganize!
('initialize-release' obsolete superclass:methodDictionary:format: updateInstancesFrom: updateInstances:from:isMeta:)
('accessing comment' classCommentBlank hasComment comment: comment comment:stamp:)
('printing' storeOn: instanceVariablesString printOn: classVariablesString sharedPoolsString)
('filein/out' commentStamp: fileOutOn:moveSource:toFile: fileOutCategory: fileOutChangedMessages:on: fileOutCategory:on:moveSource:toFile: fileOutChangedMessages:on:moveSource:toFile: putClassCommentToCondensedChangesFile: definition localMethods commentStamp:prior: classComment: selectorsToFileOutCategory: printMethodChunk:withPreamble:on:moveSource:toFile: fileOutOrganizationOn: fileOutMethod:on: classComment:stamp: printCategoryChunk:on:withStamp:priorMethod: fileOutMethod: methodsFor: moveChangesTo: fileOutOn:)
('organization' basicOrganization: organization: zapOrganization addCategory:before: whichCategoryIncludesSelector: organization basicOrganization reorganize)
('testing' isTestCase)
('*NautilusCommon' correspondingForTest)
('private' numberOfMethods linesOfCode setInstVarNames: errorCategoryName instVarMappingFrom: newInstanceFrom:variable:size:map: notifyRepackage:method:oldProtocol:newProtocol:)
('organization updating' noteMethodRemoved: notifyOfRecategorizedSelector:from:to: noteMethodAdded: noteRecategorizedSelectors:oldComposition: noteRecategorizedSelector:from:to: applyChangesOfNewTraitCompositionReplacing: noteChangesFrom: updateOrganizationDescription:oldCategory:newCategory:changedCategories: updateOrganizationDescription:oldCategory:newCategory:changed: noteMethodChanged:to: updateOrganizationSelector:oldCategory:newCategory:)
('accessing' version classVersion instanceVariables)
('traits')
('authors' authors addAuthorsTo:)
('users notification' notifyUsersOfRecategorizedSelector:from:to: notifyUsersOfChangedSelectors:)
('copying' copyAll:from: copyAll:from:classified: copyMethodDictionaryFrom: copy:from: copyCategory:from:classified: copy:from:classified: copyCategory:from: copyAllCategoriesFrom:)
('accessing class hierarchy' printSubclassesOn:level: classesThatImplementAllOf: subclasses commentInventory subclassesDo:)
('instance variables' classThatDefinesClassVariable: instVarIndexFor: instVarIndexFor:ifAbsent: classThatDefinesInstanceVariable: forceNewFrom: instVarNameForIndex: instVarNames hasInstVarNamed: allInstVarNamesEverywhere checkForInstVarsOK:)
('accessing parallel hierarchy' isMeta isInstanceSide theNonMetaClass classSide instanceSide theMetaClass isClassSide)
('*FuelTests' duringTestCompileSilently:classified: duringTestCompileSilently:)
('compiling' reformatAll logMethodSource:forMethod:inCategory:withStamp: noteCompilationOf:meta: compile:notifying: doneCompiling compile:classified:withStamp:notifying: wantsChangeSetLogging acceptsLoggingOfCompilation wantsRecompilationProgressReported compile:classified: instVarNamesAndOffsetsDo: compileSilently:classified: compileSilently:classified:notifying: compile:classified:withStamp:notifying:logSource: compile:classified:notifying: compileSilently:)
('accessing method dictionary' removeCategory: removeSelector: uncategorizedMethods addSelectorSilently:withMethod: addAndClassifySelector:withMethod:inProtocol:notifying: addSelector:withMethod:notifying: noteAddedSelector:meta: methodsInCategory: allMethodsInCategory: allMethodCategoriesIntegratedThrough:)
('pool variable' allSharedPools hasSharedPools usesLocalPoolVarNamed: usesPoolVarNamed: sharedPoolOfVarNamed:)
!