The Trunk: Tools-mt.914.mcz

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

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

Name: Tools-mt.914
Author: mt
Time: 15 November 2019, 2:36:45.66233 pm
UUID: 0df495c8-ef25-1742-aa44-82ee0c5cae5a
Ancestors: Tools-mt.913, Tools-ct.872, Tools-ct.873, Tools-ct.874, Tools-ct.879, Tools-ct.884, Tools-ct.893, Tools-ct.894

Merge, merge, merge:
- some UI fixes and refactorings for browser buttons
- adds #browse to CompiledMethod, PackageInfo, MethodReference
- adds support for #removeMessage to Debugger, which is already working in other CodeHolder tools
- some fixes in ProcessBrowser
- improved error messages

I decided to put the convenient #browseMethod: in ToolSet instead of StandardToolSet.

In ToolSet, I decided to use the term "category" without a class context to mean "system category", which is also the case in Browser's class-side messages.

I think that those #ifNil-checks in ProcessBrowser are ugly and need to be re-designed in the future. :-) But they are more consistent now.

=============== Diff against Tools-mt.913 ===============

Item was removed:
- ----- Method: CodeHolder>>addCodeProvenanceButtonTo:using: (in category 'toolbuilder') -----
- addCodeProvenanceButtonTo: panelSpec using: builder
- panelSpec children add: (self buildCodeProvenanceButtonWith: builder)!

