The Trunk: ReleaseBuilder-mt.199.mcz

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

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

Name: ReleaseBuilder-mt.199
Author: mt
Time: 25 September 2019, 9:28:08.255671 am
UUID: a27499bc-3692-a540-9210-eff8f33e6c2e
Ancestors: ReleaseBuilder-mt.198, ReleaseBuilder-dtl.198

Merges ReleaseBuilder-dtl.198.

=============== Diff against ReleaseBuilder-mt.198 ===============

Item was added:
+ ----- Method: ReleaseBuilder class>>addMVCParentProject (in category 'scripts - support') -----
+ addMVCParentProject
+ "The home project is a single Morphic project. Let the home project have a
+ parent MVC project as the root of the project tree. The MVC project supports
+ emergency debugging in the event of unrecoverable Morphic problems, and
+ will fall back on the traditional emergency evaluator if MVC debugging fails.
+ If MVC is not installed in the image, then do nothing."
+
+ (Smalltalk hasClassNamed:#MVCProject) ifTrue: [ | cls |
+ cls := Smalltalk classNamed: #MVCProject.
+ ((Project topProject) perform: #isMVC)
+ ifFalse: [(cls new name: 'The root project') beTopProject ] ].
+ !

Item was changed:
+ ----- Method: ReleaseBuilder class>>changesBetween:and: (in category 'scripts - changes') -----
- ----- Method: ReleaseBuilder class>>changesBetween:and: (in category 'scripts - support') -----
  changesBetween: startConfiguration and: endConfiguration
 
  | a b d |
  a := startConfiguration.
  b := endConfiguration.
  d := OrderedDictionary new.
 
  b dependencies do: [:dep |
  | begin end finished started |
  finished := false. started := false.
  begin := a dependencies
  detect: [:ea | ea package = dep package]
  ifFound: [:x | x versionInfo]
  ifNone: [nil].
  end := dep versionInfo.
 
  d at: dep package put: OrderedDictionary new.
  dep package workingCopy ancestry allAncestorsDo: [:ver |
  started := started or: [(ver name findTokens: '.') last asNumber <= (end name findTokens: '.') last asNumber].
  finished := finished or: [begin notNil and: [(ver name findTokens: '.') last asNumber <= (begin name findTokens: '.') last asNumber]].
  started & finished not ifTrue: [(d at: dep package) at: ver put: ver message]]].
  ^ d!

Item was changed:
+ ----- Method: ReleaseBuilder class>>changesBetweenReleases (in category 'scripts - changes') -----
- ----- Method: ReleaseBuilder class>>changesBetweenReleases (in category 'scripts - support') -----
  changesBetweenReleases
 
  | repos configs result |
  repos :=#(52) collect: [:ea |
  (MCHttpRepository
     location: 'http://source.squeak.org/squeak', ea
     user: 'squeak'
     password: 'squeak')].
  configs := repos collect: [:ea | ea description -> (self firstConfigurationIn: ea map: 'update')].
  configs := configs, {(self buildRepository description -> self buildConfiguration)}.
 
  result := OrderedDictionary new.
  configs overlappingPairsDo: [:c1 :c2 |
  result
  at: c2 key
  put: (self changesBetween: c1 value and: c2 value)].
 
  ^ result
  !

Item was changed:
  ----- Method: ReleaseBuilder class>>checkCurrentProjects (in category 'scripts - support') -----
  checkCurrentProjects
 
  Project current isMorphic ifFalse: [
  Warning signal: 'The current project is not Morphic. Please create a new Morphic project, enter it, and restart the release building process.'].
 
