Nicolas Cellier uploaded a new version of Tools to project The Trunk: http://source.squeak.org/trunk/Tools-nice.302.mcz
==================== Summary ====================
Name: Tools-nice.302 Author: nice Time: 30 March 2011, 9:46:08.165 pm UUID: d076ded9-2b09-4e05-8a12-f8e0cd6ec0cc Ancestors: Tools-eem.301
Use #newCompiler #newParser
=============== Diff against Tools-eem.301 ===============
Item was changed: ----- Method: Browser>>defineMessageFrom:notifying: (in category 'message functions') ----- defineMessageFrom: aString notifying: aController "Compile the expressions in aString. Notify aController if a syntax error occurs. Install the compiled method in the selected class classified under the currently selected message category name. Answer the selector obtained if compilation succeeds, nil otherwise." | selectedMessageName selector category oldMessageList | selectedMessageName := self selectedMessageName. oldMessageList := self messageList. contents := nil. + selector := (self selectedClassOrMetaClass newParser parseSelector: aString). - selector := (self selectedClassOrMetaClass parserClass new parseSelector: aString). (self metaClassIndicated and: [(self selectedClassOrMetaClass includesSelector: selector) not and: [Metaclass isScarySelector: selector]]) ifTrue: ["A frist-time definition overlaps the protocol of Metaclasses" (self confirm: ((selector , ' is used in the existing class system. Overriding it could cause serious problems. Is this really what you want to do?') asText makeBoldFrom: 1 to: selector size)) ifFalse: [^nil]]. selector := self selectedClassOrMetaClass compile: aString classified: (category := self selectedMessageCategoryName) notifying: aController. selector == nil ifTrue: [^ nil]. contents := aString copy. selector ~~ selectedMessageName ifTrue: [category = ClassOrganizer nullCategory ifTrue: [self changed: #classSelectionChanged. self changed: #classList. self messageCategoryListIndex: 1]. self setClassOrganizer. "In case organization not cached" (oldMessageList includes: selector) ifFalse: [self changed: #messageList]. self messageListIndex: (self messageList indexOf: selector)]. ^ selector!
Item was changed: ----- Method: ChangeList>>removeExistingMethodVersions (in category 'menu actions') ----- removeExistingMethodVersions "Remove all up to date version of entries from the receiver" | newChangeList newList | newChangeList := OrderedCollection new. newList := OrderedCollection new.
changeList with: list do:[:chRec :strNstamp | | str keep cls sel | keep := true. (cls := chRec methodClass) ifNotNil:[ str := chRec string. + sel := cls newParser parseSelector: str. - sel := cls parserClass new parseSelector: str. keep := (cls sourceCodeAt: sel ifAbsent:['']) asString ~= str. ]. keep ifTrue:[ newChangeList add: chRec. newList add: strNstamp]]. newChangeList size < changeList size ifTrue: [changeList := newChangeList. list := newList. listIndex := 0. listSelections := Array new: list size withAll: false]. self changed: #list!
Item was changed: ----- Method: ChangeList>>scanCategory:class:meta:stamp: (in category 'scanning') ----- scanCategory: category class: class meta: meta stamp: stamp | itemPosition method selector | [itemPosition := file position. method := file nextChunk. file skipStyleChunk. method size > 0] "done when double terminators" whileTrue: [self addItem: (ChangeRecord new file: file position: itemPosition type: #method class: class category: category meta: meta stamp: stamp) text: 'method: ' , class , (meta ifTrue: [' class '] ifFalse: [' ']) + , ((selector := (Smalltalk at: class ifAbsent: [Object]) newParser parseSelector: method) isNil - , ((selector := (Smalltalk at: class ifAbsent: [Object]) parserClass new parseSelector: method) isNil ifTrue: ['unparsableSelector'] ifFalse: [selector]) , (stamp isEmpty ifTrue: [''] ifFalse: ['; ' , stamp])]!
Item was changed: ----- Method: ChangedMessageSet>>contents:notifying: (in category 'acceptance') ----- contents: aString notifying: aController "Accept the string as new source for the current method, and make certain the annotation pane gets invalidated"
| existingSelector existingClass superResult newSelector | existingSelector := self selectedMessageName. existingClass := self selectedClassOrMetaClass.
superResult := super contents: aString notifying: aController. superResult ifTrue: "succeeded" + [newSelector := existingClass newParser parseSelector: aString. - [newSelector := existingClass parserClass new parseSelector: aString. newSelector ~= existingSelector ifTrue: "Selector changed -- maybe an addition" [self reformulateList. self changed: #messageList. self messageList doWithIndex: [:aMethodReference :anIndex | (aMethodReference actualClass == existingClass and: [aMethodReference methodSymbol == newSelector]) ifTrue: [self messageListIndex: anIndex]]]]. ^ superResult!
Item was changed: ----- Method: CodeHolder>>decompiledSourceIntoContentsWithTempNames: (in category 'message list') ----- decompiledSourceIntoContentsWithTempNames: showTempNames "Obtain a source string by decompiling the method's code, and place that source string into my contents. Also return the string. Get temps from source file if showTempNames is true."
| tempNames class selector method | class := self selectedClassOrMetaClass. selector := self selectedMessageName. "Was method deleted while in another project?" method := class compiledMethodAt: selector ifAbsent: [^ ''].
currentCompiledMethod := method. (showTempNames not or: [method fileIndex > 0 and: [(SourceFiles at: method fileIndex) isNil]]) ifTrue: [ "Emergency or no source file -- decompile without temp names " contents := (class decompilerClass new decompile: selector in: class method: method) decompileString] + ifFalse: [tempNames := (class newCompiler - ifFalse: [tempNames := (class compilerClass new parse: method getSourceFromFile asString in: class notifying: nil) generate: CompiledMethodTrailer defaultMethodTrailer; schematicTempNamesString. contents := ((class decompilerClass new withTempNames: tempNames) decompile: selector in: class method: method) decompileString]. contents := contents asText makeSelectorBoldIn: class. ^ contents copy!
Item was changed: ----- Method: CodeHolder>>validateMessageSource:forSelector:inClass: (in category 'message list') ----- validateMessageSource: sourceString forSelector: aSelector inClass: theClass "Check whether there is evidence that method source is invalid"
+ (theClass newParser parseSelector: sourceString asString) = aSelector - (theClass parserClass new parseSelector: sourceString asString) = aSelector ifFalse: [self informPossiblyCorruptSource].!
Item was changed: ----- Method: Debugger>>contents:notifying: (in category 'accessing') ----- contents: aText notifying: aController "The retrieved information has changed and its source must now be updated. In this case, the retrieved information is the method of the selected context." | result selector classOfMethod category h ctxt newMethod | contextStackIndex = 0 ifTrue: [^false]. self selectedContext isExecutingBlock ifTrue: [h := self selectedContext activeHome. h ifNil: [self inform: 'Method for block not found on stack, can''t edit and continue'. ^false]. (self confirm: 'I will have to revert to the method from\which this block originated. Is that OK?' withCRs) ifFalse: [^false]. self resetContext: h. result := self contents: aText notifying: aController. self contentsChanged. ^result].
classOfMethod := self selectedClass. category := self selectedMessageCategoryName. + selector := self selectedClass newParser parseSelector: aText. - selector := self selectedClass parserClass new parseSelector: aText. (selector == self selectedMessageName or: [(self selectedMessageName beginsWith: 'DoIt') and: [selector numArgs = self selectedMessageName numArgs]]) ifFalse: [self inform: 'can''t change selector'. ^false]. selector := classOfMethod compile: aText classified: category notifying: aController. selector ifNil: [^false]. "compile cancelled" contents := aText. newMethod := classOfMethod compiledMethodAt: selector. newMethod isQuick ifTrue: [self down. self selectedContext jump: (self selectedContext previousPc - self selectedContext pc)]. ctxt := interruptedProcess popTo: self selectedContext. ctxt == self selectedContext ifFalse: [self inform: 'Method saved, but current context unchanged\because of unwind error. Click OK to see error' withCRs] ifTrue: [newMethod isQuick ifFalse: [interruptedProcess restartTopWith: newMethod; stepToSendOrReturn]. contextVariablesInspector object: nil]. self resetContext: ctxt. Smalltalk isMorphic ifTrue: [World addAlarm: #changed: withArguments: #(contentsSelection) for: self at: (Time millisecondClockValue + 200)]. ^true!
Item was changed: ----- Method: Debugger>>selectedMessage (in category 'context stack (message list)') ----- selectedMessage "Answer the source code of the currently selected context." + | aContext | + ^contents := (aContext := self selectedContext) debuggerMap sourceText asText makeSelectorBoldIn: aContext home receiver class! - ^contents := self selectedContext debuggerMap sourceText asText makeSelectorBold!
Item was changed: ----- Method: MethodHolder>>contents:notifying: (in category 'contents') ----- contents: input notifying: aController | selector | + (selector := methodClass newParser parseSelector: input asText) ifNil: - (selector := methodClass parserClass new parseSelector: input asText) ifNil: [self inform: 'Sorry - invalid format for the method name and arguments -- cannot accept.'. ^ false].
selector == methodSelector ifFalse: [self inform: 'You cannot change the name of the method here -- it must continue to be ', methodSelector. ^ false].
selector := methodClass compile: input asText classified: self selectedMessageCategoryName notifying: aController. selector == nil ifTrue: [^ false]. contents := input asString copy. currentCompiledMethod := methodClass compiledMethodAt: methodSelector. ^ true!
Item was changed: ----- Method: SyntaxError>>setClass:code:debugger:doitFlag: (in category 'accessing') ----- setClass: aClass code: aString debugger: aDebugger doitFlag: flag
| types printables badChar | class := aClass. debugger := aDebugger. + selector := aClass newParser parseSelector: aString. - selector := aClass parserClass new parseSelector: aString. types := Scanner classPool at: #TypeTable. "dictionary" printables := '!!@#$%&*-_=+<>{}?/,·£¢§¶ªº Úæگ׿«»`~`' asSet. badChar := aString detect: [:aChar | (types at: aChar asciiValue ifAbsent: [#xLetter]) == #xBinary and: [ (printables includes: aChar) not]] ifNone: [nil]. contents := badChar ifNil: [aString] ifNotNil: ['<<<This string contains a character (ascii value ', badChar asciiValue printString, ') that is not normally used in code>>> ', aString]. category ifNil: [category := aClass organization categoryOfElement: selector]. category ifNil: [category := ClassOrganizer default]. doitFlag := flag!
squeak-dev@lists.squeakfoundation.org