The Trunk: Tools-mt.1028.mcz

Marcel Taeumel uploaded a new version of Tools to project The Trunk:
http://source.squeak.org/trunk/Tools-mt.1028.mcz

==================== Summary ====================

Name: Tools-mt.1028
Author: mt
Time: 4 March 2021, 3:33:48.778661 pm
UUID: ac105d50-b9ae-9f48-9233-3c4e5bdd741f
Ancestors: Tools-mt.1027

Makes CodeHolder useful by itself. It can easily be used to show and edit a single compiled method. Compilation logic extracted from Browser.

=============== Diff against Tools-mt.1027 ===============

Item was changed:
+ ----- Method: CodeHolder>>aboutToStyle: (in category 'code pane') -----
- ----- Method: CodeHolder>>aboutToStyle: (in category 'contents') -----
  aboutToStyle: aStyler
- "This is a notification that aStyler is about to re-style its text.
- The default is to answer false to veto the styling"
 
+ currentCompiledMethod ifNil: [^ false].
+ aStyler classOrMetaClass: self selectedClassOrMetaClass.
+ ^ true!
- ^false!

Item was added:
+ ----- Method: CodeHolder>>compileMessage:notifying: (in category 'code pane') -----
+ compileMessage: aString notifying: aController
+ "Compile the code that was accepted by the user, placing the compiled method into an appropriate message category.  Return true if the compilation succeeded, else false."
+
+ | selectedMessageName selector category selectedClassOrMetaClass |
+ selectedMessageName := self selectedMessageName.
+ selectedClassOrMetaClass := self selectedClassOrMetaClass.
+ contents := nil.
+ selector := (selectedClassOrMetaClass newParser parseSelector: aString).
+ (self metaClassIndicated
+ and: [(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]].
+ category := self selectedMessageCategoryName.
+ selector := selectedClassOrMetaClass
+ compile: aString
+ classified: category
+ notifying: aController.
+ selector == nil ifTrue: [^ nil].
+ contents := aString copy.
+ currentCompiledMethod := selectedClassOrMetaClass compiledMethodAt: selector.
+ ^ true!

Item was added:
+ ----- Method: CodeHolder>>contents:notifying: (in category 'accessing') -----
+ contents: input notifying: aController
+ "The retrieved information has changed and its source must now be updated. Answer the result of updating the source."
+
+ self changed: #annotation.
+
+ ^ self okayToAccept
+ ifFalse: [false]
+ ifTrue: [self compileMessage: input asText notifying: aController].!

Item was added:
+ ----- Method: CodeHolder>>defaultBrowserTitle (in category 'initialize-release') -----
+ defaultBrowserTitle
+
+ ^ 'Source Code'!

Item was added:
+ ----- Method: CodeHolder>>labelString (in category 'initialize-release') -----
+ labelString
+
+ | label |
+ label := self defaultBrowserTitle.
+ currentCompiledMethod ifNotNil: [
+ label := label, (': {1} >> #{2} ({3})' format: {
+ self selectedClassOrMetaClass name.
+ self selectedMessageName.
+ self selectedMessageCategoryName })].
+ ^ label!

Item was added:
+ ----- Method: CodeHolder>>metaClassIndicated (in category 'accessing') -----
+ metaClassIndicated
+
+ ^ self selectedClassOrMetaClass isMeta!

Item was added:
+ ----- Method: CodeHolder>>selectedClass (in category 'accessing') -----
+ selectedClass
+
+ ^ self selectedClassOrMetaClass ifNotNil: [:cls | cls theNonMetaClass]!

Item was added:
+ ----- Method: CodeHolder>>selectedClassOrMetaClass (in category 'accessing') -----
+ selectedClassOrMetaClass
+
+ ^ currentCompiledMethod ifNotNil: [:method | method methodClass]!

Item was added:
+ ----- Method: CodeHolder>>selectedMessageName (in category 'accessing') -----
+ selectedMessageName
+
+ ^ currentCompiledMethod
+ ifNil: [super selectedMessageName]
+ ifNotNil: [:method | method selector]!

Item was added:
+ ----- Method: CodeHolder>>setClass:selector: (in category 'initialize-release') -----
+ setClass: aBehavior selector: aSymbol
+
+ contents := nil.
+ currentCompiledMethod := aBehavior compiledMethodAt: aSymbol.
+ self changed: #relabel.
+ self contentsChanged.
+ self decorateButtons.!