diff --git a/src/PharoLauncher-Core/PhLImage.class.st b/src/PharoLauncher-Core/PhLImage.class.st index f73dfc8d2..2e78dae7f 100644 --- a/src/PharoLauncher-Core/PhLImage.class.st +++ b/src/PharoLauncher-Core/PhLImage.class.st @@ -392,12 +392,10 @@ PhLImage >> launchWithConfiguration: aPhLLaunchConfiguration [ ^ self ]. architectureWarningEnabled := true. continue := true. - [ [ | processWrapper| + [ | processWrapper| processWrapper := (aPhLLaunchConfiguration launchProcess) runUnwatch. self doNotRunInitializationScript. "Just run, image already initialized" ^ processWrapper ] - on: PhLImageVersionDeterminationError - do: [ :error | error uiAlert ] ] on: PhLArchitectureMismatchWarning do: [ :warning | architectureWarningEnabled ifTrue: [ diff --git a/src/PharoLauncher-Core/PhLImageVersionDeterminationError.class.st b/src/PharoLauncher-Core/PhLImageVersionDeterminationError.class.st deleted file mode 100644 index d4125c168..000000000 --- a/src/PharoLauncher-Core/PhLImageVersionDeterminationError.class.st +++ /dev/null @@ -1,37 +0,0 @@ -" -Error thrown when Pharo Launcher did not succeed to determine the Pharo version of the image to launch. -Probably, the run command failed. -I hold the command run to determoine the version so that it can be reused for debugging purposes. -" -Class { - #name : #PhLImageVersionDeterminationError, - #superclass : #PhLError, - #instVars : [ - 'command' - ], - #category : #'PharoLauncher-Core-Download' -} - -{ #category : #signalling } -PhLImageVersionDeterminationError class >> signalCommand: aCommandString [ - ^ self new - setCommand: aCommandString; - signal -] - -{ #category : #accessing } -PhLImageVersionDeterminationError >> longDescription [ - ^ PhLImage versionFileName , - ' file was not found for your image, and probably your VMs are not up to date. -Please, contact us at http://pharo.org/community' -] - -{ #category : #accessing } -PhLImageVersionDeterminationError >> name [ - ^ 'Cannot determine image version' -] - -{ #category : #initialization } -PhLImageVersionDeterminationError >> setCommand: aCommandString [ - command := aCommandString reject: [ :c | c = Character cr ] "easier to run the copy/pasted command in a shell if command has only one line" -] diff --git a/src/PharoLauncher-Core/PhLImageVersionFileNotFound.class.st b/src/PharoLauncher-Core/PhLImageVersionFileNotFound.class.st new file mode 100644 index 000000000..35bebd9dc --- /dev/null +++ b/src/PharoLauncher-Core/PhLImageVersionFileNotFound.class.st @@ -0,0 +1,22 @@ +" +Error thrown when Pharo Launcher did not succeed to determine the Pharo version of the image to launch. +Probably, the run command failed. +I hold the command run to determoine the version so that it can be reused for debugging purposes. +" +Class { + #name : #PhLImageVersionFileNotFound, + #superclass : #PhLError, + #category : #'PharoLauncher-Core-Download' +} + +{ #category : #accessing } +PhLImageVersionFileNotFound >> longDescription [ + ^ PhLImage versionFileName , + ' file was not found for your image, and probably your VMs are not up to date. +Please, contact us at http://pharo.org/community' +] + +{ #category : #accessing } +PhLImageVersionFileNotFound >> name [ + ^ 'Image version file ', PhLImage versionFileName , ' not found!' +] diff --git a/src/PharoLauncher-Core/PhLLaunchConfiguration.class.st b/src/PharoLauncher-Core/PhLLaunchConfiguration.class.st index 5c168effa..c637d20c1 100644 --- a/src/PharoLauncher-Core/PhLLaunchConfiguration.class.st +++ b/src/PharoLauncher-Core/PhLLaunchConfiguration.class.st @@ -92,7 +92,7 @@ PhLLaunchConfiguration >> commandString [ { #category : #querying } PhLLaunchConfiguration >> defaultVm [ - self image ensurePharoVersion. + self image pharoVersion. ^ self image vmManager virtualMachine ] @@ -128,7 +128,8 @@ PhLLaunchConfiguration >> initializeWithImage: anImage [ image := anImage. name := 'new configuration...'. usePharoSettings := true. - imageArguments := anImage defaultArguments + imageArguments := anImage defaultArguments. + image ensurePharoVersion ] { #category : #testing } @@ -168,7 +169,7 @@ PhLLaunchConfiguration >> printOn: aStream [ { #category : #configuring } PhLLaunchConfiguration >> useSettings: aBoolean [ "Cannot skip Pharo settings before Pharo 3.0" - self image ensurePharoVersion asInteger < 30 ifTrue: [ ^ self ]. + self image pharoVersion asInteger < 30 ifTrue: [ ^ self ]. usePharoSettings := aBoolean. ] diff --git a/src/PharoLauncher-Core/PhLLaunchImageCommand.class.st b/src/PharoLauncher-Core/PhLLaunchImageCommand.class.st index caf711ad8..a6f3c9419 100644 --- a/src/PharoLauncher-Core/PhLLaunchImageCommand.class.st +++ b/src/PharoLauncher-Core/PhLLaunchImageCommand.class.st @@ -129,8 +129,7 @@ PhLLaunchImageCommand >> launchConfigurationOfImage: aPhLImage [ PhLLaunchImageCommand >> launchImage: aPhLImage [ | process launchConfig | - [ - launchConfig := self launchConfigurationOfImage: aPhLImage. + [ launchConfig := self launchConfigurationOfImage: aPhLImage. launchConfig useSettings: useSettings. process := aPhLImage launchWithConfiguration: launchConfig ] on: PhLError diff --git a/src/PharoLauncher-Core/PhLPrivateVirtualMachine.class.st b/src/PharoLauncher-Core/PhLPrivateVirtualMachine.class.st deleted file mode 100644 index 07f6ac7ca..000000000 --- a/src/PharoLauncher-Core/PhLPrivateVirtualMachine.class.st +++ /dev/null @@ -1,27 +0,0 @@ -" -I represent a Pharo virtual machine used to determine an image phar version by running it with a VM compatible with its image format. - - ex: 6505 6521 68021 - -" -Class { - #name : #PhLPrivateVirtualMachine, - #superclass : #PhLVirtualMachine, - #category : #'PharoLauncher-Core-Download' -} - -{ #category : #testing } -PhLPrivateVirtualMachine class >> isSubclassForDirectory: aFileReference private: isPrivateVm [ - ^ isPrivateVm -] - -{ #category : #querying } -PhLPrivateVirtualMachine >> downloadUrl [ - ^ self manager compatibleVmUrls - at: self name asInteger -] - -{ #category : #accessing } -PhLPrivateVirtualMachine >> vmStore [ - ^ self manager privateVmStore -] diff --git a/src/PharoLauncher-Core/PhLToggleVmPrivateVmCommand.class.st b/src/PharoLauncher-Core/PhLToggleVmPrivateVmCommand.class.st deleted file mode 100644 index ae44681ba..000000000 --- a/src/PharoLauncher-Core/PhLToggleVmPrivateVmCommand.class.st +++ /dev/null @@ -1,28 +0,0 @@ -" -Toggle between display of VMs used to launch Pharo images and ""private"" VMs used to determine Pharo version of an image (one VM per image format) -" -Class { - #name : #PhLToggleVmPrivateVmCommand, - #superclass : #PhLVmCommand, - #category : #'PharoLauncher-Core-Commands' -} - -{ #category : #converting } -PhLToggleVmPrivateVmCommand >> asSpecCommand [ - ^ super asSpecCommand - iconName: #remote; - beDisplayedOnRightSide; - configureAsToolBarToggleButton; - yourself -] - -{ #category : #executing } -PhLToggleVmPrivateVmCommand >> execute [ - self vmsPresenter toggleShowVmPrivateVm. -] - -{ #category : #initialization } -PhLToggleVmPrivateVmCommand >> initialize [ - super initialize. - self name: 'public' -] diff --git a/src/PharoLauncher-Core/PhLVirtualMachine.class.st b/src/PharoLauncher-Core/PhLVirtualMachine.class.st index c1c681cda..4eb3d6e06 100644 --- a/src/PharoLauncher-Core/PhLVirtualMachine.class.st +++ b/src/PharoLauncher-Core/PhLVirtualMachine.class.st @@ -41,18 +41,14 @@ Class { { #category : #'instance creation' } PhLVirtualMachine class >> directory: aFileReference [ - ^ self - directory: aFileReference - private: false -] -{ #category : #'instance creation' } -PhLVirtualMachine class >> directory: aFileReference private: isPrivateVm [ | targetClass | - targetClass := self allSubclasses detect: [ :cls | cls isSubclassForDirectory: aFileReference private: isPrivateVm ] ifNone: [ self ]. - ^ targetClass new - initializeOn: aFileReference; - yourself + targetClass := self allSubclasses + detect: [ :cls | cls isSubclassForDirectory: aFileReference ] + ifNone: [ self ]. + ^ targetClass new + initializeOn: aFileReference; + yourself ] { #category : #accessing } @@ -80,9 +76,9 @@ PhLVirtualMachine class >> id: aString [ ] { #category : #testing } -PhLVirtualMachine class >> isSubclassForDirectory: aFileReference private: isPrivateVm [ +PhLVirtualMachine class >> isSubclassForDirectory: aFileReference [ - ^ isPrivateVm not and: [ aFileReference basename beginsWith: self versionPrefix ] + ^ aFileReference basename beginsWith: self versionPrefix ] { #category : #accessing } diff --git a/src/PharoLauncher-Core/PhLVirtualMachineManager.class.st b/src/PharoLauncher-Core/PhLVirtualMachineManager.class.st index 27f86c74c..f78f4b37f 100644 --- a/src/PharoLauncher-Core/PhLVirtualMachineManager.class.st +++ b/src/PharoLauncher-Core/PhLVirtualMachineManager.class.st @@ -117,12 +117,6 @@ PhLVirtualMachineManager class >> pharoUnzip: aZipFileReference to: outputDirect overwrite: true ] ] -{ #category : #private } -PhLVirtualMachineManager class >> privateVmStore [ - "The private store is used to fetch one VM per image format and open image to determine their pharo version number (e.g. 6.0, 7.0, etc.). Then we download the latest stable VM for the given Pharo image version." - ^ (self vmStore / 'private') ensureCreateDirectory -] - { #category : #initialization } PhLVirtualMachineManager class >> reset [