[Cuis-dev] Package Installer - initial version

Mariano Montone marianomontone at gmail.com
Thu Nov 25 12:18:26 PST 2021 

Hello Juan,

I'm submitting (see attached) an initial version of the Package
Installer for review.

The code needs to be better commented, methods classified, etc. But I
would like to know if there are any major objections first; my plan is
to clean things up once it is on a git repository.

Can you have a look and give me some feedback?

To run select: World Menu -> Open -> Package Installer.

Thanks!

Mariano
-------------- next part --------------
'From Cuis 5.0 [latest update: #4973] on 25 November 2021 at 5:16:00 pm'!
'Description '!
!provides: 'PackageInstaller' 1 25!
SystemOrganization addCategory: 'PackageInstaller'!


!classDefinition: #PackageInstallerWindow category: 'PackageInstaller'!
SystemWindow subclass: #PackageInstallerWindow
	instanceVariableNames: 'filterString filterInput currentIndex'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'PackageInstaller'!
!classDefinition: 'PackageInstallerWindow class' category: 'PackageInstaller'!
PackageInstallerWindow class
	instanceVariableNames: ''!

!classDefinition: #PackageDescription category: 'PackageInstaller'!
Object subclass: #PackageDescription
	instanceVariableNames: 'name homepage description features provides requires tags'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'PackageInstaller'!
!classDefinition: 'PackageDescription class' category: 'PackageInstaller'!
PackageDescription class
	instanceVariableNames: ''!

!classDefinition: #FilePackageDescription category: 'PackageInstaller'!
PackageDescription subclass: #FilePackageDescription
	instanceVariableNames: 'codePackageFile'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'PackageInstaller'!
!classDefinition: 'FilePackageDescription class' category: 'PackageInstaller'!
FilePackageDescription class
	instanceVariableNames: ''!

!classDefinition: #PackageInstaller category: 'PackageInstaller'!
Object subclass: #PackageInstaller
	instanceVariableNames: 'packageList'
	classVariableNames: 'PackageList'
	poolDictionaries: ''
	category: 'PackageInstaller'!
!classDefinition: 'PackageInstaller class' category: 'PackageInstaller'!
PackageInstaller class
	instanceVariableNames: ''!


!FilePackageDescription commentStamp: '<historical>' prior: 0!
PackageSpec of a package that lives on a file on disk.!

!PackageInstallerWindow methodsFor: 'as yet unclassified' stamp: 'MM 11/25/2021 15:21:52'!
buildActionsBar

	| actionsBar | 
	
	actionsBar _ LayoutMorph newRow.
	
	actionsBar addMorph:
		(PluggableButtonMorph 
				model: self 
				action: #installPackage
				label: 'Install package').
	actionsBar addMorph:
		(PluggableButtonMorph
				model: self
				action: #updatePackageList
				label: 'Update package list').
	
	actionsBar addMorph: (LabelMorph contents: 'Search: ').
	
	filterInput _ TextModelMorph textProvider: self textGetter: #filterString textSetter: #filterString:.
	filterInput acceptOnCR: true;
		askBeforeDiscardingEdits: false.
	actionsBar addMorph: filterInput layoutSpec: (LayoutSpec fixedHeight: 30).
	
	^ actionsBar! !

!PackageInstallerWindow methodsFor: 'as yet unclassified' stamp: 'MM 11/25/2021 13:56:23'!
buildDetailPane
	^ TextModelMorph textProvider:  self textGetter: #packageDescription! !

!PackageInstallerWindow methodsFor: 'as yet unclassified' stamp: 'MM 11/25/2021 15:23:37'!
buildMorphicWindow

	|layout|
		
	layout _ LayoutMorph newRow.
	layout addMorph: self buildPackageListMorph layoutSpec: (LayoutSpec proportionalWidth: 0.5).
	layout addAdjusterAndMorph: self buildDetailPane layoutSpec: (LayoutSpec proportionalWidth: 0.5).
	self addMorph: layout layoutSpec: (LayoutSpec proportionalWidth: 1).
	self addMorph: self buildActionsBar layoutSpec: (LayoutSpec new fixedHeight: 30; proportionalWidth: 1; yourself). 
	! !

