[squeak-dev] The Trunk: Tools-mt.914.mczcommits at source.squeak.org commits at source.squeak.orgFri Nov 15 13:36:49 UTC 2019
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]))!
More information about the Squeak-dev mailing list |