[Pkg] The Trunk: Tools-nice.302.mcz
commits at source.squeak.org
commits at source.squeak.org
Wed Mar 30 19:46:52 UTC 2011
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!
More information about the Packages
mailing list