[squeak-dev] The Inbox: Monticello-ct.776.mcz

commits at source.squeak.org commits at source.squeak.org
Thu Apr 7 21:12:56 UTC 2022


A new version of Monticello was added to project The Inbox:
http://source.squeak.org/inbox/Monticello-ct.776.mcz

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

Name: Monticello-ct.776
Author: ct
Time: 7 April 2022, 11:12:55.033279 pm
UUID: 3c34be3d-e7b0-d048-87c9-865c51e20cf9
Ancestors: Monticello-ct.775

Proposal: Updates patch message suggestions (aka 'text below is ignored') when refreshing a save-version dialog. This is helpful when preparing a merge commit, and writing your commit message and adopting new commits in parallel.

To implement this, MCSaveVersionDialog now depends on the request exception rather than the extracted patchBlock. To the request exception, add a new messageBlock field.

Also formats the ignored text in gray color (however, this is no dynamic styling :D).

Also disables updating before accepting a save-version dialog to avoid unexpected surprises. Please discuss. See the comment in MCSaveVersionDialog>>#accept.

Please review. :-)

=============== Diff against Monticello-ct.775 ===============

Item was changed:
  MCPatchBrowser subclass: #MCSaveVersionDialog
+ 	instanceVariableNames: 'name message ignore request'
- 	instanceVariableNames: 'name message ignore patchBlock'
  	classVariableNames: ''
  	poolDictionaries: ''
  	category: 'Monticello-UI'!

Item was changed:
  ----- Method: MCSaveVersionDialog>>accept (in category 'actions') -----
  accept
  	| logMessage logMessageWidget |
