[Fix] Repost of formatpatch
Roel Wuyts
wuyts at iam.unibe.ch
Wed Apr 25 07:08:15 UTC 2001
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:!
More information about the Squeak-dev
mailing list
|