Any fundamental objections before I would merge this into the Trunk? :-)
=============== Summary ===============
Change Set: mcSlips
Date: 16 January 2022
Author: Christoph Thiede
This changeset integrates the slip detection mechanism, previously only known from the domain of changesets, into the Monticello system. When users save a new version, it will automatically notify them about any possible slips and let them decide whether to browse them first or proceed the saving. Users can also scan their patch for slips manually by invocating the item from the patch list menu. The value of the preference #checkForSlips is still honored for the automatic detection, and the description of that preference is updated to mention the new usage.
=============== Postscript ===============
"Postscript:"
(Preferences preferenceAt: #checkForSlips) helpString: 'If true, then whenever you file out a change set or save a Monticello version, it is checked for ''slips'' and if any are found, you are so informed and given a chance to open a browser on them.'.
=============== Diff ===============
CompiledMethod>>hasReportableSlip {testing} · ct 1/15/2022 22:32 (changed)
hasReportableSlip
"Answer whether the receiver contains anything that should be brought
to the attention of the author when filing out. Customize the lists here
to suit your preferences. If slips do not get reported in spite of your
best efforts here, make certain that the Preference 'checkForSlips' is set
to true."
- #(#doOnlyOnce: #halt #halt: #hottest #printDirectlyToDisplay #toRemove #personal #urgent #haltOnce #haltOnce: #haltIf: )
+ #(#doOnlyOnce: #halt #halt: #hottest #printDirectlyToDisplay #toRemove #personal #urgent #haltOnce #haltOnce: #haltIf: #haltIfNil #haltOnCount: #halt:onCount: #break )
do: [:aLit | (self hasLiteral: aLit)
ifTrue: [^ true]].
#(#Transcript #AA #BB #CC #DD #EE )
do: [:aSymbol |
| assoc |
(assoc := Smalltalk globals
associationAt: aSymbol
ifAbsent: [])
ifNotNil: [(self hasLiteral: assoc)
ifTrue: [^ true]]].
^ false
MCChangeSelector>>select {actions} · ct 1/15/2022 22:46 (changed)
select
+
+ (Preferences checkForSlips ==> [self lookForSlips]) ifFalse: [^ self].
+
self answer: (MCPatch operations: kept)
MCDefinition>>hasReportableSlip {testing} · ct 1/15/2022 22:49
+ hasReportableSlip
+
+ ^ false
MCMethodDefinition (changed)
MCDefinition subclass: #MCMethodDefinition
- instanceVariableNames: 'classIsMeta source category selector className timeStamp'
+ instanceVariableNames: 'classIsMeta source category selector className timeStamp hasReportableSlip'
classVariableNames: ''
poolDictionaries: ''
category: 'Monticello-Modeling'
MCMethodDefinition class
instanceVariableNames: 'definitions'
""
MCMethodDefinition class>>forMethodReference: {create} · ct 1/15/2022 22:53 (changed)
forMethodReference: aMethodReference
| definition |
definition := self cachedDefinitions at: aMethodReference compiledMethod ifAbsent: [].
(definition isNil
or: [definition selector ~= aMethodReference methodSymbol
or: [definition className ~= aMethodReference classSymbol
or: [definition classIsMeta ~= aMethodReference classIsMeta
or: [definition category ~= aMethodReference category]]]])
ifTrue: [definition := self
className: aMethodReference classSymbol
classIsMeta: aMethodReference classIsMeta
selector: aMethodReference methodSymbol
category: aMethodReference category
timeStamp: aMethodReference timeStamp
source: aMethodReference source.
+ definition hasReportableSlip: aMethodReference compiledMethod hasReportableSlip.
self cachedDefinitions at: aMethodReference compiledMethod put: definition].
^ definition
MCMethodDefinition>>hasReportableSlip {accessing} · ct 1/15/2022 22:54
+ hasReportableSlip
+
+ ^ hasReportableSlip ifNil: [false]
MCMethodDefinition>>hasReportableSlip: {accessing} · ct 1/15/2022 22:53
+ hasReportableSlip: aBoolean
+
+ hasReportableSlip := aBoolean.
MCPatchBrowser>>checkForSlips {actions} · ct 1/15/2022 23:12
+ checkForSlips
+
+ ^ self checkForSlipsIn: self items
MCPatchBrowser>>checkForSlipsIn: {actions} · ct 1/15/2022 23:07
+ checkForSlipsIn: patchItems
+
+ ^ patchItems select: [:ea | ea hasReportableSlip]
MCPatchBrowser>>lookForSlips {actions} · ct 1/15/2022 23:11
+ lookForSlips
+ "Look for slips in all changes. If there are any, ask the user how to treat them. Answer true if the operation should go on, or false if it should be canceled."
+
+ | slips |
+ slips := self checkForSlips ifEmpty: [^ true].
+ (Project uiManager
+ chooseFromLabeledValues: (OrderedDictionary new
+ at: 'Browse slips' translated put: [self systemNavigation
+ browseMessageList: (slips collect: [:ea | ea definition asMethodReference])
+ name: 'Possible slips in new version' translated];
+ at: 'Ignore slips and continue' translated put: [^ true];
+ at: 'Cancel' translated put: [^ false];
+ yourself)
+ title: ('This patch contains {1} halts, Transcript sends, or other possible slips.\\Save the new version anyway?' withCRs translated format: {slips size})) value.
+ ^ false
MCPatchBrowser>>methodListMenu: {menus} · ct 1/15/2022 23:01
+ methodListMenu: aMenu
+
+ super methodListMenu: aMenu.
+
+ aMenu add: 'check for slips' translated help: 'Check all changes for possible slips such as forgotten breakpoints or logging statements.' translated action: #reportSlips.
+
+ ^ aMenu
MCPatchBrowser>>reportSlips {actions} · ct 1/15/2022 23:05
+ reportSlips
+ "Look for slips in all changes and report to the user what was found."
+
+ | slips |
+ slips := self checkForSlips ifEmpty: [^ self inform: 'There were no obvious slips in this patch' translated].
+ self systemNavigation
+ browseMessageList: (slips collect: [:ea | ea definition asMethodReference])
+ name: 'Possible slips in new version' translated.
MCPatchOperation>>hasReportableSlip {testing} · ct 1/15/2022 22:49
+ hasReportableSlip
+
+ ^ self targetDefinition
+ ifNil: [false]
+ ifNotNil: [:def | def hasReportableSlip]
MCSaveVersionDialog>>accept {actions} · ct 1/15/2022 23:06 (changed)
accept
| logMessage logMessageWidget |
self updateItems.
+
+ (Preferences checkForSlips ==> [self lookForSlips]) ifFalse: [^ self].
+
logMessage := (logMessageWidget := self findTextMorph: #logMessage) text asString.
(logMessage isEmpty or: [logMessage beginsWith: 'empty log message'])
ifTrue:
- [(UIManager confirm: 'the log message is empty; are you sure you want to commit') ifFalse: [^ self]]
+ [(self confirm: 'The log message is empty; are you sure you want to commit?' translated) ifFalse: [^ self]]
ifFalse: [logMessageWidget accept].
+
self answer: {
(self findTextMorph: #versionName) text asString.
logMessage.
ignore }
MCSaveVersionDialog>>checkForSlips {actions} · ct 1/15/2022 23:12
+ checkForSlips
+
+ ^ super checkForSlipsIn: (self items copyWithoutAll: self ignore)
Preference>>helpString: {menu} · ct 1/16/2022 01:31
+ helpString: aString
+
+ helpString := aString
---
Sent from Squeak Inbox Talk
["mcSlips.1.cs"]
["mcSlips.png"]