--- a/AbstractLauncherApplication.st Sat Dec 07 13:19:15 2019 +0100
+++ b/AbstractLauncherApplication.st Sat Dec 07 22:55:02 2019 +0100
@@ -7449,6 +7449,191 @@
"Modified: / 18-11-2016 / 11:11:07 / cg"
! !
+!AbstractLauncherApplication::PackageLoadDialog methodsFor:'menu-actions'!
+
+loadAction:doBrowse
+ "the button's load action"
+
+ (hierarchicalListView selectionValue) do:[:eachSelectedItem |
+ |package repos|
+
+ eachSelectedItem type == #monticelloRepository ifTrue:[
+ repos := eachSelectedItem info.
+ MCRepositoryBrowser openOnRepository:repos forPackage:nil.
+ ] ifFalse:[
+ eachSelectedItem type == #monticelloPackage ifTrue:[
+ repos := eachSelectedItem parent info.
+ MCRepositoryBrowser openOnRepository:repos forPackage:eachSelectedItem label.
+ ] ifFalse:[
+ package := packageIdByItem at:eachSelectedItem ifAbsent:[nil].
+ package notNil ifTrue:[
+ self loadPackageAndUpdate:package browse:doBrowse subPackages:false item:eachSelectedItem
+ ].
+ ].
+ ].
+ ].
+!
+
+loadPackageAndUpdate:package browse:doBrowse subPackages:subPackages item:someItem
+ |defClass updateAction|
+
+ self withWaitCursorDo:[
+ updateAction :=
+ [:whatChanged :parameter |
+ self updateAction:whatChanged parameter:parameter
+ ].
+
+ Smalltalk onChangeSend:#value:value: to:updateAction.
+ [
+ |packageTried|
+ packageTried := package.
+ ((package includes:$:) not and:[(package includes:$/) not]) ifTrue:[
+ packageTried := package,':'
+ ].
+ [
+ Smalltalk loadPackage:packageTried
+ ] on:PackageLoadError do:[:ex |
+ |path|
+
+ path := pathByItem at:someItem ifAbsent:nil.
+ path isNil ifTrue:[
+ Dialog information:('package load failed: %1' bindWith:ex description).
+ ] ifFalse:[
+ (packageDirPath asFilename / path) exists ifTrue:[
+ "/ try to load the file as is (i.e. not via package-id
+ Dialog information:(resources stringWithCRs:'package load failed: %1\\Loading file directly...' with:ex description).
+ Smalltalk fileIn:(packageDirPath asFilename / path).
+ ] ifFalse:[
+ (Dialog confirm:(resources stringWithCRs:'package load failed: %1\\Autoload individual files?' with:ex description))
+ ifTrue:[
+ [
+ Smalltalk loadPackage:package asAutoloaded:true
+ ] on:PackageLoadError do:[:ex |
+ Dialog information:(resources stringWithCRs:'package load failed: %1' with:ex description).
+ ]
+ ]
+ ].
+ ].
+ ]
+ ] ensure:[
+ Smalltalk retractInterestsFor:updateAction.
+ ].
+ ].
+ defClass := package asPackageId projectDefinitionClass.
+ defClass isNil ifTrue:[
+ Dialog warn:(resources string:'Load failed: definition class for packageID (%1) not present after package load.' with:package)
+ ] ifFalse:[
+ (defClass isLoaded and:[ defClass isFullyLoaded]) ifFalse:[
+ defClass installAutoloadedClasses.
+ ].
+ (defClass isLoaded and:[ defClass isFullyLoaded]) ifFalse:[
+ defClass verbose:true.
+ defClass isLoaded.
+ defClass isFullyLoaded.
+ defClass verbose:false.
+ Dialog warn:(resources string:'Load failed: definition class "%1" not fully loaded after package load.' with:defClass name)
+ ] ifTrue:[
+ doBrowse ifTrue:[
+ Tools::NewSystemBrowser openOnPackage:package
+ ].
+ someItem icon == packageIcon ifTrue:[
+ someItem icon:greyPackageIcon.
+ someItem label:(someItem label , alreadyLoadedString).
+ ] ifFalse:[
+ someItem icon == applicationIcon ifTrue:[
+ someItem icon:greyApplicationIcon.
+ someItem label:(someItem label , alreadyLoadedString).
+ ].
+ ].
+ ].
+ ].
+
+ subPackages ifTrue:[
+ someItem children do:[:eachChild |
+ |subPackageID|
+
+ subPackageID := packageIdByItem at:eachChild.
+ self loadPackageAndUpdate:subPackageID browse:false subPackages:true item:eachChild.
+ ].
+ ].
+
+ "Modified: / 02-08-2017 / 13:00:14 / cg"
+ "Modified: / 17-12-2018 / 13:09:34 / Claus Gittinger"
+!
+
+loadPackageDefinition:package browse:doBrowse subPackages:subPackages item:someItem
+ |defClass updateAction|
+
+ self withWaitCursorDo:[
+ updateAction :=
+ [:whatChanged :parameter |
+ self updateAction:whatChanged parameter:parameter
+ ].
+
+ Smalltalk onChangeSend:#value:value: to:updateAction.
+
+ [
+ |packageTried dir className fileName|
+
+ packageTried := package.
+ ((package includes:$:) not and:[(package includes:$/) not]) ifTrue:[
+ packageTried := package,':'
+ ].
+
+ dir := Smalltalk packageDirectoryForPackageId:package.
+ dir notNil ifTrue:[
+ "/ is there a project definition class's source?
+ className := ProjectDefinition projectDefinitionClassNameForDefinitionOf:package.
+ fileName := dir / ((Smalltalk fileNameForClass:className),'.st').
+ fileName exists ifTrue:[
+ ParseError handle:[:ex |
+ Dialog warn:(resources string:'An error happened while loading the project definition:\ %1\\Maybe the project depends on some other package.\Please check this manually.' with:ex description)
+ ] do:[
+ Smalltalk fileIn:fileName.
+ ].
+ ] ifFalse:[
+ Dialog warn:(resources string:'Project definition class file not present: "%1"' with:fileName)
+ ]
+ ] ifFalse:[
+ Dialog warn:(resources string:'Project directory for "%1" is not present/readable' with:package).
+ ^ self.
+ ]
+ ] ensure:[
+ Smalltalk retractInterestsFor:updateAction.
+ ].
+ ].
+ ((defClass := package asPackageId projectDefinitionClass) notNil and:[ defClass isLoaded ])
+ ifFalse:[
+ defClass isNil ifTrue:[
+ Dialog warn:(resources string:'Load failed: definition class for packageID (%1) not present after package load.' with:package)
+ ]
+ ] ifTrue:[
+ doBrowse ifTrue:[
+ Tools::NewSystemBrowser openOnPackage:package
+ ].
+"/ someItem icon == packageIcon ifTrue:[
+"/ someItem icon:greyPackageIcon.
+"/ someItem label:(someItem label , alreadyLoadedString).
+"/ ] ifFalse:[
+"/ someItem icon == applicationIcon ifTrue:[
+"/ someItem icon:greyApplicationIcon.
+"/ someItem label:(someItem label , alreadyLoadedString).
+"/ ].
+"/ ].
+ ].
+
+ subPackages ifTrue:[
+ someItem children do:[:eachChild |
+ |subPackageID|
+
+ subPackageID := packageIdByItem at:eachChild.
+ self loadPackageAndUpdate:subPackageID browse:false subPackages:true item:eachChild.
+ ].
+ ].
+
+ "Created: / 18-11-2016 / 11:13:03 / cg"
+! !
+
!AbstractLauncherApplication::PackageLoadDialog methodsFor:'opening'!
openLoadPackageDialog
@@ -7810,189 +7995,6 @@
"Modified: / 13-03-2019 / 21:40:49 / Claus Gittinger"
!
-loadAction:doBrowse
- "the button's load action"
-
- (hierarchicalListView selectionValue) do:[:eachSelectedItem |
- |package repos|
-
- eachSelectedItem type == #monticelloRepository ifTrue:[
- repos := eachSelectedItem info.
- MCRepositoryBrowser openOnRepository:repos forPackage:nil.
- ] ifFalse:[
- eachSelectedItem type == #monticelloPackage ifTrue:[
- repos := eachSelectedItem parent info.
- MCRepositoryBrowser openOnRepository:repos forPackage:eachSelectedItem label.
- ] ifFalse:[
- package := packageIdByItem at:eachSelectedItem ifAbsent:[nil].
- package notNil ifTrue:[
- self loadPackageAndUpdate:package browse:doBrowse subPackages:false item:eachSelectedItem
- ].
- ].
- ].
- ].
-!
-
-loadPackageAndUpdate:package browse:doBrowse subPackages:subPackages item:someItem
- |defClass updateAction|
-
- self withWaitCursorDo:[
- updateAction :=
- [:whatChanged :parameter |
- self updateAction:whatChanged parameter:parameter
- ].
-
- Smalltalk onChangeSend:#value:value: to:updateAction.
- [
- |packageTried|
- packageTried := package.
- ((package includes:$:) not and:[(package includes:$/) not]) ifTrue:[
- packageTried := package,':'
- ].
- [
- Smalltalk loadPackage:packageTried
- ] on:PackageLoadError do:[:ex |
- |path|
-
- path := pathByItem at:someItem ifAbsent:nil.
- path isNil ifTrue:[
- Dialog information:('package load failed: %1' bindWith:ex description).
- ] ifFalse:[
- (packageDirPath asFilename / path) exists ifTrue:[
- "/ try to load the file as is (i.e. not via package-id
- Dialog information:(resources stringWithCRs:'package load failed: %1\\Loading file directly...' with:ex description).
- Smalltalk fileIn:(packageDirPath asFilename / path).
- ] ifFalse:[
- (Dialog confirm:(resources stringWithCRs:'package load failed: %1\\Autoload individual files?' with:ex description))
- ifTrue:[
- [
- Smalltalk loadPackage:package asAutoloaded:true
- ] on:PackageLoadError do:[:ex |
- Dialog information:(resources stringWithCRs:'package load failed: %1' with:ex description).
- ]
- ]
- ].
- ].
- ]
- ] ensure:[
- Smalltalk retractInterestsFor:updateAction.
- ].
- ].
- defClass := package asPackageId projectDefinitionClass.
- defClass isNil ifTrue:[
- Dialog warn:(resources string:'Load failed: definition class for packageID (%1) not present after package load.' with:package)
- ] ifFalse:[
- (defClass isLoaded and:[ defClass isFullyLoaded]) ifFalse:[
- defClass installAutoloadedClasses.
- ].
- (defClass isLoaded and:[ defClass isFullyLoaded]) ifFalse:[
- defClass verbose:true.
- defClass isLoaded.
- defClass isFullyLoaded.
- defClass verbose:false.
- Dialog warn:(resources string:'Load failed: definition class "%1" not fully loaded after package load.' with:defClass name)
- ] ifTrue:[
- doBrowse ifTrue:[
- Tools::NewSystemBrowser openOnPackage:package
- ].
- someItem icon == packageIcon ifTrue:[
- someItem icon:greyPackageIcon.
- someItem label:(someItem label , alreadyLoadedString).
- ] ifFalse:[
- someItem icon == applicationIcon ifTrue:[
- someItem icon:greyApplicationIcon.
- someItem label:(someItem label , alreadyLoadedString).
- ].
- ].
- ].
- ].
-
- subPackages ifTrue:[
- someItem children do:[:eachChild |
- |subPackageID|
-
- subPackageID := packageIdByItem at:eachChild.
- self loadPackageAndUpdate:subPackageID browse:false subPackages:true item:eachChild.
- ].
- ].
-
- "Modified: / 02-08-2017 / 13:00:14 / cg"
- "Modified: / 17-12-2018 / 13:09:34 / Claus Gittinger"
-!
-
-loadPackageDefinition:package browse:doBrowse subPackages:subPackages item:someItem
- |defClass updateAction|
-
- self withWaitCursorDo:[
- updateAction :=
- [:whatChanged :parameter |
- self updateAction:whatChanged parameter:parameter
- ].
-
- Smalltalk onChangeSend:#value:value: to:updateAction.
-
- [
- |packageTried dir className fileName|
-
- packageTried := package.
- ((package includes:$:) not and:[(package includes:$/) not]) ifTrue:[
- packageTried := package,':'
- ].
-
- dir := Smalltalk packageDirectoryForPackageId:package.
- dir notNil ifTrue:[
- "/ is there a project definition class's source?
- className := ProjectDefinition projectDefinitionClassNameForDefinitionOf:package.
- fileName := dir / ((Smalltalk fileNameForClass:className),'.st').
- fileName exists ifTrue:[
- ParseError handle:[:ex |
- Dialog warn:(resources string:'An error happened while loading the project definition:\ %1\\Maybe the project depends on some other package.\Please check this manually.' with:ex description)
- ] do:[
- Smalltalk fileIn:fileName.
- ].
- ] ifFalse:[
- Dialog warn:(resources string:'Project definition class file not present: "%1"' with:fileName)
- ]
- ] ifFalse:[
- Dialog warn:(resources string:'Project directory for "%1" is not present/readable' with:package).
- ^ self.
- ]
- ] ensure:[
- Smalltalk retractInterestsFor:updateAction.
- ].
- ].
- ((defClass := package asPackageId projectDefinitionClass) notNil and:[ defClass isLoaded ])
- ifFalse:[
- defClass isNil ifTrue:[
- Dialog warn:(resources string:'Load failed: definition class for packageID (%1) not present after package load.' with:package)
- ]
- ] ifTrue:[
- doBrowse ifTrue:[
- Tools::NewSystemBrowser openOnPackage:package
- ].
-"/ someItem icon == packageIcon ifTrue:[
-"/ someItem icon:greyPackageIcon.
-"/ someItem label:(someItem label , alreadyLoadedString).
-"/ ] ifFalse:[
-"/ someItem icon == applicationIcon ifTrue:[
-"/ someItem icon:greyApplicationIcon.
-"/ someItem label:(someItem label , alreadyLoadedString).
-"/ ].
-"/ ].
- ].
-
- subPackages ifTrue:[
- someItem children do:[:eachChild |
- |subPackageID|
-
- subPackageID := packageIdByItem at:eachChild.
- self loadPackageAndUpdate:subPackageID browse:false subPackages:true item:eachChild.
- ].
- ].
-
- "Created: / 18-11-2016 / 11:13:03 / cg"
-!
-
readOtherPackageTrees
|packagePath|