Item was changed:
  ----- Method: CodeHolder>>buildOptionalButtonsWith: (in category 'toolbuilder') -----
  buildOptionalButtonsWith: builder
 
  | panelSpec |
  panelSpec := builder pluggablePanelSpec new.
  panelSpec children: OrderedCollection new.
  self optionalButtonPairs do:[:spec|
  | buttonSpec |
  buttonSpec := builder pluggableActionButtonSpec new.
  buttonSpec model: self.
  buttonSpec label: spec first.
  buttonSpec action: spec second.
  spec second == #methodHierarchy
  ifTrue:[buttonSpec
  enabled: #inheritanceButtonEnabled;
  color: #inheritanceButtonColor].
  spec second == #browseVersions
  ifTrue:[buttonSpec enabled: #versionsButtonEnabled].
  spec size > 2 ifTrue:[buttonSpec help: spec third].
  panelSpec children add: buttonSpec].
 
  "What to show"
+ self wantsCodeProvenanceButton ifTrue: [
+ panelSpec children
+ add: builder pluggableSpacerSpec new;
+ add: (self buildCodeProvenanceButtonWith: builder)].
- panelSpec children add: builder pluggableSpacerSpec new.
- self addCodeProvenanceButtonTo: panelSpec using: builder.
 
  panelSpec layout: #horizontal. "buttons"
  ^panelSpec!

Item was added:
+ ----- Method: CodeHolder>>wantsCodeProvenanceButton (in category 'what to show') -----
+ wantsCodeProvenanceButton
+
+ ^ true!

Item was added:
+ ----- Method: CompiledMethod>>browse (in category '*Tools-Browsing') -----
+ browse
+
+ ^ ToolSet browseMethod: self!

Item was removed:
- ----- Method: Debugger>>addCodeProvenanceButtonTo:using: (in category 'toolbuilder') -----
- addCodeProvenanceButtonTo: panelSpec using: builder
- "No thanks!!"!

Item was added:
+ ----- Method: Debugger>>findCleanHomeBelow: (in category 'context stack (message list)') -----
+ findCleanHomeBelow: method
+
+ | dirtyIndex |
+ dirtyIndex := contextStack size + 1.
+ contextStack reverse detect: [:context |
+ dirtyIndex := dirtyIndex - 1.
+ context method = method].
+ ^ dirtyIndex + 1!

Item was changed:
  ----- Method: Debugger>>mainContextStackMenu: (in category 'context stack menu') -----
  mainContextStackMenu: aMenu
  "Set up the menu appropriately for the context-stack-list, unshifted"
  <contextStackMenuShifted: false>
  ^ aMenu addList: #(
  ('fullStack (f)' fullStack)
  ('restart (r)' restart)
  ('proceed (p)' proceed)
  ('step (t)' doStep)
  ('step through (T)' stepIntoBlock)
  ('send (e)' send)
  ('where (w)' where)
  ('peel to first like this' peelToFirst)
  -
  ('return entered value' returnValue)
  -
  ('toggle break on entry' toggleBreakOnEntry)
  ('senders of    (n)' browseSendersOfMessages)
  ('implementors of    (m)' browseMessages)
  ('inheritance (i)' methodHierarchy)
  -
  ('versions (v)' browseVersions)
  -
  ('references    (r)' browseVariableReferences)
  ('assignments    (a)' browseVariableAssignments)
  -
  ('class refs (N)' browseClassRefs)
  ('browse full (b)' browseMethodFull)
  ('file out ' fileOutMessage)
+ ('remove method (x) ' removeMessage)
  -
  ('copy bug report to clipboard' copyBugReportToClipboard));
  yourself
  !

Item was added:
+ ----- Method: Debugger>>removeMessage (in category 'context stack menu') -----
+ removeMessage
+
+ | oldContext method cleanIndex confirmation  |
+ self okToChange ifFalse: [^ false].
+ contextStackIndex isZero ifTrue: [^ false].
+
+ oldContext := self selectedContext.
+ method := oldContext method.
+ cleanIndex := self findCleanHomeBelow: method.
+ contextStack at: cleanIndex ifAbsent: [
+ self inform: 'Sender of method not found on stack, can''t remove message'.
+ ^ false].
+ (self confirm: 'I will have to revert to the sender of this message.  Is that OK?')
+ ifFalse: [^ false].
+
+ confirmation := self systemNavigation
+ confirmRemovalOf: method selector
+ on: method methodClass.
+ confirmation = 3 ifTrue: [^ self].
+ self selectedClassOrMetaClass removeSelector: method selector.
+
+ self
+ contextStackIndex: cleanIndex oldContextWas: oldContext;
+ tryRestartFrom: self selectedContext.
+ confirmation = 2
+ ifTrue: [self systemNavigation browseAllCallsOn: method selector].!

Item was changed:
  ----- Method: Debugger>>restart (in category 'context stack menu') -----
  restart
  "Proceed from the initial state of the currently selected context. The
  argument is a controller on a view of the receiver. That view is closed."
  "Closing now depends on a preference #restartAlsoProceeds - hmm 9/7/2001 16:46"
 
+ | unwindError |
- | ctxt noUnwindError |
  self okToChange ifFalse: [^ self].
  self checkContextSelection.
+ unwindError := self tryRestartFrom: self selectedContext.
- ctxt := interruptedProcess popTo: self selectedContext.
- noUnwindError := false.
- ctxt == self selectedContext ifTrue: [
- noUnwindError := true.
- interruptedProcess restartTop; stepToSendOrReturn].
- self resetContext: ctxt.
  ((Preferences restartAlsoProceeds
+ and: [unwindError not])
+ and: [self interruptedProcessShouldResume])
+ ifTrue: [self proceed].!
- and: [noUnwindError])
- and: [self interruptedProcessShouldResume]) ifTrue: [self proceed].
- !

Item was added:
+ ----- Method: Debugger>>tryRestartFrom: (in category 'context stack menu') -----
+ tryRestartFrom: context
+ "Try to restart from the initial state of the context.
+ Return whether an unwind error occurred."
+
+ | actualContext unwindError |
+ actualContext := interruptedProcess popTo: context.
+ unwindError := actualContext ~= context.
+ unwindError ifFalse: [
+ interruptedProcess restartTop; stepToSendOrReturn].
+ self resetContext: actualContext.
+ ^ unwindError!

Item was added:
+ ----- Method: Debugger>>wantsCodeProvenanceButton (in category 'toolbuilder') -----
+ wantsCodeProvenanceButton
+
+ ^ false!

Item was added:
+ ----- Method: MethodReference>>browse (in category '*Tools-Browsing') -----
+ browse
+
+ ^ ToolSet browse: self actualClass selector: self selector!

Item was changed:
  ----- Method: PackageInfo>>browse (in category '*Tools-Browsing') -----
  browse
 
+ ^ ToolSet browsePackage: self!
- ^ StandardToolSet browseSystemCategory: self packageName!

Item was changed:
  ----- Method: PluggableFileList>>open (in category 'initialize-release') -----
  open