!PackageInstallerWindow methodsFor: 'as yet unclassified' stamp: 'MM 11/25/2021 15:29:21'!
buildPackageListMorph
	
	^ PluggableListMorph model: self listGetter: #packageListNames indexGetter: #currentIndex indexSetter: #currentIndex:.! !

!PackageInstallerWindow methodsFor: 'as yet unclassified' stamp: 'MM 11/25/2021 15:17:00'!
currentIndex
	^ currentIndex ifNil: [0]! !

!PackageInstallerWindow methodsFor: 'as yet unclassified' stamp: 'MM 11/25/2021 15:17:08'!
currentIndex: index
	currentIndex _ index.
	self changed: #acceptedContents! !

!PackageInstallerWindow methodsFor: 'as yet unclassified' stamp: 'MM 11/25/2021 16:18:21'!
filteredPackageList

	| packageList |
	
	packageList _ model packageList.
	
	^ filterString isEmpty
		ifTrue: [packageList]
		ifFalse: [packageList select: [:package | package packageName includesSubstring: filterString caseSensitive: false]]! !

!PackageInstallerWindow methodsFor: 'as yet unclassified' stamp: 'MM 11/25/2021 14:18:16'!
getFilter
	^ [:str :el | el printString includesSubstring: str caseSensitive: false]! !

!PackageInstallerWindow methodsFor: 'as yet unclassified' stamp: 'MM 11/25/2021 15:18:18'!
initialize
	super initialize.
	filterString _ ''.! !

!PackageInstallerWindow methodsFor: 'as yet unclassified' stamp: 'MM 11/25/2021 15:26:06'!
installPackage
	self selectedPackage ifNotNil: [:package | package install]! !

!PackageInstallerWindow methodsFor: 'as yet unclassified' stamp: 'MM 11/25/2021 14:04:10'!
open
	self buildMorphicWindow.
	labelString _ 'Package Installer'.
	self openInWorld! !

!PackageInstallerWindow methodsFor: 'as yet unclassified' stamp: 'MM 11/25/2021 16:49:17'!
packageDescription

	|package|
	
	package _ self selectedPackage.
	
	package ifNil: [^''].
	
	^ String streamContents: [:s | 
		s nextPutAll: package packageName;
			newLine.
		60 timesRepeat: [	s nextPut: $-].
		s newLine; newLine.
		
		package description ifNotEmpty: [
			s nextPutAll: package description;
				newLine;
				newLine].
		
		s nextPutAll: package codePackageFile description]! !

!PackageInstallerWindow methodsFor: 'as yet unclassified' stamp: 'MM 11/25/2021 16:12:17'!
packageListNames

	^ self filteredPackageList collect: [:package | package packageName].
	
	! !

!PackageInstallerWindow methodsFor: 'as yet unclassified' stamp: 'MM 11/25/2021 16:10:59'!
selectedPackage
	currentIndex ifNil: [^nil].
	currentIndex isZero ifTrue: [^nil].
	^ self filteredPackageList at: currentIndex.! !

!PackageInstallerWindow methodsFor: 'as yet unclassified' stamp: 'MM 11/25/2021 15:30:07'!
updatePackageList

	model updatePackageList.
	self changed: #packageListNames! !

!PackageInstallerWindow methodsFor: 'accessing' stamp: 'MM 11/25/2021 13:43:45'!
filterInput
	"Answer the value of filterInput"

	^ filterInput! !

!PackageInstallerWindow methodsFor: 'accessing' stamp: 'MM 11/25/2021 13:43:45'!
filterInput: anObject
	"Set the value of filterInput"

	filterInput _ anObject! !

!PackageInstallerWindow methodsFor: 'accessing' stamp: 'MM 11/25/2021 13:43:45'!
filterString
	"Answer the value of filterString"

	^ filterString! !

!PackageInstallerWindow methodsFor: 'accessing' stamp: 'MM 11/25/2021 16:53:16'!
filterString: aString
	"Set the value of filterString"

	filterString _ aString.
	filterInput hasUnacceptedEdits: false.
	self currentIndex: nil.
	self changed: #packageListNames! !

!PackageInstallerWindow methodsFor: 'accessing' stamp: 'MM 11/25/2021 13:43:45'!
model
	"Answer the value of model"

	^ model! !

