Some people mailed me that there was something wrong with the previous
attachment (I used an old Celeste that came with my 2.8 image). Hence this
repost. I promise to use the new Celeste from now on :-)

PS: is it worth to make a 3.1 version ? Is anybody needing this ?


"Change Set:        formatPatch
Date:            24 April 2001
Author:            Roel Wuyts

Moved Compiler>>#format:in:notifying:decorated: to
Parser>>#format:in:notifying:decorated:. Changed all senders of the
message that used #compilerClass to retrieve the receiver to send the
method to to now use #parserClass. Also removed Compiler>>#format:in:,
as there was no one sending this message.

Motivation for the change was that conceptually the compiler has nothing
to do with formatting source code. When then, for example, someone wants
to add custom pretty printing, then classes using the custom pretty
printer have to override both #compilerClass and #parserClass. With this
change the formatting responsibility lies with the Parser, and
subclasses can just override #parserClass to change this."

--
Roel Wuyts                           Software Composition Group
Roel.Wuyts at iam.unibe.ch         University of Bern, Switzerland
Board member of the European Smalltalk User Group: www.esug.org

-------------- next part --------------
'From Squeak2.8 of 13 June 2000 [latest update: #2359] on 24 April 2001 at 2:42:47 pm'!"Change Set:		formatPatchDate:			24 April 2001Author:			Roel WuytsMoved Compiler>>#format:in:notifying:decorated: to Parser>>#format:in:notifying:decorated:. Changed all senders of the message that used #compilerClass to retrieve the receiver to send the method to to now use #parserClass. Also removed Compiler>>#format:in:, as there was no one sending this message.Motivation for the change was that conceptually the compiler has nothing to do with formatting source code. When then, for example, someone wants to add custom pretty printing, then classes using the custom pretty printer have to override both #compilerClass and #parserClass. With this change the formatting responsibility lies with the Parser, and subclasses can just override #parserClass to change this."!!Browser methodsFor: 'message list' stamp: 'rw 4/24/2001 12:54'!selectedMessage	"Answer a copy of the source code for the selected message selector.
"	| class selector method tempNames |	contents == nil ifFalse: [^ contents copy].	class _ self selectedClassOrMetaClass.	selector _ self selectedMessageName.	method _ class compiledMethodAt: selector ifAbsent: [^ ''].	"method deleted while in another project"	currentCompiledMethod _ method.	(Sensor controlKeyPressed		or: [method fileIndex > 0 and: [(SourceFiles at: method fileIndex)					== nil]])		ifTrue: 			["Emergency or no source file -- decompile without temp names"			contents _ (class decompilerClass new						decompile: selector						in: class						method: method) decompileString.			contents _ contents asText makeSelectorBoldIn: class.			^ contents copy].	Sensor leftShiftDown		ifTrue: 			["Special request to decompile -- get temps from source file"			tempNames _ (class compilerClass new						parse: method getSourceFromFile asString						in: class						notifying: nil) tempNames.			contents _ ((class decompilerClass new withTempNames: tempNames)						decompile: selector						in
: class						method: method) decompileString.			contents _ contents asText makeSelectorBoldIn: class.			^ contents copy].	contents _ class sourceCodeAt: selector.	self validateMessageSource: selector.	Preferences browseWithPrettyPrint ifTrue: [contents _ class parserClass new					format: contents					in: class					notifying: nil					decorated: Preferences colorWhenPrettyPrinting].	self showDiffs ifTrue: [contents _ self diffFromPriorSourceFor: contents].	contents _ contents asText makeSelectorBoldIn: class.	^ contents copy! !!ChangeSorter methodsFor: 'code pane' stamp: 'rw 4/24/2001 12:56'!setContents	"return the source code that shows in the bottom pane"	| sel class strm changeType |	self clearUserEditFlag.	currentClassName ifNil: [^ contents _ myChangeSet preambleString ifNil: ['']].	class _ self selectedClassOrMetaClass.	(sel _ currentSelector) == nil		ifTrue: 			[strm _ WriteStream on: (String new: 100).			(myChangeSet classChangeAt: currentClassName)				do: 					[:each | 			
		each = #remove ifTrue: [strm nextPutAll: 'Entire class was removed.';						 cr].					each = #addedThenRemoved ifTrue: [strm nextPutAll: 'Class was added then removed.'].					each = #rename ifTrue: [strm nextPutAll: 'Class name was changed.';						 cr].					each = #add ifTrue: [strm nextPutAll: 'Class definition was added.';						 cr].					each = #change ifTrue: [strm nextPutAll: 'Class definition was changed.';						 cr].					each = #reorganize ifTrue: [strm nextPutAll: 'Class organization was changed.';						 cr].					each = #comment ifTrue: [strm nextPutAll: 'New class comment.';						 cr]].			^ contents _ strm contents]		ifFalse: 			[changeType _ myChangeSet atSelector: (sel _ sel asSymbol) class: class.			changeType == #remove ifTrue: [^ contents _ 'Method has been removed (see versions)'].			changeType == #addedThenRemoved ifTrue: [^ contents _ 'Added then removed (see versions)'].			class ifNil: [^ contents _ 'Method was added, but cannot be found!!'].			(class includesSelector: se
l)				ifFalse: [^ contents _ 'Method was added, but cannot be found!!'].			contents _ class sourceCodeAt: sel.			Preferences browseWithPrettyPrint ifTrue: [contents _ class parserClass new							format: contents							in: class							notifying: nil							decorated: Preferences colorWhenPrettyPrinting].			self showDiffs ifTrue: [contents _ self diffFromPriorSourceFor: contents].			^ contents _ contents asText makeSelectorBoldIn: class]! !!ClassDescription methodsFor: 'fileIn/Out' stamp: 'rw 4/24/2001 12:56'!reformatMethodAt: selector 	| newCodeString method |	newCodeString _ self parserClass new				format: (self sourceCodeAt: selector)				in: self				notifying: nil				decorated: false.	method _ self compiledMethodAt: selector.	method		putSource: newCodeString		fromParseNode: nil		class: self		category: (self organization categoryOfElement: selector)		inFile: 2		priorMethod: method! !!Debugger methodsFor: 'context stack (message list)' stamp: 'rw 4/24/2001 12:56'!selectedMessage
	"Answer the source code of the currently selected context."	contents _ [self selectedContext sourceCode]				ifError: [:err :rcvr | 'ERROR"' , (err reject: [:each | each == $"]) , '"'].	Preferences browseWithPrettyPrint ifTrue: [contents _ self selectedClass parserClass new					format: contents					in: self selectedClass					notifying: nil					decorated: Preferences colorWhenPrettyPrinting].	^ contents _ contents asText makeSelectorBoldIn: self selectedClass! !!FileContentsBrowser methodsFor: 'edit pane' stamp: 'rw 4/24/2001 12:57'!selectedMessage	"Answer a copy of the source code for the selected message selector."	| class selector |	class _ self selectedClassOrMetaClass.	selector _ self selectedMessageName.	contents _ class sourceCodeAt: selector.	Preferences browseWithPrettyPrint ifTrue: [contents _ class parserClass new					format: contents					in: class					notifying: nil					decorated: Preferences colorWhenPrettyPrinting].	self showDiffs ifTrue: [contents _ self					methodDiffF
or: contents					class: self selectedClass					selector: self selectedMessageName					meta: self metaClassIndicated].	^ contents asText makeSelectorBoldIn: class! !!MessageSet methodsFor: 'contents' stamp: 'rw 4/24/2001 12:58'!selectedMessage	"Answer the source method for the currently selected message."	| source |	self		setClassAndSelectorIn: 			[:class :selector | 			class ifNil: [^ 'Class vanished'].			source _ class sourceMethodAt: selector						ifAbsent: 							[currentCompiledMethod _ nil.							^ 'Missing'].			currentCompiledMethod _ class compiledMethodAt: selector ifAbsent: [].			Preferences browseWithPrettyPrint ifTrue: [source _ class parserClass new							format: source							in: class							notifying: nil							decorated: Preferences colorWhenPrettyPrinting].			self showDiffs ifTrue: [source _ self diffFromPriorSourceFor: source].			^ source asText makeSelectorBoldIn: class]! !!LinkedMessageSet methodsFor: 'as yet unclassified' stamp: 'rw 4/24/2001 12:58'!selectedMe
ssage	"Answer the source method for the currently selected message. Allow 	class comment, definition, and hierarchy."	| source |	self		setClassAndSelectorIn: 			[:class :selector | 			selector first isUppercase				ifFalse: 					[source _ class sourceMethodAt: selector.					currentCompiledMethod _ class compiledMethodAt: selector ifAbsent: [].					^ source asText makeSelectorBoldIn: self selectedClassOrMetaClass].			selector = #Comment ifTrue: [^ class comment].			selector = #Definition ifTrue: [^ class definition].			selector = #Hierarchy ifTrue: [^ class printHierarchy].			source _ class sourceMethodAt: selector.			currentCompiledMethod _ class compiledMethodAt: selector ifAbsent: [].			Preferences browseWithPrettyPrint ifTrue: [source _ class parserClass new							format: source							in: class							notifying: nil							decorated: Preferences colorWhenPrettyPrinting].			^ source asText makeSelectorBoldIn: self selectedClassOrMetaClass]! !!MethodHolder methodsFor: 'as yet unclassif
ied' stamp: 'rw 4/24/2001 12:58'!contents	contents _ methodClass sourceCodeAt: methodSelector ifAbsent: [''].	currentCompiledMethod _ methodClass compiledMethodAt: methodSelector ifAbsent: [].	Preferences browseWithPrettyPrint ifTrue: [contents _ methodClass parserClass new					format: contents					in: methodClass					notifying: nil					decorated: Preferences colorWhenPrettyPrinting].	self showDiffs ifTrue: [contents _ self diffFromPriorSourceFor: contents].	contents _ contents asText makeSelectorBoldIn: methodClass.	^ contents! !!ParagraphEditor methodsFor: 'menu messages' stamp: 'rw 4/24/2001 12:58'!prettyPrint: decorated 	"Reformat the contents of the receiver's view (a Browser)."	| selectedClass newText |	model selectedMessageCategoryName ifNil: [^ view flash].	selectedClass _ model selectedClassOrMetaClass.	newText _ selectedClass parserClass new				format: self text				in: selectedClass				notifying: self				decorated: decorated.	newText		ifNotNil: 			[self deselect; selectIn
visiblyFrom: 1 to: paragraph text size.			self replaceSelectionWith: (newText asText makeSelectorBoldIn: selectedClass).			self selectAt: 1]! !!Parser methodsFor: 'public access' stamp: 'rw 4/24/2001 12:59'!format: textOrStream in: aClass notifying: aRequestor decorated: aBoolean 	"Compile a parse tree from the argument, textOrStream. Answer a string  	containing the original code, formatted nicely. If aBoolean is true, then 	decorate the resulting text with color and hypertext actions"	| aNode sourceStream |	(textOrStream isKindOf: PositionableStream)		ifTrue: [sourceStream _ textOrStream]		ifFalse: [sourceStream _ ReadStream on: textOrStream asString].	aNode _ self				parse: sourceStream				class: aClass				noPattern: false				context: nil				notifying: aRequestor				ifFail: [^ nil].	^ aBoolean		ifTrue: [aNode decompileText]		ifFalse: [aNode decompileString]! !!SystemDictionary methodsFor: 'housekeeping' stamp: 'rw 4/24/2001 12:58'!testFormatter	"Smalltalk testFormatter"	"Refor
mats the source for every method in the system, and then 	compiles that source and verifies that it generates identical code. The 	formatting used will be either classic monochrome or fancy 	polychrome, depending on the setting of the preference 	#colorWhenPrettyPrinting. "	| newCodeString methodNode oldMethod newMethod badOnes n |	badOnes _ OrderedCollection new.	Smalltalk forgetDoIts.	'Formatting all classes...'		displayProgressAt: Sensor cursorPoint		from: 0		to: CompiledMethod instanceCount		during: 			[:bar | 			n _ 0.			Smalltalk allBehaviorsDo: [:cls | "Transcript cr; show: cls name."				cls selectors do: 					[:selector | 					(n _ n + 1) \\ 100 = 0 ifTrue: [bar value: n].					newCodeString _ cls parserClass new								format: (cls sourceCodeAt: selector)								in: cls								notifying: nil								decorated: Preferences colorWhenPrettyPrinting.					methodNode _ cls compilerClass new								compile: newCodeString								in: cls								notifying: nil								ifFail: [].				
	newMethod _ methodNode generate: #(0 0 0 0 ).					oldMethod _ cls compiledMethodAt: selector.					oldMethod = newMethod						ifFalse: 							[Transcript cr; show: '***' , cls name , ' ' , selector.							badOnes add: cls name , ' ' , selector]]]].	Smalltalk browseMessageList: badOnes asSortedCollection name: 'Formatter Discrepancies'! !!SystemDictionary methodsFor: 'housekeeping' stamp: 'rw 4/24/2001 12:58'!testFormatter2	"Smalltalk testFormatter2"	"Reformats the source for every method in the system, and then verifies 	that the order of source tokens is unchanged. The formatting used will 	be either classic monochrome or fancy polychrome, depending on the 	setting of the preference #colorWhenPrettyPrinting."	| newCodeString badOnes n oldCodeString oldTokens newTokens |	badOnes _ OrderedCollection new.	Smalltalk forgetDoIts.	'Formatting all classes...'		displayProgressAt: Sensor cursorPoint		from: 0		to: CompiledMethod instanceCount		during: 			[:bar | 			n _ 0.			Smalltalk allBehav
iorsDo: [:cls | "Transcript cr; show: cls name."				cls selectors do: 					[:selector | 					(n _ n + 1) \\ 100 = 0 ifTrue: [bar value: n].					oldCodeString _ (cls sourceCodeAt: selector) asString.					newCodeString _ cls parserClass new								format: oldCodeString								in: cls								notifying: nil								decorated: Preferences colorWhenPrettyPrinting.					oldTokens _ oldCodeString findTokens: Character separators.					newTokens _ newCodeString findTokens: Character separators.					oldTokens = newTokens						ifFalse: 							[Transcript cr; show: '***' , cls name , ' ' , selector.							badOnes add: cls name , ' ' , selector]]]].	Smalltalk browseMessageList: badOnes asSortedCollection name: 'Formatter Discrepancies'! !!TimeProfileBrowser methodsFor: 'private' stamp: 'rw 4/24/2001 12:59'!selectedMessage	"Answer the source method for the currently selected message."	| source |	self		setClassAndSelectorIn: 			[:class :selector | 			source _ class sourceMethodAt: selector ifAbsent: 
[^ 'Missing'].			Preferences browseWithPrettyPrint ifTrue: [source _ class parserClass new							format: source							in: class							notifying: nil							decorated: false].			^ source asText makeSelectorBoldIn: class].	^ ''! !Compiler removeSelector: #format:in:notifying:decorated:!Compiler removeSelector: #format:noPattern:ifFail:!