[squeak-dev] The Inbox: ConfigBrowser-ar.1.mcz

commits at source.squeak.org commits at source.squeak.org
Wed May 19 05:33:00 UTC 2010


A new version of ConfigBrowser was added to project The Inbox:
http://source.squeak.org/inbox/ConfigBrowser-ar.1.mcz

==================== Summary ====================

Name: ConfigBrowser-ar.1
Author: ar
Time: 18 May 2010, 10:32:53.736 pm
UUID: e3a7091a-3d7a-1446-b44d-d374b7ca8d42
Ancestors: 

A very first commit of ConfigBrowser, a UI for browsing and installing Metacello configurations. Requires the Configurations package.

==================== Snapshot ====================

SystemOrganization addCategory: #'ConfigBrowser-UI'!

Model subclass: #ConfigBrowser
	instanceVariableNames: 'builder window configRoot selectedConfig'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'ConfigBrowser-UI'!

!ConfigBrowser commentStamp: 'ar 5/18/2010 18:08' prior: 0!
ToolBuilder open: self new.!

----- Method: ConfigBrowser classSide>>open (in category 'opening') -----
open
	^ToolBuilder open: self new!

----- Method: ConfigBrowser>>buildButtonBarWith: (in category 'toolbuilder') -----
buildButtonBarWith: aBuilder
	^ aBuilder pluggablePanelSpec new
		model: self;
		layout: #horizontal;
		children: (self commandSpecs select: [ :spec | spec fourth includes: #all]
				thenCollect: [ :spec |
					aBuilder pluggableActionButtonSpec new
						model: self;
						label: spec first;
						action: spec second;
						help: spec third;
						enabled: ((spec fourth includes: #item) ifTrue: [#hasSelectedItem]);
						yourself]);
		name: #buttonBar;
		yourself!

----- Method: ConfigBrowser>>buildButtonNamed:helpText:action: (in category 'toolbuilder') -----
buildButtonNamed: labelText helpText: balloon action: action
	| btn |
	btn := PluggableButtonMorph on: self getState: nil action: action.
	btn color: Color transparent;
		hResizing: #shrinkWrap;
		vResizing: #spaceFill;
		label: labelText;
		setBalloonText: balloon;
		onColor: Color transparent offColor: Color transparent.
	^ btn!

----- Method: ConfigBrowser>>buildCategoriesListWith: (in category 'toolbuilder') -----
buildCategoriesListWith: aBuilder 
	"Create the hierarchical list holding the category tree."
	^ aBuilder pluggableTreeSpec new model: self;
		 roots: #categoryList;
		 getSelectedPath: #selectedCategoryPath;
		 getChildren: #categoryChildren:;
		 hasChildren: #categoryHasChildren:;
		 setSelected: #selectedCategory:;
		 menu: #categoriesMenu:;
		 label: #categoryLabel:;
		 autoDeselect: true;
		 wantsDrop: true;
		 name: #categoriesList;
		 yourself!

----- Method: ConfigBrowser>>buildPackagePaneWith: (in category 'toolbuilder') -----
buildPackagePaneWith: aBuilder
	"Create the text area to the right in the loader."

	^ aBuilder pluggableTextSpec new model: self; getText: #itemDescription; name: #packagePane; yourself!

----- Method: ConfigBrowser>>buildPackagesListWith: (in category 'toolbuilder') -----
buildPackagesListWith: aBuilder 
	"Create the hierarchical list holding the packages and releases."
	^ aBuilder pluggableTreeSpec new model: self;
		 roots: #packageList;
		 getSelectedPath: #selectedItemPath;
		 setSelected: #selectedItem:;
		 menu: #packagesMenu:;
		 label: #itemLabel:;
		 getChildren: #itemChildren:;
		 hasChildren: #itemHasChildren:;
		 autoDeselect: true;
		 wantsDrop: true;
		 name: #packagesList;
		 yourself!

----- Method: ConfigBrowser>>buildSearchPaneWith: (in category 'toolbuilder') -----
buildSearchPaneWith: aBuilder
	^ aBuilder pluggableInputFieldSpec new model: self;
		selection: #searchSelection;
		getText: #searchText; setText: #findPackage:notifying:; name: #search; yourself!

----- Method: ConfigBrowser>>buildWith: (in category 'toolbuilder') -----
buildWith: aBuilder 
	"Create the package loader window."
	| buttonBarHeight vertDivide horizDivide |
	buttonBarHeight := 0.07.
	vertDivide := 0.6.
	horizDivide := 0.3.
	builder := aBuilder.
	window := builder build: (builder pluggableWindowSpec new model: self;
					 label: #label;
					 children: (OrderedCollection new
						add: ((self buildSearchPaneWith: builder)
							frame: (0 @ 0 corner: horizDivide @ buttonBarHeight));
						add: ((self buildButtonBarWith: builder)
							frame: (horizDivide @ (1- buttonBarHeight) corner: 1 @ 1));
						add: ((self buildPackagesListWith: builder)
							frame: (0 @ (buttonBarHeight) corner: horizDivide @ 1));
						add: ((self buildPackagePaneWith: builder)
								frame: (horizDivide @ 0 corner: 1 @ (1- buttonBarHeight)));
						 yourself);
					 yourself).
	window on: #mouseEnter send: #paneTransition: to: window.
	window on: #mouseLeave send: #paneTransition: to: window.
	window extent: self initialExtent.
	^ window!

----- Method: ConfigBrowser>>commandSpecs (in category 'toolbuilder') -----
commandSpecs
	^ #(('Install' installPackageRelease 'Install the selected package.' (item all))
		('Update' updatePackage 'Update the selected package.' (item all))
		('Help' help 'What is this?' (all)))!

----- Method: ConfigBrowser>>hasSelectedItem (in category 'model access') -----
hasSelectedItem
	^ selectedConfig notNil!

----- Method: ConfigBrowser>>initialize (in category 'initialize') -----
initialize
	"ConfigBrowser open"
	configRoot := ConfigRoot new.
!

----- Method: ConfigBrowser>>itemChildren: (in category 'model access') -----
itemChildren: config

	^config items
!

----- Method: ConfigBrowser>>itemDescription (in category 'model access') -----
itemDescription
	selectedConfig ifNotNil:[^selectedConfig description].
	^'Welcome to the Squeak Package Installer!!

Please select from the list on the left which package to install. 
Some packages may offer different versions, it is recommended to install the default version unless a specfic version is required'!

----- Method: ConfigBrowser>>itemHasChildren: (in category 'model access') -----
itemHasChildren: config
	^config items notEmpty!

----- Method: ConfigBrowser>>itemLabel: (in category 'model access') -----
itemLabel: config
	^config name!

----- Method: ConfigBrowser>>label (in category 'window') -----
label
	^self class name!

----- Method: ConfigBrowser>>packageList (in category 'model access') -----
packageList
	^configRoot items!

----- Method: ConfigBrowser>>searchSelection (in category 'model access') -----
searchSelection
	"Selects all of the default search text so that a type-in overwrites it."
	^ {1. self searchText size}!

----- Method: ConfigBrowser>>searchText (in category 'model access') -----
searchText
	"A dummy default search text so that the field describes its purpose."
	^ 'Search packages'!

----- Method: ConfigBrowser>>selectedItem (in category 'model access') -----
selectedItem
	^selectedConfig!

----- Method: ConfigBrowser>>selectedItem: (in category 'model access') -----
selectedItem: configClass
	selectedConfig := configClass.
	self changed: #selectedItem.
	self changed: #itemDescription.
	self changed: #hasSelectedItem.!

Object subclass: #ConfigEntity
	instanceVariableNames: 'item parent'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'ConfigBrowser-UI'!

!ConfigEntity commentStamp: 'ar 5/18/2010 19:46' prior: 0!
A common superclass for config entitites.!

ConfigEntity subclass: #ConfigCategory
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'ConfigBrowser-UI'!

!ConfigCategory commentStamp: 'ar 5/18/2010 19:45' prior: 0!
A system category containing configuration.!

----- Method: ConfigCategory>>description (in category 'accessing') -----
description

	^Text streamContents:[:s|
"		s nextPutAll:'Category: ' asText allBold.
		s nextPutAll: self name; cr.	"
		s nextPutAll:'Packages: ' asText allBold.
		self items do:[:each| s crtab; nextPutAll: '* '; nextPutAll: each name].
	]!

----- Method: ConfigCategory>>items (in category 'accessing') -----
items
	"Collect the config classes in this category"

	| list |
	list := MetacelloConfiguration allSubclasses select:[:aClass| aClass category = item].
	^(list sort:[:c1 :c2| c1 name <= c2 name]) collect:[:each| ConfigClass on: each in: self]
!

----- Method: ConfigCategory>>name (in category 'accessing') -----
name
	"Strip off the top-level category, usually 'Configuration-Whatever'"
	^(item includes: $-)
		ifTrue:[item copyAfter: $-]
		ifFalse:[item]!

ConfigEntity subclass: #ConfigClass
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'ConfigBrowser-UI'!

!ConfigClass commentStamp: 'ar 5/18/2010 19:45' prior: 0!
A Metacello configuration class.!

----- Method: ConfigClass>>canBeInstalled (in category 'testing') -----
canBeInstalled
	^true!

----- Method: ConfigClass>>description (in category 'accessing') -----
description

	^Text streamContents:[:s|
		s nextPutAll:'Name: ' asText allBold.
		s nextPutAll: self name.
		s cr; nextPutAll:'Versions: ' asText allBold.
		self items do:[:each| s nextPutAll: each name] separatedBy:[s nextPutAll: ', '].
		s cr; nextPutAll: 'Description: ' asText allBold.
		item hasComment ifTrue:[s cr; cr; nextPutAll: item comment].
	]!

----- Method: ConfigClass>>descriptionFor: (in category 'accessing') -----
descriptionFor: configVersion
	| proxy |
	proxy := ConfigProxy new.
	item new perform: configVersion selector with: proxy.
	^proxy description ifNil:['']!

----- Method: ConfigClass>>isBlessingAcceptableIn: (in category 'testing') -----
isBlessingAcceptableIn: selector
	| proxy |
	proxy := ConfigProxy new.
	item new perform: selector with: proxy.
	^#(release beta) includes: proxy blessing!

----- Method: ConfigClass>>items (in category 'accessing') -----
items
	"Collect the available versions in the configuration"

	| versions |
	versions := Array streamContents:[:s|
		Pragma withPragmasIn: item do:[:pragma|
			(pragma keyword == #version: 
				or:[pragma keyword == #version:imports:])
					ifTrue:[s nextPut: pragma selector -> pragma arguments first]]].
	versions := versions select:[:assoc| self isBlessingAcceptableIn: assoc key].
	^versions collect:[:each| 
		(ConfigVersion on: each value in: self) selector: each key
	].!

----- Method: ConfigClass>>name (in category 'accessing') -----
name
	"Strip off the ConfigurationOf from the class name"

	^(item name beginsWith: 'ConfigurationOf')
		ifTrue:[item name allButFirst: 'ConfigurationOf' size]
		ifFalse:[item name]!

----- Method: ConfigEntity classSide>>on:in: (in category 'instance creation') -----
on: anItem in: aParent
	^self new on: anItem in: aParent!

----- Method: ConfigEntity>>canBeInstalled (in category 'testing') -----
canBeInstalled
	^false!

----- Method: ConfigEntity>>description (in category 'accessing') -----
description
	^parent ifNil:['No description'] ifNotNil:[parent description].
!

----- Method: ConfigEntity>>items (in category 'accessing') -----
items
	"Answer the config items contained in this entity"
	^#()!

----- Method: ConfigEntity>>name (in category 'accessing') -----
name
	"Answer the name for this configuration entity"
	^item name!

----- Method: ConfigEntity>>on:in: (in category 'initialize') -----
on: anItem in: aParent

	item := anItem.
	parent := aParent.!

ConfigEntity subclass: #ConfigRoot
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'ConfigBrowser-UI'!

!ConfigRoot commentStamp: 'ar 5/18/2010 19:46' prior: 0!
The virtual root for all config entities.!

----- Method: ConfigRoot>>items (in category 'accessing') -----
items
	| classes categories |
	classes := MetacelloConfiguration allSubclasses.
	categories := classes collect:[:each| each category] as: Set.
	^(categories asArray sort) collect:[:cat| ConfigCategory on: cat in: self].!

ConfigEntity subclass: #ConfigTarget
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'ConfigBrowser-UI'!

!ConfigTarget commentStamp: 'ar 5/18/2010 19:46' prior: 0!
A target (group) that can be installed.!

ConfigEntity subclass: #ConfigVersion
	instanceVariableNames: 'selector'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'ConfigBrowser-UI'!

!ConfigVersion commentStamp: 'ar 5/18/2010 19:46' prior: 0!
A version in a configuration class.!

----- Method: ConfigVersion>>canBeInstalled (in category 'testing') -----
canBeInstalled
	^true!

----- Method: ConfigVersion>>description (in category 'accessing') -----
description

	^Text streamContents:[:s|
		s nextPutAll:'Name: ' asText allBold.
		s nextPutAll: parent name.
		s cr; nextPutAll:'Version: ' asText allBold.
		s nextPutAll: self name.
		s cr; nextPutAll: 'Description: ' asText allBold.
		s cr; nextPutAll: (parent descriptionFor: self).
	]!

----- Method: ConfigVersion>>items (in category 'accessing') -----
items
	"The targets defined in the config"

	^#()!

----- Method: ConfigVersion>>name (in category 'accessing') -----
name
	"Just the name of the version please"

	^item!

----- Method: ConfigVersion>>selector (in category 'accessing') -----
selector
	^selector!

----- Method: ConfigVersion>>selector: (in category 'accessing') -----
selector: aString
	selector := aString!

Object subclass: #ConfigProxy
	instanceVariableNames: 'blessing targets description'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'ConfigBrowser-UI'!

----- Method: ConfigProxy>>author: (in category 'api') -----
author: aString
	"Author name"

!

----- Method: ConfigProxy>>blessing (in category 'accessing') -----
blessing
	^blessing!

----- Method: ConfigProxy>>blessing: (in category 'api') -----
blessing: aSymbol
	"Blessing (whatever). Known values:
		#baseline
		#release
		#beta
		#development
		#broken
	"
	blessing := aSymbol.
!

----- Method: ConfigProxy>>className: (in category 'api') -----
className: aSymbol
	"Name of a class to load from an external config"
!

----- Method: ConfigProxy>>description (in category 'accessing') -----
description
	^description!

----- Method: ConfigProxy>>description: (in category 'api') -----
description: aString
	"Description. Seems to be more change log style than package description."
	description := aString!

----- Method: ConfigProxy>>file: (in category 'api') -----
file: aString
	"Name of the MCZ file actually containing the contents for a package/project.
	Can include or exclude version, i.e.,
		spec package: 'Metacello-TestsPlatform' with: [
				spec requires: #('Metacello-Platform');
					file: 'Metacello-TestsPlatform.squeakCommon'].
		spec project: 'Grease' with: [
				spec className: 'ConfigurationOfGrease';
					versionString: '1.0-alpha2-baseline';
					file: 'ConfigurationOfGrease';
					repository: 'http://www.squeaksource.com/MetacelloRepository' ];
	"
!

----- Method: ConfigProxy>>for:do: (in category 'api') -----
for: aSymbol do: aBlock
	"Conditional evaluation based on symbol value:
		#common - all systems
		#pharo - Pharo only
		#squeak - Squeak only
		#gemstone - Gemstone only
	"
	(#(common squeakCommon squeak) includes: aSymbol)
		ifTrue:[aBlock value]!

----- Method: ConfigProxy>>group:overrides: (in category 'strange') -----
group: groupName overrides: aList
	"No clue"
!

----- Method: ConfigProxy>>group:with: (in category 'api') -----
group: aString with: packageList
	"Group of packages. Can be nested. Example Gofer>>baseline100:
		spec
			group: 'default' with: #('Core');
			group: 'Core' with: #('Gofer-Core');
			group: 'Tests' with: #('Gofer-Tests'). ].
	"
	targets := targets copyWith: aString.
!

----- Method: ConfigProxy>>includes: (in category 'api') -----
includes: aList
	"Like requres: just the other direction; the list of specs must be loaded after the current one."
!

----- Method: ConfigProxy>>initialize (in category 'initialize') -----
initialize
	targets := #().
!

----- Method: ConfigProxy>>loads: (in category 'api') -----
loads: aList
	"Loads a specific set of targets (packages) from another configuration project..
		spec project: 'OB' with: [
				spec
					className: 'ConfigurationOfOmniBrowser';
					loads: #('Core' 'OB-Shout' );
					file: 'ConfigurationOfOmniBrowser';
					repository: 'http://www.squeaksource.com/MetacelloRepository' ];
	"
!

----- Method: ConfigProxy>>name: (in category 'strange') -----
name: aString
	"Used by projectPackage:"!

----- Method: ConfigProxy>>package: (in category 'api') -----
package: packageName
	"Shorthand for package:with:[]?"
!

----- Method: ConfigProxy>>package:with: (in category 'api') -----
package: packageName with: blockOrString
	"If string, apparently the file name for the package, i.e.,
		spec 
			package: 'Alien-Prereqs' with: 'Alien-Prereqs-mha.3'.
	If block, a set of properties for the package, e.g.,
		spec 
			package: 'Pier-Book' with: [ 
				spec requires: #('Pier Core')];
	"
	blockOrString isBlock ifTrue:[blockOrString value].
!

----- Method: ConfigProxy>>postLoadDoIt: (in category 'api') -----
postLoadDoIt: configSelector
	"Selector of method to perform after load. Generally a simple doIt"
!

----- Method: ConfigProxy>>preLoadDoIt: (in category 'api') -----
preLoadDoIt: configSelector
	"Selector of method to perform before load. Generally a simple validation"
!

----- Method: ConfigProxy>>project:copyFrom:with: (in category 'api') -----
project: project copyFrom: other with: aBlock
	"Modifies an existing project target with settings in aBlock.
	Project target = ConfigurationOfXXX + package"
	aBlock value.!

----- Method: ConfigProxy>>project:with: (in category 'api') -----
project: projName with: aBlock
	"Defines a new project (external target) with settings in aBlock.
	Project target = ConfigurationOfXXX + package"
	aBlock value.!

----- Method: ConfigProxy>>projectPackage: (in category 'strange') -----
projectPackage: aBlock
	"Used only by Seaside 3.0"
	aBlock value.!

----- Method: ConfigProxy>>removeGroup: (in category 'strange') -----
removeGroup: package
	"No clue"
!

----- Method: ConfigProxy>>removePackage: (in category 'strange') -----
removePackage: package
	"No clue"
!

----- Method: ConfigProxy>>repository: (in category 'api') -----
repository: aString
	"Sets repository location for current target"

!

----- Method: ConfigProxy>>requires: (in category 'api') -----
requires: aList
	"Declares dependencies."
!

----- Method: ConfigProxy>>supplyingAnswers: (in category 'api') -----
supplyingAnswers: aList
	"Shuts up interactive requests"
!

----- Method: ConfigProxy>>timestamp: (in category 'api') -----
timestamp: ts
	"Timestamp for spec"
!

----- Method: ConfigProxy>>version: (in category 'api') -----
version: aString
	"Define a version for some package. How is this different from versionString???"!

----- Method: ConfigProxy>>versionString: (in category 'api') -----
versionString: string
	"Sets version string for a project (external target), i.e.,
		spec project: 'Refactoring-Core' with: [
				spec
					className: 'ConfigurationOfRefactoringBrowser';
					versionString: '1.2-baseline';
					loads: #('Refactoring-Core' );
					file: 'ConfigurationOfRefactoringBrowser';
					repository: 'http://www.squeaksource.com/MetacelloRepository' ];
			yourself.
	"
!




More information about the Squeak-dev mailing list