!PackageInstallerWindow methodsFor: 'accessing' stamp: 'MM 11/25/2021 13:43:45'!
model: anObject
	"Set the value of model"

	model _ anObject! !

!PackageInstallerWindow class methodsFor: 'as yet unclassified' stamp: 'MM 11/25/2021 15:11:25'!
open

	^ self open: PackageInstaller new label: 'Package Installer'! !

!PackageInstallerWindow class methodsFor: 'as yet unclassified' stamp: 'MM 11/25/2021 17:15:50'!
worldMenuForOpenGroup
	^ `{{
			#itemGroup 		-> 		20.
			#itemOrder 		-> 		10.
			#label 			->	'Package Installer'.
			#object 			-> 	PackageInstallerWindow.
			#selector 		-> 		#open.
			#icon 			-> 		#packageIcon.
			#balloonText 	-> 		'A tool for installing local Cuis packages.'.
		} asDictionary}`! !

!PackageDescription methodsFor: 'accessing' stamp: 'MM 11/19/2021 12:01:08'!
description
	"Answer the value of description"

	^ description! !

!PackageDescription methodsFor: 'accessing' stamp: 'MM 11/19/2021 12:01:08'!
description: anObject
	"Set the value of description"

	description _ anObject! !

!PackageDescription methodsFor: 'accessing' stamp: 'MM 11/19/2021 12:01:08'!
features
	"Answer the value of features"

	^ features! !

!PackageDescription methodsFor: 'accessing' stamp: 'MM 11/19/2021 12:01:08'!
features: anObject
	"Set the value of features"

	features _ anObject! !

!PackageDescription methodsFor: 'accessing' stamp: 'MM 11/19/2021 12:01:08'!
homepage
	"Answer the value of homepage"

	^ homepage! !

!PackageDescription methodsFor: 'accessing' stamp: 'MM 11/19/2021 12:01:08'!
homepage: anObject
	"Set the value of homepage"

	homepage _ anObject! !

!PackageDescription methodsFor: 'accessing' stamp: 'MM 11/19/2021 12:01:08'!
name: anObject
	"Set the value of name"

	name _ anObject! !

!PackageDescription methodsFor: 'accessing' stamp: 'MM 11/19/2021 13:17:45'!
packageName

	^ name! !

!PackageDescription methodsFor: 'accessing' stamp: 'MM 11/19/2021 12:12:36'!
provides
	"Answer the value of provides"

	^ provides! !

!PackageDescription methodsFor: 'accessing' stamp: 'MM 11/19/2021 12:12:36'!
provides: anObject
	"Set the value of provides"

	provides _ anObject! !

!PackageDescription methodsFor: 'accessing' stamp: 'MM 11/19/2021 12:12:36'!
requires
	"Answer the value of requires"

	^ requires! !

!PackageDescription methodsFor: 'accessing' stamp: 'MM 11/19/2021 12:12:36'!
requires: anObject
	"Set the value of requires"

	requires _ anObject! !

!PackageDescription methodsFor: 'accessing' stamp: 'MM 11/19/2021 12:16:27'!
tags
	"Answer the value of tags"

	^ tags! !

!PackageDescription methodsFor: 'accessing' stamp: 'MM 11/19/2021 12:16:27'!
tags: anObject
	"Set the value of tags"

	tags _ anObject! !

!PackageDescription methodsFor: 'as yet unclassified' stamp: 'MM 11/19/2021 14:09:58'!
install

	provides do: [:feature |
		Feature require: feature]! !

!FilePackageDescription methodsFor: 'accessing' stamp: 'MM 11/19/2021 14:12:03'!
codePackageFile
	"Answer the value of codePackageFile"

	^ codePackageFile! !

!FilePackageDescription methodsFor: 'accessing' stamp: 'MM 11/19/2021 14:12:03'!
codePackageFile: anObject
	"Set the value of codePackageFile"

	codePackageFile _ anObject! !

!FilePackageDescription methodsFor: 'as yet unclassified' stamp: 'MM 11/25/2021 16:30:52'!
install
	
	(FeatureRequirement name: name)
		pathName: codePackageFile fullName;
		satisfyRequirementsAndInstall! !