+ self deprecated: 'PluggableFileList is being deprecated'. "This can go away soon"
+
- "PluggableFileList is being deprecated and this can go away soon"
- self deprecated: 'PluggableFileList must die'.
-
  ^ Project uiManager openPluggableFileList: self label: prompt in: self currentWorld!

Item was changed:
  ----- Method: ProcessBrowser>>changePriority (in category 'process actions') -----
  changePriority
  | str newPriority nameAndRules |
+ selectedProcess ifNil: [^ self].
  nameAndRules := self nameAndRulesForSelectedProcess.
  nameAndRules third
  ifFalse: [self inform: 'Nope, won''t change priority of ' , nameAndRules first.
  ^ self].
  str := UIManager default
  request: 'New priority'
   initialAnswer: selectedProcess priority asString.
  newPriority := str asNumber asInteger.
  newPriority
  ifNil: [^ self].
  (newPriority < 1
  or: [newPriority > Processor highestPriority])
  ifTrue: [self inform: 'Bad priority'.
  ^ self].
  self class setProcess: selectedProcess toPriority: newPriority.
  self updateProcessList!

Item was changed:
  ----- Method: ProcessBrowser>>chasePointers (in category 'process actions') -----
  chasePointers
  | saved |
+ selectedProcess ifNil: [^ self].
- selectedProcess
- ifNil: [^ self].
  saved := selectedProcess.
  [selectedProcess := nil.
  (Smalltalk includesKey: #PointerFinder)
  ifTrue: [PointerFinder on: saved]
  ifFalse: [self inspectPointers]]
  ensure: [selectedProcess := saved]!

Item was changed:
  ----- Method: ProcessBrowser>>debugProcess (in category 'process actions') -----
  debugProcess
  | nameAndRules |
+ selectedProcess ifNil: [^ self].
  nameAndRules := self nameAndRulesForSelectedProcess.
  nameAndRules third
  ifFalse: [self inform: 'Nope, won''t debug ' , nameAndRules first.
  ^ self].
  self class debugProcess: selectedProcess.!

Item was changed:
  ----- Method: ProcessBrowser>>exploreContext (in category 'stack list') -----
  exploreContext
+ selectedContext ifNotNil: #explore!
- selectedContext explore!

Item was changed:
  ----- Method: ProcessBrowser>>exploreProcess (in category 'process list') -----
  exploreProcess
+ selectedProcess ifNotNil: #explore!
- selectedProcess explore!

Item was changed:
  ----- Method: ProcessBrowser>>exploreReceiver (in category 'stack list') -----
  exploreReceiver
+ selectedContext ifNotNil: [
+ selectedContext receiver explore]!
- selectedContext ifNotNil: [ selectedContext receiver explore ]!

Item was changed:
  ----- Method: ProcessBrowser>>inspectContext (in category 'stack list') -----
  inspectContext
+ selectedContext ifNotNil: #inspect!
- selectedContext inspect!

Item was changed:
  ----- Method: ProcessBrowser>>inspectPointers (in category 'process actions') -----
  inspectPointers
  | tc pointers |
+ selectedProcess ifNil: [^ self].
- selectedProcess ifNil: [^self].
  tc := thisContext.
+ pointers := PointerFinder
+ pointersTo: selectedProcess
+ except: {
+ self processList.
+ tc.
+ self}.
+ pointers isEmpty ifTrue: [^ self].
- pointers := PointerFinder pointersTo: selectedProcess
- except: {
- self processList.
- tc.
- self}.
- pointers isEmpty ifTrue: [^self].
  OrderedCollectionInspector
  openOn: pointers
  withEvalPane: false
  withLabel: 'Objects pointing to ' , selectedProcess browserPrintString!

Item was changed:
  ----- Method: ProcessBrowser>>inspectProcess (in category 'process list') -----
  inspectProcess
+ selectedProcess ifNotNil: #inspect!
- selectedProcess inspect!

Item was changed:
  ----- Method: ProcessBrowser>>inspectReceiver (in category 'stack list') -----
  inspectReceiver
+ selectedContext ifNotNil: [
+ selectedContext receiver inspect]!
- selectedContext
- ifNotNil: [selectedContext receiver inspect]!

Item was changed:
  ----- Method: ProcessBrowser>>messageTally (in category 'stack list') -----
  messageTally
  | secString secs |
+ selectedProcess ifNil: [^ self].
  secString := UIManager default request: 'Profile for how many seconds?' initialAnswer: '4'.
+ secString isEmptyOrNil ifTrue: [^ self].
  secs := secString asNumber asInteger.
+ (secs isNil or: [secs isZero])
- (secs isNil
- or: [secs isZero])
  ifTrue: [^ self].
  [ TimeProfileBrowser spyOnProcess: selectedProcess forMilliseconds: secs * 1000 ] forkAt: selectedProcess priority + 1.!

Item was changed:
  ----- Method: ProcessBrowser>>resumeProcess (in category 'process actions') -----
  resumeProcess
+ selectedProcess ifNil: [^ self].
- selectedProcess
- ifNil: [^ self].
  self class resumeProcess: selectedProcess.
  self updateProcessList!

Item was changed:
  ----- Method: ProcessBrowser>>signalSemaphore (in category 'process actions') -----
  signalSemaphore
+ selectedProcess ifNil: [^ self].
  (selectedProcess suspendingList isKindOf: Semaphore)
  ifFalse: [^ self].
  [selectedProcess suspendingList signal] fork.
  (Delay forMilliseconds: 300) wait.
  "Hate to make the UI wait, but it's convenient..."
  self updateProcessList!

Item was changed:
  ----- Method: ProcessBrowser>>suspendProcess (in category 'process actions') -----
  suspendProcess
  | nameAndRules |
+ selectedProcess ifNil: [^ self].
  selectedProcess isSuspended
  ifTrue: [^ self].
  nameAndRules := self nameAndRulesForSelectedProcess.
  nameAndRules second
  ifFalse: [self inform: 'Nope, won''t suspend ' , nameAndRules first.
  ^ self].
  self class suspendProcess: selectedProcess.
  self updateProcessList!

Item was changed:
  ----- Method: ProcessBrowser>>terminateProcess (in category 'process actions') -----
  terminateProcess
  | nameAndRules |
+ selectedProcess ifNil: [^ self].
  nameAndRules := self nameAndRulesForSelectedProcess.
  nameAndRules second
  ifFalse: [self inform: 'Nope, won''t kill ' , nameAndRules first.
  ^ self].
  self class terminateProcess: selectedProcess.
  self updateProcessList!

Item was added:
+ ----- Method: StandardToolSet class>>browseCategory: (in category 'browsing') -----
+ browseCategory: aCategory
+
+ ^ SystemBrowser default fullOnCategory: aCategory!

Item was added:
+ ----- Method: StandardToolSet class>>browseMethodVersion: (in category 'browsing') -----
+ browseMethodVersion: aCompiledMethod
+
+ ^ VersionsBrowser browseMethod: aCompiledMethod!

Item was added:
+ ----- Method: StandardToolSet class>>browsePackage: (in category 'browsing') -----
+ browsePackage: aPackageInfo
+
+ self flag: #discuss. "mt: Maybe use the package-pane browser?"
+ "PackagePaneBrowser fullOnCategory: aPackageInfo name"
+
+ ^ self browseCategory: aPackageInfo systemCategories first
+
+ !

Item was removed:
- ----- Method: StandardToolSet class>>browseSystemCategory: (in category 'browsing') -----
- browseSystemCategory: aCategory
-
- ^ SystemBrowser default
- fullOnCategory: aCategory!

Item was added:
+ ----- Method: VersionsBrowser class>>browseMethod: (in category 'instance creation') -----
+ browseMethod: aCompiledMethod
+
+ ^ (self browseVersionsForClass: aCompiledMethod methodClass selector: aCompiledMethod selector)
+ selectMethod: aCompiledMethod;
+ yourself!

Item was changed:
  ----- Method: VersionsBrowser class>>browseVersionsForClass:selector: (in category 'instance creation') -----
  browseVersionsForClass: aClass selector: aSelector
+
+ ^ self
- self
  browseVersionsOf: (aClass compiledMethodAt: aSelector)
  class: aClass
  meta: aClass isMeta
  category: (aClass organization categoryOfElement: aSelector)
  selector: aSelector!

Item was added:
+ ----- Method: VersionsBrowser>>selectMethod: (in category 'menu') -----
+ selectMethod: aCompiledMethod
+
+ self toggleListIndex: (self changeList indexOf: (
+ self changeList detect: [:change | change stamp = aCompiledMethod timeStamp]))!