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"]
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://lists.squeakfoundation.org/pipermail/squeak-dev/attachments/20220116/6f719a85/attachment-0001.html>
-------------- next part --------------
A non-text attachment was scrubbed...
Name: mcSlips.1.cs
Type: application/octet-stream
Size: 6560 bytes
Desc: not available
URL: <http://lists.squeakfoundation.org/pipermail/squeak-dev/attachments/20220116/6f719a85/attachment-0002.obj>
-------------- next part --------------
A non-text attachment was scrubbed...
Name: mcSlips.png
Type: application/octet-stream
Size: 73908 bytes
Desc: not available
URL: <http://lists.squeakfoundation.org/pipermail/squeak-dev/attachments/20220116/6f719a85/attachment-0003.obj>