!PackageInstaller methodsFor: 'accessing' stamp: 'MM 11/25/2021 14:24:04'!
packageList
	"Answer the value of packageList"

	^ packageList! !

!PackageInstaller methodsFor: 'as yet unclassified' stamp: 'MM 11/25/2021 15:12:28'!
addPackage: aPackageSpec

	packageList add: aPackageSpec! !

!PackageInstaller methodsFor: 'as yet unclassified' stamp: 'MM 11/25/2021 17:12:12'!
buildPackageDescription: aCodePackage

	"Create a PackageSpec from aCodePackage."
	
	| packageSpec |
	
	packageSpec _ FilePackageDescription new.
	
	packageSpec name: aCodePackage packageName;
		description: aCodePackage packageDescription;
		requires: aCodePackage requires;
		provides: aCodePackage provides;
		codePackageFile: aCodePackage.
	
	^ packageSpec! !

!PackageInstaller methodsFor: 'as yet unclassified' stamp: 'MM 11/25/2021 17:12:12'!
collectPackagesFromDirectory: aDirectory

	"Create a collection of PackageSpec with package files found in aDirectory."
	
	|packageFiles|
	
	packageFiles _ aDirectory fileNamesMatching: '*.pck.st'.
		
	packageFiles do: [:packageFile | | packageSpec codePackage |
		codePackage _ CodePackageFile onFileEntry: (aDirectory // packageFile).
		packageSpec _ self buildPackageDescription: codePackage.
		self addPackage: packageSpec]! !

!PackageInstaller methodsFor: 'as yet unclassified' stamp: 'MM 11/25/2021 14:39:54'!
collectPackagesFromDisk

	"Collect PackageSpec with package files found in Cuis packages directories."
	
	self placesToLookForPackagesDo: [:aDirectory | 
		self collectPackagesFromDirectory: aDirectory]! !

!PackageInstaller methodsFor: 'as yet unclassified' stamp: 'MM 11/25/2021 16:15:28'!
initialize
	packageList _ PackageList ifNil: [self updatePackageList]! !

!PackageInstaller methodsFor: 'as yet unclassified' stamp: 'MM 11/25/2021 14:40:18'!
placesToLookForPackagesDo: aBlock

	| base packagesDirectory |

	"Look in Cuis image folder and reasonable subfolders"
	base _ DirectoryEntry smalltalkImageDirectory.
	aBlock value: base.
	packagesDirectory _ base / 'Packages'.
	aBlock value: packagesDirectory.
	packagesDirectory allRegularDirectoriesDo: aBlock.
	base regularDirectoriesDo: [ :child |
		child = packagesDirectory ifFalse: [
			aBlock value: child.
			child allRegularDirectoriesDo: aBlock]].
	
	"Look in parent directory and reasonable subfolders. 
	Useful when image is stored in a subdirectory of the main app directory.
	This could be the case when the package comes from a 'main' git repo, and image is copied from gitHub.
	First try directories including the word Cuis in the name. Then try others."
	base parent regularDirectoriesDo: [ :dir |
		dir ~= base ifTrue: [
			('*Cuis*' match: dir name)
				ifTrue: [aBlock value: dir. dir allRegularDirectoriesDo: aBlock]]].
	base parent regularDirectoriesDo: [ :dir |
		dir ~= base ifTrue: [
			('*Cuis*' match: dir name)
				ifFalse: [aBlock value: dir. dir allRegularDirectoriesDo: aBlock]]].

	"Also look in host OS current directory"
	(base ~= DirectoryEntry currentDirectory and: [base parent ~= DirectoryEntry currentDirectory])
		ifTrue: [
			base _ DirectoryEntry currentDirectory.
			base allRegularDirectoriesDo: aBlock ]! !

!PackageInstaller methodsFor: 'as yet unclassified' stamp: 'MM 11/25/2021 16:15:37'!
updatePackageList
	
	packageList _ OrderedCollection new.
	self collectPackagesFromDisk.
	packageList sort: [:p1 :p2 | p1 packageName < p2 packageName].
	PackageList _ packageList.
	self changed: #packageList.
	^ packageList! !

!CodePackageFile methodsFor: '*PackageInstaller' stamp: 'MM 11/19/2021 14:30:09'!
packageDescription
	^ description! !

More information about the Cuis-dev mailing list