+ Project allProjects size
+ caseOf: {
+ [ 1 ]  -> [ self addMVCParentProject ] .
+ [ 2 ] -> [ ((Project current parent) perform: #isMVC) ifFalse: [ Warning signal: 'Parent of the home project should be an MVC project.' ]  ] }
+ otherwise: [ Warning signal: 'There should be one home Morphic project with a parent MVC project for fallback debugging.' ] .
- Project allProjects size = 1 ifFalse: [
- Warning signal: 'There should only be one project.'].
 
  "Avoid strange drawing issues."
  Project current world allMorphsDo: [:m | m removeProperty: #errorOnDraw].!

Item was changed:
+ ----- Method: ReleaseBuilder class>>confirm:orCancel:title: (in category 'scripts - ui') -----
- ----- Method: ReleaseBuilder class>>confirm:orCancel:title: (in category 'scripts - support') -----
  confirm: aString orCancel: cancelBlock title: titleString
  "Allow questions to be answered in advance."
  ^QAndA
  at: titleString
  ifAbsent:
  [Project uiManager
  confirm: aString translated
  orCancel: cancelBlock
  title: titleString translated]!

Item was changed:
+ ----- Method: ReleaseBuilder class>>fileOutChangesBetweenReleases (in category 'scripts - changes') -----
- ----- Method: ReleaseBuilder class>>fileOutChangesBetweenReleases (in category 'scripts - support') -----
  fileOutChangesBetweenReleases
  "Generate mark-down files with all commit messages by release. To be used to write release notes."
 
  | fileNames |
  fileNames := OrderedCollection new.
 
  self changesBetweenReleases keysAndValuesDo: [:location :c |
  fileNames add: ('commits-{1}.md' format: {(location findTokens: '/') last}).
  FileStream forceNewFileNamed: fileNames last do: [:strm |
  c keysAndValuesDo: [:pkg :changes |
  strm nextPutAll: '# '; nextPutAll: pkg name; cr.
  changes keysAndValuesDo: [:ver :msg |
  msg linesDo: [:line | line withBlanksTrimmed ifNotEmpty: [:m |
  (m first isDigit or: [{$*. $-} includes: m first])
  ifTrue: [strm nextPutAll: '   ', m]
  ifFalse: [strm nextPutAll: ' - ', m].
  strm cr]].
  strm nextPutAll: '------------------'; cr]]]].
 
  self inform: 'Files written:\' withCRs, (fileNames joinSeparatedBy: String cr).!

Item was changed:
+ ----- Method: ReleaseBuilder class>>firstConfigurationIn:map: (in category 'scripts - changes') -----
- ----- Method: ReleaseBuilder class>>firstConfigurationIn:map: (in category 'scripts - support') -----
  firstConfigurationIn: repo map: map
 
  | min versionName |
  min := 999999999.
  versionName := ''.
 
  (repo versionNamesForPackageNamed: map) do: [:nm |
  ((nm findTokens: $.) atLast: 2) asInteger in: [:versionNumber |
  versionNumber < min ifTrue: [min := versionNumber. versionName := nm]]].
 
  ^ repo versionNamed: versionName
  !

Item was changed:
+ ----- Method: ReleaseBuilder class>>getBalloonForm (in category 'scripts - ui') -----
- ----- Method: ReleaseBuilder class>>getBalloonForm (in category 'scripts - support') -----
  getBalloonForm
 
  ^ (FileDirectory default fileExists: 'balloon.png')
  ifFalse: [nil]
  ifTrue: [Form fromFileNamed: 'balloon.png']!

Item was changed:
+ ----- Method: ReleaseBuilder class>>lastConfigurationIn:map: (in category 'scripts - changes') -----
- ----- Method: ReleaseBuilder class>>lastConfigurationIn:map: (in category 'scripts - support') -----
  lastConfigurationIn: repo map: map
 
  | max versionName |
  max := 0.
  versionName := ''.
 
  (repo versionNamesForPackageNamed: map) do: [:nm |
  ((nm findTokens: $.) atLast: 2) asInteger in: [:versionNumber |
  versionNumber > max ifTrue: [max := versionNumber. versionName := nm]]].
 
  ^ repo versionNamed: versionName
  !