diff -r 67bcfdfc08d2 -r e098e65efa0a AbstractLauncherApplication.st --- 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|