[squeak-dev] The Trunk: ReleaseBuilder-ct.226.mczcommits at source.squeak.org commits at source.squeak.orgMon Jan 3 21:27:11 UTC 2022
Christoph Thiede uploaded a new version of ReleaseBuilder to project The Trunk: http://source.squeak.org/trunk/ReleaseBuilder-ct.226.mcz ==================== Summary ==================== Name: ReleaseBuilder-ct.226 Author: ct Time: 3 January 2022, 10:27:10.842397 pm UUID: 3639c022-82ea-7744-b68c-5cc171829185 Ancestors: ReleaseBuilder-mt.225 Improves multilingual support. =============== Diff against ReleaseBuilder-mt.225 =============== Item was changed: ----- Method: ReleaseBuilder class>>assureReleaseRepositoryReadAccess: (in category 'manual') ----- assureReleaseRepositoryReadAccess: repo self releaseLocally ifTrue: [ (FileDirectory on: repo description) assureExistence. ^ true]. [repo allFileNames] on: NetworkError, NotFound do: [ self + inform: ('Release Builder - Manual Step Required\\Please create the release repository:\{1}\...and ensure that you have global read access to it.' translated withCRs - inform: ('Release Builder - Manual Step Required\\Please create the release repository:\{1}\...and ensure that you have global read access to it.' withCRs format: {repo description}). ^ false]. ^ true! Item was changed: ----- Method: ReleaseBuilder class>>assureReleaseRepositoryWriteAccess: (in category 'manual') ----- assureReleaseRepositoryWriteAccess: repo self releaseLocally ifTrue: [^ self]. repo + user: (Project uiManager + request: ('Enter user for {1}' translated format: {repo description}) - user: (UIManager default - request: 'Enter user for ', repo description initialAnswer: (repo user ifEmpty: [Utilities authorInitials])); + password: (Project uiManager + requestPassword: ('Enter password for {1}' translated format: {repo description})).! - password: (UIManager default - requestPassword: 'Enter password for ' , repo description).! Item was changed: ----- Method: ReleaseBuilder class>>checkForDirtyPackages (in category 'scripts - support') ----- checkForDirtyPackages | modifiedWorkingCopies unmergedWorkingCopies | MCWorkingCopy checkModified: true. modifiedWorkingCopies := MCWorkingCopy allManagers select: [:wc | wc ancestors size = 1 and: [wc modified] ]. unmergedWorkingCopies := MCWorkingCopy allManagers select: [:wc | (wc ancestors size = 1) not ]. unmergedWorkingCopies ifNotEmpty: [ "Sort to simplify exploration. MC browser does also show packages sorted." (unmergedWorkingCopies sorted: [:wc1 :wc2 | wc1 packageName <= wc2 packageName]) explore. + Warning signal: 'There are unmerged packages.' translated]. - Warning signal: 'There are unmerged packages.']. modifiedWorkingCopies ifNotEmpty: [ "Sort to simplify exploration. MC browser does also show packages sorted." (modifiedWorkingCopies sorted: [:wc1 :wc2 | wc1 packageName <= wc2 packageName]) explore. (self + confirm: 'Do you want to discard all local changes?' translated + orCancel: [^ Error signal: 'Release building canceled.' translated] + title: 'Dirty Packages Found' translated) - confirm: 'Do you want to discard all local changes?' - orCancel: [^ Error signal: 'Release building canceled.'] - title: 'Dirty Packages Found') ifTrue: [modifiedWorkingCopies do: [:wc | [(self buildRepository versionWithInfo: wc ancestors first) load] on: Warning do: [:warning | warning resume]]]].! Item was changed: ----- Method: ReleaseBuilder class>>checkForNilCategories (in category 'scripts - support') ----- checkForNilCategories | nilClasses nilMethods | nilClasses := OrderedCollection new. nilMethods := OrderedCollection new. SystemNavigation default allClasses do: [:cls | cls category ifNil: [nilClasses add: cls]. {cls. cls class} do: [:b | b selectorsAndMethodsDo: [:selector :method | (method methodClass organization categoryOfElement: selector) in: [:category | (category isNil or: [category = 'nil']) ifTrue: [ nilMethods add: method methodReference]]]]] + displayingProgress: [:behavior | 'Checking for invalid categories...' translated]. - displayingProgress: [:behavior | 'Checking for invalid categories...']. nilMethods ifNotEmpty: [ + SystemNavigation default browseMessageList: nilMethods name: 'Messages with invalid categories' translated autoSelect: nil]. - SystemNavigation default browseMessageList: nilMethods name: 'Messages with invalid categories ', nilMethods size autoSelect: nil]. nilClasses ifNotEmpty: [ nilClasses explore]. (nilClasses notEmpty or: [nilMethods notEmpty]) ifTrue: [ + Warning signal: 'There are classes or methods with invalid categories!!' translated].! - Warning signal: 'There are classes or methods with invalid categories!!'].! Item was changed: ----- Method: ReleaseBuilder class>>checkForUndeclaredSymbols (in category 'scripts - support') ----- checkForUndeclaredSymbols "Parses through all source code in the image and looks for undeclard symbols in those." | msgs | msgs := OrderedCollection new. SystemNavigation default allClasses do: [:cls | {cls. cls class} do: [:b | b selectorsAndMethodsDo: [:selector :method | | parser ranges | parser := SHParserST80 new. parser parseAMethod: true. ranges := parser rangesIn: method getSource classOrMetaClass: method methodClass workspace: nil environment: method methodClass environment. (ranges anySatisfy: [:range | range type = #undefinedIdentifier]) ifTrue: [msgs add: method methodReference]]]] + displayingProgress: [:behavior | 'Checking for undeclared symbols...' translated]. - displayingProgress: [:behavior | 'Checking for undeclared symbols...']. msgs ifNotEmpty: [ + SystemNavigation default browseMessageList: msgs name: 'Invalid Messages' translated autoSelect: nil. + Warning signal: 'There is source code with undeclared symbols!!' translated].! - SystemNavigation default browseMessageList: msgs name: 'Invalid Messages ', msgs size autoSelect: nil. - Warning signal: 'There is source code with undeclared symbols!!'].! Item was changed: ----- Method: ReleaseBuilder class>>configureProjects (in category 'scripts') ----- configureProjects "Set up the desired configuration of projects, which might be a single project, multiple projects..." | homeProject rootProject | homeProject := Project current. rootProject := homeProject. homeProject isMorphic ifFalse: [ + Warning signal: 'The current project is not Morphic. Please create a new Morphic project, enter it, and restart the release building process.' translated]. - Warning signal: 'The current project is not Morphic. Please create a new Morphic project, enter it, and restart the release building process.']. "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." Project current removeAllOtherProjects. (Smalltalk classNamed: #MVCProject) + ifNil: [Warning signal: 'MVC must be installed in the release image.' translated] - ifNil: [Warning signal: 'MVC must be installed in the release image.'] ifNotNil: [:mvc | rootProject := mvc new]. rootProject name: 'RootProject'. homeProject name: 'HomeProject'. self assert: homeProject isTopProject; assert: rootProject isTopProject not. rootProject beTopProject. self assert: rootProject isTopProject; assert: homeProject isTopProject not. self assert: rootProject subProjects size = 1; assert: homeProject parent == rootProject; assert: rootProject isMVC.! Item was changed: ----- Method: ReleaseBuilder class>>copyPackagesFrom:to:depth: (in category 'manual') ----- copyPackagesFrom: sourceRepository to: targetRepository depth: historyDepth "Copy the packages currently loaded in the image from the source repository to a target repository. Follow ancestry up to the depth specified." | currentDepth nextVersions currentVersions ignoredVersions | currentDepth := 0. nextVersions := (MCWorkingCopy allManagers gather: [:wc | wc ancestors]) asOrderedCollection. ignoredVersions := OrderedCollection new. [nextVersions notEmpty] whileTrue: [ currentVersions := nextVersions. nextVersions := OrderedCollection new. currentDepth := currentDepth + 1. currentVersions do: [:versionInfo | (targetRepository includesVersionNamed: versionInfo versionName) ifTrue: [Transcript showln: ('[ReleaseBuilder] Version {1} already exists in {2}' format: {versionInfo versionName. targetRepository description})] ifFalse: [(sourceRepository versionWithInfo: versionInfo) ifNil: [ignoredVersions add: versionInfo] ifNotNil: [:version | targetRepository storeVersion: version ] ]. currentDepth < historyDepth ifTrue: [ nextVersions addAll: versionInfo ancestors]]]. ignoredVersions ifNotEmpty: [ ignoredVersions explore. + Warning signal: 'There were versions not found in the source repository.' translated].! - Warning signal: 'There were versions not found in the source repository.'].! Item was changed: ----- Method: ReleaseBuilder class>>doNextStep (in category 'manual - steps') ----- doNextStep "Use this call to perform the manual steps in the release process." | versionString | SystemVersion current isRelease ifTrue: [ + ^ self inform: 'This is a release image. Please use a trunk image to prepare the next release' translated]. - ^ self inform: 'This is a release image. Please use a trunk image to prepare the next release']. versionString := SystemVersion current version. SystemVersion current isAlpha ifTrue: [^ self step1FeatureFreeze]. (SystemVersion current isFeatureFreeze and: [SystemVersion current isCodeFreeze not]) ifTrue: [^ self step2CodeFreeze]. SystemVersion current isReleaseCandidate ifTrue: [ "Still code freeze and another RC? Or do the release?" + (Project uiManager - (UIManager default chooseFrom: #('Create next release candidate' 'Create next release' 'Do nothing') lines: #(2) title: versionString) in: [:answer | answer = 1 ifTrue: [^ self step3NextReleaseCandidate]. answer = 2 ifTrue: [^ self step4Release]]. ^ self].! Item was changed: ----- Method: ReleaseBuilder class>>fileOutChangesBetweenReleases (in category 'scripts - changes') ----- 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 withKeysSortedSafely keysAndValuesDo: [:pkg :changes | strm nextPutAll: '# '; nextPutAll: pkg name; cr. (changes withKeysSorted: #dateAndTime ascending) keysAndValuesDo: [:ver :msg | strm nextPutAll: '- **'; nextPutAll: ver name; nextPutAll: ':** '. msg lines withIndexDo: [:line :index | line ifNotEmpty: [:m | index > 1 ifTrue: [strm nextPutAll: ' ']. strm nextPutAll: m. strm cr]]]]]]. + self inform: 'Files written:' translated translated, String cr, (fileNames joinSeparatedBy: String cr).! - self inform: 'Files written:\' withCRs, (fileNames joinSeparatedBy: String cr).! Item was changed: ----- Method: ReleaseBuilder class>>openWelcomeWorkspacesWith: (in category 'scripts - support') ----- openWelcomeWorkspacesWith: balloonForm | t browser balloon | + t := HelpTopic title: 'Welcome to Squeak' translated readOnlyContents: 'Please choose a topic from the left sidebar.' translated. - t := HelpTopic title: 'Welcome to Squeak' readOnlyContents: 'Please choose a topic from the left sidebar.'. t subtopics add: (SqueakHelp asHelpTopic subtopics detect: [:ea | ea key = #introduction]); add: SqueakLicenseHelp asHelpTopic; add: (SqueakProjectHelp asHelpTopic subtopics detect: [:ea | ea key = #squeakUserInterface]); add: (SqueakProjectHelp asHelpTopic subtopics detect: [:ea | ea key = #workingWithSqueak]); add: SqueakReleaseNotes asHelpTopic. browser := HelpBrowser openOn: t. browser extent: browser world extent * 0.6. browser center: browser world center. browser model showFirstTopic. balloonForm ifNil: [^ self]. balloon := balloonForm asMorph. browser addMorphFront: balloon. balloon layoutFrame: (LayoutFrame fractions: (0 at 1 corner: 0 at 1) offsets: (balloon width // 1.7 negated @ (balloon height * 0.9) negated corner: 0 at 0)).! Item was changed: ----- Method: ReleaseBuilder class>>recompileAll (in category 'scripts - support') ----- recompileAll (Smalltalk classNamed: #EncoderForSistaV1) ifNotNil: [:sistaBytecodeSet| CompiledCode preferredBytecodeSetEncoderClass ~~ sistaBytecodeSet ifTrue: [(self + confirm: 'Do you want to make it the default in this release?' translated - confirm: 'Do you want to make it the default in this release?' orCancel: [false] + title: 'The SistaV1 Bytecode Set Is Available' translated) ifTrue: - title: 'The SistaV1 Bytecode Set Is Available') ifTrue: [CompiledCode installSecondaryBytecodeSet: sistaBytecodeSet; preferredBytecodeSetEncoderClass: sistaBytecodeSet]]]. Compiler recompileAll! Item was changed: ----- Method: ReleaseBuilder class>>releaseRepository (in category 'accessing') ----- releaseRepository (MCRepositoryGroup default repositories detect: [:repo | repo description = self releaseRepositoryUrl] ifNone: [MCRepository location: self releaseRepositoryUrl]) in: [:repo | (self assureReleaseRepositoryReadAccess: repo) + ifFalse: [ReleaseBuilderFailed signal: 'Could not build the release.' translated]. - ifFalse: [ReleaseBuilderFailed signal: 'Could not build the release.']. MCRepositoryGroup default addRepository: repo. ^ repo]! Item was changed: ----- Method: ReleaseBuilder class>>requestNextReleaseVersion (in category 'manual') ----- requestNextReleaseVersion "self requestNextReleaseVersion" | nextMinor nextMajor current next | current := { SystemVersion current majorVersionNumber. SystemVersion current minorVersionNumber}. nextMinor := { current first. current second + 1}. nextMajor := { current first + 1. 0}. next := Project uiManager chooseFromLabeledValues: (OrderedDictionary new at: ('{1}.{2}' format: {nextMinor first. nextMinor second}) put: nextMinor; at: ('{1}.{2}' format: {nextMajor first. nextMajor second}) put: nextMajor; yourself) + title: 'Please Choose Next Version' translated. - title: 'Please Choose Next Version'. next ifNil: [^ self requestNextReleaseVersion]. NextMajorVersion := next first. NextMinorVersion := next second.! Item was changed: ----- Method: ReleaseBuilder class>>saveAsNewClean (in category 'saving') ----- saveAsNewClean "Use this to create clean up the current image and save it under a new name." | fileName | (Project uiManager + confirm: 'This will update and clean-up the current image,\which is then saved under a new name.\\Do you want to continue?' translated withCRs + title: 'Prepare Clean Image' translated) == true ifFalse: [^ self]. - confirm: 'This will update and clean-up the current image,\which is then saved under a new name.\\Do you want to continue?' withCRs - title: 'Prepare Clean Image') == true ifFalse: [^ self]. "Prepare first so that we can propose an appropriate file name." self prepareSourceCode; prepareEnvironment. fileName := ('{1}-{2}-{3}-{4}bit-i{5}.image' format: { SystemVersion current version. SystemVersion current highestUpdate. CompiledCode preferredBytecodeSetEncoderClass name allButFirst: 'EncoderFor' size. Smalltalk wordSize * 8. Smalltalk imageFormatVersion}). fileName := Project uiManager saveFilenameRequest: 'Save clean image as...' translated initialAnswer: fileName. fileName ifNil: [^ self]. Smalltalk saveAs: fileName. self saveAndQuit.! Item was changed: ----- Method: ReleaseBuilder class>>saveClean (in category 'saving') ----- saveClean "Use this to clean up the current image and save it under a new name." (Project uiManager + confirm: 'This will update and clean-up the current (!!) image,\which is then saved under the same (!!) name.\\Do you want to continue?' withCRs translated + title: 'Clean Image' translated) == true ifFalse: [^ self]. - confirm: 'This will update and clean-up the current (!!) image,\which is then saved under the same (!!) name.\\Do you want to continue?' withCRs - title: 'Clean Image') == true ifFalse: [^ self]. self prepareSourceCode; prepareEnvironment. self saveAndQuit.! Item was changed: ----- Method: ReleaseBuilder class>>setDisplayExtent: (in category 'scripts - support') ----- setDisplayExtent: extent [ DisplayScreen fullScreenOff; setNewScreenSize: extent. ] on: Error do: [:err | + Transcript showln: ('[ReleaseBuilder] Failed to set display extent to: {1}. Keep {2}.' translated format: {extent. Display extent})].! - Transcript showln: ('[ReleaseBuilder] Failed to set display extent to: {1}. Keep {2}.' format: {extent. Display extent})].! Item was changed: ----- Method: ReleaseBuilder class>>step1FeatureFreeze (in category 'manual - steps') ----- step1FeatureFreeze + (Project uiManager + confirm: ('Do you really want to feature-freeze the trunk\in preparation for the next release {1}?\Bugfixes only after this.' translated withCRs format: {self versionString}) + title: 'Release Builder Step 1 of 4: Feature Freeze' translated) ifFalse: [^ self]. - (UIManager default - confirm: ('Do you really want to feature-freeze the trunk\in preparation for the next release {1}?\Bugfixes only after this.' withCRs format: {self versionString}) - title: 'Release Builder Step 1 of 4: Feature Freeze') ifFalse: [^ self]. self setNewSystemVersion: self versionString, 'beta'.! Item was changed: ----- Method: ReleaseBuilder class>>step2CodeFreeze (in category 'manual - steps') ----- step2CodeFreeze "Creates the first release candidate." + (Project uiManager + confirm: ('Do you really want to code-freeze the trunk\in preparation for the next release {1}?\Urgent fixes only after this.' translated withCRs format: {self versionString}) - (UIManager default - confirm: ('Do you really want to code-freeze the trunk\in preparation for the next release {1}?\Urgent fixes only after this.' withCRs format: {self versionString}) title: 'Release Builder Step 2 of 4: Code Freeze') ifFalse: [^ self]. self setNewSystemVersion: self versionString, 'rc', (SystemVersion current releaseCandidateNumber + 1) asString.! Item was changed: ----- Method: ReleaseBuilder class>>step3NextReleaseCandidate (in category 'manual - steps') ----- step3NextReleaseCandidate "Creates additional release candidates." "update version, update post load script, add stuff commit" + (Project uiManager + confirm: ('Do you want create another release candidate\for the next release {1}?\Urgent fixes still possible.' translated withCRs format: {self versionString}) + title: 'Release Builder Step 3 of 4: Release Candidate' translated) ifFalse: [^ self]. - (UIManager default - confirm: ('Do you want create another release candidate\for the next release {1}?\Urgent fixes still possible.' withCRs format: {self versionString}) - title: 'Release Builder Step 3 of 4: Release Candidate') ifFalse: [^ self]. self setNewSystemVersion: self versionString, 'rc', (SystemVersion current releaseCandidateNumber + 1) asString.! Item was changed: ----- Method: ReleaseBuilder class>>step4Release (in category 'manual - steps') ----- step4Release "Creates the release. New file, cleaned up." + (Project uiManager + confirm: ('Do you want release {1}{2}?' translated withCRs format: { - (UIManager default - confirm: ('Do you want release {1}{2}?' withCRs format: { self versionString. + (self releaseLocally ifTrue: [' locally' translated] ifFalse: [''])}) + title: 'Release Builder Step 4 of 4: The Release' translated) - (self releaseLocally ifTrue: [' locally'] ifFalse: [''])}) - title: 'Release Builder Step 4 of 4: The Release') ifFalse: [^ self]. "If you re-open the current trunk image again, it will be an alpha version for the next release." DeferredTask := [self step0AssureAlpha]. "We continue with preparing the release image." NextTask := [self saveAsNewRelease]. "Now save it but do not quit." Smalltalk snapshot: true andQuit: false.!
More information about the Squeak-dev mailing list |