+ 	"self updateVersion."
+ 	self flag: #discuss. "ct: Should we really update the version again here? This might add new changes to it that have not yet been reviewed."
+ 	
- 	self updateItems.
  	logMessage := (logMessageWidget := self findTextMorph: #logMessage) text asString.
+ 	(logMessage isEmpty or: [logMessage beginsWith: 'empty log message' translated])
- 	(logMessage isEmpty or: [logMessage beginsWith: 'empty log message'])
  		ifTrue:
+ 			[(self confirm: 'The log message is empty; are you sure you want to commit?' translated) ifFalse: [^ self]]
- 			[(UIManager confirm: 'the log message is empty; are you sure you want to commit') ifFalse: [^ self]]
  		ifFalse: [logMessageWidget accept].
  	self answer: {
  		(self findTextMorph: #versionName) text asString.
  		logMessage.
  		ignore }!

Item was changed:
  ----- Method: MCSaveVersionDialog>>logMessage: (in category 'accessing') -----
  logMessage: aString
+ 
+ 	self message: aString.
+ 	self changed: #logMessage.!
- 	message := aString.
- 	self changed: #logMessage!

Item was removed:
- ----- Method: MCSaveVersionDialog>>patchBlock (in category 'accessing') -----
- patchBlock
- 
- 	^ patchBlock!

Item was removed:
- ----- Method: MCSaveVersionDialog>>patchBlock: (in category 'accessing') -----
- patchBlock: anObject
- 
- 	patchBlock := anObject.
- 	self updateItems!

Item was changed:
  ----- Method: MCSaveVersionDialog>>refresh (in category 'actions') -----
  refresh
  	| latestSelection |
  	latestSelection := self selection.
+ 	self updateVersion.
- 	self updateItems.
  	self
+ 		changed: #logMessage;
  		selection: latestSelection;
  		changed: #list;
  		changed: #text.!

Item was added:
+ ----- Method: MCSaveVersionDialog>>request (in category 'accessing') -----
+ request
+ 
+ 	^ request!

Item was added:
+ ----- Method: MCSaveVersionDialog>>request: (in category 'accessing') -----
+ request: aVersionNameAndMessageRequest
+ 
+ 	request := aVersionNameAndMessageRequest.
+ 	self updateVersion.!

Item was removed:
- ----- Method: MCSaveVersionDialog>>updateItems (in category 'ui') -----
- updateItems
- 	" update our items using the patchBlock "
- 	self patch: patchBlock value!

Item was added:
+ ----- Method: MCSaveVersionDialog>>updateVersion (in category 'ui') -----
+ updateVersion
+ 
+ 	(self findTextMorph: #logMessage) ifNotNil: #accept.
+ 	
+ 	self request message: self message asString.
+ 	self request update.
+ 	self message: self request message.
+ 	self patch: self request patch.!

Item was changed:
  ----- Method: MCTool>>findTextMorph: (in category 'morphic ui') -----
  findTextMorph: aSymbol
+ 	morph ifNil: [^ nil].
  	^ morph submorphs detect: [:ea | (ea respondsTo: #getTextSelector) and: [ea getTextSelector = aSymbol]] ifNone: []!

Item was changed:
  Notification subclass: #MCVersionNameAndMessageRequest
+ 	instanceVariableNames: 'suggestion messageBlock patchBlock message patch'
- 	instanceVariableNames: 'suggestion initialMessage patchBlock'
  	classVariableNames: ''
  	poolDictionaries: ''
  	category: 'Monticello-Versioning'!

Item was changed:
  ----- Method: MCVersionNameAndMessageRequest>>defaultAction (in category 'handling') -----
  defaultAction
  	^ MCSaveVersionDialog new
  		versionName: suggestion;
+ 		request: self;
- 		logMessage: initialMessage;
- 		patchBlock: patchBlock;
  		selection: 1;
  		showModally!

Item was changed:
  ----- Method: MCVersionNameAndMessageRequest>>initialMessage (in category 'accessing') -----
  initialMessage
+ 
+ 	self deprecated.
+ 	^ self message!
- 	^ initialMessage!

Item was changed:
  ----- Method: MCVersionNameAndMessageRequest>>initialMessage: (in category 'accessing') -----
  initialMessage: aString
+ 
+ 	self deprecated.
+ 	^ self message: aString!
- 	initialMessage := aString!

Item was added:
+ ----- Method: MCVersionNameAndMessageRequest>>message (in category 'accessing - variable state') -----
+ message
+ 
+ 	^ message ifNil: [self messageBlock cull: nil]!

Item was added:
+ ----- Method: MCVersionNameAndMessageRequest>>message: (in category 'accessing - variable state') -----
+ message: aStringOrText
+ 
+ 	message := aStringOrText!

Item was added:
+ ----- Method: MCVersionNameAndMessageRequest>>messageBlock (in category 'accessing') -----
+ messageBlock
+ 	^ messageBlock!

Item was added:
+ ----- Method: MCVersionNameAndMessageRequest>>messageBlock: (in category 'accessing') -----
+ messageBlock: aBlock
+ 	messageBlock := aBlock
+ !

Item was added:
+ ----- Method: MCVersionNameAndMessageRequest>>patch (in category 'accessing - variable state') -----
+ patch
+ 
+ 	^ patch ifNil: [self patchBlock value]!

Item was added:
+ ----- Method: MCVersionNameAndMessageRequest>>patch: (in category 'accessing - variable state') -----
+ patch: aPatch
+ 
+ 	patch := aPatch.!

Item was added:
+ ----- Method: MCVersionNameAndMessageRequest>>update (in category 'updating') -----
+ update
+ 
+ 	self message: (self messageBlock cull: message).
+ 	self patch: self patchBlock value.!

Item was changed:
  ----- Method: MCWorkingCopy>>newVersion (in category 'operations') -----
  newVersion
+ 
+ 	| packageSnapshot parentSnapshot patch messageBlock patchBlock tuple |
- 	| packageSnapshot parentSnapshot patch patchBlock |
  	parentSnapshot := self parentSnapshot.
+ 	messageBlock := [:message | self patchMessageSuggestionWith: (self patchMessageStripped: message)].
+ 	patchBlock := [patch := (packageSnapshot := package snapshot) patchRelativeToBase: parentSnapshot].
+ 	
+ 	tuple := self
+ 		requestVersionNameAndMessageWithSuggestion: self uniqueVersionName
+ 		initialMessage: self patchMessageDefault
+ 		messageBlock: messageBlock
+ 		patchBlock: patchBlock.
+ 	tuple ifNil: [^ nil].
+ 	
+ 	^ self
+ 		newVersionWithName: tuple first withBlanksTrimmed
+ 		message: (self patchMessageStripped: tuple second)
+ 		snapshot: ((tuple size >= 3 and: [tuple third notNil and: [tuple third notEmpty]])
+ 			ifTrue: [	MCPatcher apply: (patch ignoring: tuple third) to: parentSnapshot]
+ 			ifFalse: [packageSnapshot]).!
- 	patchBlock :=  [patch := (packageSnapshot := package snapshot) patchRelativeToBase: parentSnapshot].
- 	patchBlock value. "Ensure that this is called at least once."
- 	^ (self requestVersionNameAndMessageWithSuggestion: self uniqueVersionName
- 		initialMessage: self patchMessageSuggestion
- 		patchBlock: patchBlock
- 	) ifNotNil: [:tuple |
- 		self newVersionWithName: tuple first withBlanksTrimmed
- 			message: (self patchMessageStripped: tuple second)
- 			snapshot: ((tuple size >= 3 and: [tuple third notNil and: [tuple third notEmpty]])
- 				ifTrue: [	MCPatcher apply: (patch ignoring: tuple third) to: parentSnapshot]
- 				ifFalse: [packageSnapshot])]!

Item was changed:
  ----- Method: MCWorkingCopy>>patchMessageStripped: (in category 'operations') -----
  patchMessageStripped: aString
  	| pos |
  	pos := aString findString: self patchMessageChangesDelimiter.
  	^ (pos > 0
  		ifTrue: [aString first: pos - 1]
  		ifFalse: [aString]) withBlanksTrimmed!

Item was removed:
- ----- Method: MCWorkingCopy>>patchMessageSuggestion (in category 'operations') -----
- patchMessageSuggestion
- 	^ String streamContents: [:strm | strm
- 		nextPutAll: self patchMessageDefault; cr;cr;
- 		nextPutAll: self patchMessageChangesDelimiter; cr;
- 		nextPutAll: self patchMessageAncestry; cr; cr;
- 		nextPutAll: self patchMessageChanges]!

Item was added:
+ ----- Method: MCWorkingCopy>>patchMessageSuggestionWith: (in category 'operations') -----
+ patchMessageSuggestionWith: defaultMessage
+ 
+ 	^ Text streamContents: [:strm | strm
+ 		nextPutAll: defaultMessage; cr;cr;
+ 		withAttribute: TextColor gray do: [strm
+ 			nextPutAll: self patchMessageChangesDelimiter; cr;
+ 			nextPutAll: self patchMessageAncestry; cr; cr;
+ 			nextPutAll: self patchMessageChanges]]!

Item was added:
+ ----- Method: MCWorkingCopy>>requestVersionNameAndMessageWithSuggestion:initialMessage:messageBlock:patchBlock: (in category 'private') -----
+ requestVersionNameAndMessageWithSuggestion: nameString
+ 	initialMessage: initialMessage
+ 	messageBlock: messageBlock
+ 	patchBlock: patchBlock
+ 
+ 	^ MCVersionNameAndMessageRequest new
+ 		suggestedName: nameString;
+ 		message: initialMessage;
+ 		messageBlock: messageBlock;
+ 		patchBlock: patchBlock;
+ 		signal!

Item was removed:
- ----- Method: MCWorkingCopy>>requestVersionNameAndMessageWithSuggestion:initialMessage:patchBlock: (in category 'private') -----
- requestVersionNameAndMessageWithSuggestion: nameString initialMessage: msgString patchBlock: aPatchBlock
- 	^ (MCVersionNameAndMessageRequest new
- 		suggestedName: nameString;
- 		initialMessage: msgString;
- 		patchBlock: aPatchBlock
- 		) signal!



More information about the Squeak-dev mailing list