[Pkg] Packages: Sake-Packages-kph.1.mcz
squeak-dev-noreply at lists.squeakfoundation.org
squeak-dev-noreply at lists.squeakfoundation.org
Fri Nov 28 16:37:16 UTC 2008
A new version of Sake-Packages was added to project Packages:
http://www.squeaksource.com/Packages/Sake-Packages-kph.1.mcz
==================== Summary ====================
Name: Sake-Packages-kph.1
Author: kph
Time: 28 November 2008, 4:37:15 pm
UUID: 511bb9e4-898a-433f-8084-2664dab63e28
Ancestors:
.
==================== Snapshot ====================
SystemOrganization addCategory: #'Sake-Packages'!
SakeTask subclass: #Packages
instanceVariableNames: 'unloadBlock unloadPriors provides name version isUnload'
classVariableNames: 'Provided'
poolDictionaries: ''
category: 'Sake-Packages'!
Packages class
instanceVariableNames: 'lastUpdate theUUniverse'!
!Packages commentStamp: 'kph 9/4/2008 15:29' prior: 0!
To generate all of the methods based upon universes definitions:
Packages taskGenerateAllUniverses run.
or
Packages taskGenerateAll run.
Sake/Packages usage:
Public API
============
Package definition for your current version of Squeak are found using the following path.
For SystemVersion Squeak3.7
Packages findPath -> {PackagesSqueak37 . PackagesDev . PackagesBeta} *the default is #current
Packages current findPath -> {PackagesSqueak37 . PackagesDev . PackagesBeta}
Packages dev findPath {PackagesDev. PackagesSqueak37 . PackagesBeta}
Packages beta findPath {PackagesBeta . PackagesSqueak37 . PackagesDev}
Packages current load: 'Seaside'.
Packages beta named: 'Seaside'.
or
(Packages current named: 'Seaside') run. " or runQuietly, runStepping, runLogging"
(Packages beta named: 'Seaside') run.
multiples:
Packages current load: #('Seaside' 'Magma' 'Logging')
Run-variants
=========
#runStepping , - presents a confirm/debug dialog before each action.
#run - default.
#runQuietly - auto-confirms any SakeConfirm dialogs.
#runLogging - Writes any SakeStop warnings to self log.
Unloading
========
Unloading comes in two variants.
Each package task loaded by Sake/Packages is remembered in the 'provided' list
If you perform:
Packages unload: 'Seaside' .
Packages unloadStepping: 'Seaside' .
Then the 'historical' unload scripts are used, as defined when the original load tasks were run.
If instead you perform:
(Packages current named: 'Seaside') unload runStepping.
Then the most recently defined unload script will be run.
Note: If packages such as "Magma server" and "Magma client" provides "Magma", then
Packages unload: 'Magma'.
Will unload whichever of the two are loaded.
===
Misc notes...
Universes are using 'instance side' task definition, so the task extensions mechanism does not work in this context.
!
----- Method: Packages class>>UUniverse (in category 'public') -----
UUniverse
^ Smalltalk classNamed: 'UUniverse'
!
----- Method: Packages class>>allPackagesDo: (in category 'public') -----
allPackagesDo: aBlock
^ (self allSelectorsBelow: Packages) collect: [ :ea | aBlock value: (self named: ea) ]!
----- Method: Packages class>>asSelector: (in category 'utils') -----
asSelector: aName
| toUse |
toUse := ''.
aName do:
[:char | char isAlphaNumeric ifTrue: [toUse := toUse copyWith: char]].
(aName size == 0 or: [aName first isLetter not])
ifTrue: [toUse := 'v', toUse].
^ toUse asSymbol
!
----- Method: Packages class>>basicNamed: (in category 'private') -----
basicNamed: packageName
^ self basicNew perform: (self asSelector: packageName); initialize; yourself!
----- Method: Packages class>>beta (in category 'public') -----
beta
^ PackagesBeta!
----- Method: Packages class>>current (in category 'public') -----
current
^ (Smalltalk classNamed: ('Packages' , SystemVersion current majorMinorVersion asLegalSelector capitalized) asSymbol) ifNil: [ Packages ]
!
----- Method: Packages class>>dev (in category 'public') -----
dev
^ PackagesDev!
----- Method: Packages class>>findNamed: (in category 'private') -----
findNamed: packageName
| sel |
sel := self asSelector: packageName.
^ (self findPath detect: [ :ea | ea canPerform: sel ] ifNone: [ self error: 'not found' ]) basicNamed: packageName!
----- Method: Packages class>>findPath (in category 'private') -----
findPath
^ { self dev. self current. self beta. }!
----- Method: Packages class>>freeSomeSpace (in category 'as yet unclassified') -----
freeSomeSpace
self initialize!
----- Method: Packages class>>initialize (in category 'initialization') -----
initialize
lastUpdate := nil.!
----- Method: Packages class>>isUniverse (in category 'testing') -----
isUniverse
^ self class includesSelector: #universeSelector
!
----- Method: Packages class>>lastUpdate (in category 'accessors') -----
lastUpdate
^ lastUpdate ifNil: [ lastUpdate := DateAndTime now ] !
----- Method: Packages class>>launchFrom: (in category 'launcher') -----
launchFrom: launcher
^self launchWith: launcher getParameters!
----- Method: Packages class>>launchWith: (in category 'launcher') -----
launchWith: params
| packagesClass task |
packagesClass := self current.
params at: 'B' ifPresent: [ :v | params at: 'BETA' put: v ].
params at: 'U' ifPresent: [ :v | params at: 'UNLOAD' put: v ].
params at: 'L' ifPresent: [ :v | params at: 'LOAD' put: v ].
params at: 'BETA' ifPresent: [ :v |
v ifTrue: [ packagesClass := self beta ].
].
params at: 'LOAD' ifPresent: [ :v |
task := packagesClass collection: (v findTokens: ';')
].
params at: 'UNLOAD' ifPresent: [ :v |
task := SakeTask collection: ((v findTokens: ';') collect: [ :ea | (self named: ea) unload ])
].
task launch: params.
^ true!
----- Method: Packages class>>load: (in category 'public') -----
load: aNameOrList
^ (self named: aNameOrList) run!
----- Method: Packages class>>named: (in category 'public') -----
named: packageNameOrList
packageNameOrList isString ifTrue: [ ^ self findNamed: packageNameOrList ].
^ (packageNameOrList collect: [ :ea | self findNamed: packageNameOrList ]) asTask!
----- Method: Packages class>>provided (in category 'accessors') -----
provided
^ Provided ifNil: [ Provided := Dictionary new ]!
----- Method: Packages class>>providedAt: (in category 'public') -----
providedAt: aName
^ self provided at: aName!
----- Method: Packages class>>squeakmap (in category 'public') -----
squeakmap
^ Smalltalk classNamed: #PackagesSqueakMap!
----- Method: Packages class>>string: (in category 'public') -----
string: aPackageName
^ self named: aPackageName!
----- Method: Packages class>>taskGenerateAll (in category 'tasks - universes') -----
taskGenerateAll
^ SakeTask define: [ :task |
task dependsOn: {
self taskGenerateAllUniverses
}.
task if: [ self squeakmap notNil ].
task action: { self squeakmap taskGenerateSqueakMapPackageTasks }
]
!
----- Method: Packages class>>taskGenerateAllUniverses (in category 'tasks - universes') -----
taskGenerateAllUniverses
"
self taskGenerateAllUniverses run.
"
^ SakeTask define: [ :task |
task if: { (SakeTask class: 'UUniverse') exists }.
task action:
(Packages allSubclasses select: [ :each | each initialize isUniverse ] thenCollect: [ :sc | sc taskGenerateUniversePackageTasks ]).
]
!
----- Method: Packages class>>taskGenerateUniversePackageTasks (in category 'tasks - universes') -----
taskGenerateUniversePackageTasks
| source selector |
^ SakeTask define: [ :task |
task dependsOn: {
[ self isUniverse ].
self taskUpdateUniverse.
self taskRemoveOldPackages.
}.
task action: [
(self theUUniverse packageNames collect: [ :each | self theUUniverse newestPackageNamed: each ]) do: [ :each |
source := (WriteStream on: String new).
source << (selector := self asSelector: each name).
source cr; cr.
source << ' self name: ' << each name printString << '.' ; cr.
source << ' self version: ''' << each version << '''.' ; cr.
source << ' info category: ''' << each category printString << '''.' ; cr.
source << ' info description: ' ; cr.
source << each description withSqueakLineEndings printString << '.' ; cr.
source << ' info maintainer: ''' << each maintainer << '''.' ; cr.
source << ' info homepage: ''' << (each homepage ifNil: ['']) asString << '''.' ; cr.
source << ' info squeakMapID: ''' << (each squeakMapID ifNil: ['']) asString << '''.' ; cr.
source << ' info url: ' << (each url ifNotNil: [ '''' , each url printString , '''' ] ifNil: [ 'nil' ]) << '.' ; cr.
source << ' self provides: ' << each provides asArray printString << '.' ; cr ; cr.
source << ' self dependsOn: ' << each depends asSortedCollection asArray printString << '.' ; cr ; cr.
(self sourceCodeAt: selector ifAbsent: nil) ~= source contents ifTrue: [
self compile: source contents classified: each category printString notifying: nil
]
].
theUUniverse := nil.
].
]!
----- Method: Packages class>>taskRemoveOldPackages (in category 'tasks - universes') -----
taskRemoveOldPackages
^ SakeTask define: [ :task |
task dependsOn: { [ self isUniverse ]. self taskUpdateUniverse. }.
task action: [
(self selectors difference:
(self theUUniverse packageNames collect: [ :each | self asSelector: each ]))
do: [ :old | self removeSelector: old ]
].
]!
----- Method: Packages class>>taskUpdateUniverse (in category 'tasks - universes') -----
taskUpdateUniverse
^ SakeTask define: [ :task |
task dependsOn: { [ self isUniverse ] }.
task if: [ theUUniverse isNil or: [ DateAndTime now - self lastUpdate > 10 minutes ] ].
task action: [
self theUUniverse updatePackagesViaWWW.
lastUpdate := DateAndTime now
].
]!
----- Method: Packages class>>taskValidate (in category 'tasks - universes') -----
taskValidate
"
self taskValidateAll run.
"
^ SakeTask define: [ :task |
task action: {
self taskValidateCategories }
]
!
----- Method: Packages class>>taskValidateAll (in category 'tasks - universes') -----
taskValidateAll
"
self taskValidateAll run.
"
^ SakeTask define: [ :task |
task action:
(Packages allSubclasses select: [ :each | each initialize isUniverse ] thenCollect: [ :sc | sc taskValidate ]).
]
!
----- Method: Packages class>>taskValidateCategories (in category 'tasks - universes') -----
taskValidateCategories
^ SakeTask define: [ :task |
task action: [
self selectors do: [ :sel |
self organization classify: sel under: (((self named: sel) info category) ifNil: [ 'as yet unclassified' ])
].
self organization removeEmptyCategories.
]
]
!
----- Method: Packages class>>theUUniverse (in category 'accessors') -----
theUUniverse
^ theUUniverse
ifNil: [ theUUniverse := (Smalltalk classNamed: 'UUniverse') perform: self universeSelector asSymbol ]!
----- Method: Packages class>>universe (in category 'public') -----
universe
^ Smalltalk classNamed: (('Packages' , SystemVersion current majorMinorVersion asLegalSelector capitalized), 'U') asSymbol
!
----- Method: Packages class>>unload: (in category 'public') -----
unload: aNameOrList
aNameOrList isString ifTrue: [ ^ (self providedAt: aNameOrList) unload run].
^ (aNameOrList collect: [ :ea | (self providedAt: aNameOrList) unload ]) asTask run
!
----- Method: Packages class>>unloadStepping: (in category 'public') -----
unloadStepping: aNameOrList
aNameOrList isString ifTrue: [ ^ (self providedAt: aNameOrList) unload runStepping].
^ (aNameOrList collect: [ :ea | (self providedAt: aNameOrList) unload ]) asTask runStepping
!
----- Method: Packages class>>upgrade (in category 'public') -----
upgrade
self provided values asSet asTask run!
----- Method: Packages>>= (in category 'as yet unclassified') -----
= other
^ (super = other) and: [ self version = other version ]
!
----- Method: Packages>>action (in category 'as yet unclassified') -----
action
^ self isUnloading
ifTrue: [ unloadBlock ifNil: [ [ self defaultUnloadAction ] ] ]
ifFalse: [ super action ].!
----- Method: Packages>>allDependants (in category 'Packages-Core') -----
allDependants
| list |
list := OrderedCollection new.
self provides in: [ :tgt |
self class allPackagesDo: [ :package |
package withAllPriorTasksIgnoringErrorsDo: [ :ea |
(ea dependsOn includesAnyOf: tgt) ifTrue: [ (list includes: package) ifFalse: [ list add: package ] ].
]
]
].
^ list
"
String streamContents: [ :str | (Packages current named:'Seaside') allDependants do: [ :ea | str << ea info name << String cr << ea info description << String cr << '======='; cr ] ]
"!
----- Method: Packages>>beUnloading (in category 'as yet unclassified') -----
beUnloading
isUnload := true.
hasRun := false.!
----- Method: Packages>>defaultAction (in category 'as yet unclassified') -----
defaultAction
^ [ self info url ifNotNilDo: [ :url | Installer installUrl: url ] ]!
----- Method: Packages>>defaultUnloadAction (in category 'as yet unclassified') -----
defaultUnloadAction
self info url ifNotNil: [ Installer mc unload: self name ]!
----- Method: Packages>>dependants (in category 'as yet unclassified') -----
dependants
^ self class provided select: [ :dependant |
dependant dependsOn includesAnyOf: self provides.
].
!
----- Method: Packages>>dependsOn (in category 'as yet unclassified') -----
dependsOn
self isUnloading ifFalse: [ ^ super dependsOn ].
unloadPriors ifNil: [ self unloadDependsOn: self loadedDependantsUnloadTasks ].
^ unloadPriors!
----- Method: Packages>>doActionEnd (in category 'as yet unclassified') -----
doActionEnd
self isUnloading ifTrue: [ ^ self ].
self class provided in: [ :reg |
info := nil.
self provides do: [ :each | reg at: each put: self ].
].
^ nil!
----- Method: Packages>>doActionStep (in category 'as yet unclassified') -----
doActionStep
name ifNil: [ ^ self ].
self isUnloading
ifTrue: [ self step: 'Confirm unload: ', self name printString ]
ifFalse: [ self step: 'Confirm load: ', self name printString ]!
----- Method: Packages>>hash (in category 'as yet unclassified') -----
hash
^ super hash bitXor: self version hash!
----- Method: Packages>>isAlreadyProvided (in category 'as yet unclassified') -----
isAlreadyProvided
(self version includes: '+') ifTrue: [ ^ false ].
^ (self class provided at: self name ifAbsent: [ ^ false ]) version = self version
!
----- Method: Packages>>isNeeded (in category 'as yet unclassified') -----
isNeeded
self isAlreadyProvided ifTrue: [ ^ false ].
^ super isNeeded!
----- Method: Packages>>isUnloading (in category 'as yet unclassified') -----
isUnloading
^ isUnload = true!
----- Method: Packages>>load: (in category 'as yet unclassified') -----
load: aBlock
self action: aBlock!
----- Method: Packages>>loadedDependants (in category 'as yet unclassified') -----
loadedDependants
^ self class provided select: [ :dependant |
dependant dependsOn includesAnyOf: self provides.
].
!
----- Method: Packages>>loadedDependantsUnloadTasks (in category 'as yet unclassified') -----
loadedDependantsUnloadTasks
"if the task is the provided one, then we return the provided dependants."
self loadedDependants in: [ :deps |
deps ifEmpty: [ ^ #() ].
^ (self class provided at: self name ifAbsent: nil) == self
ifTrue: [ (deps collect: [ :ea | ea copy beUnloading ]) ]
ifFalse: [ (deps collect: [ : ea | (self class named: ea name) beUnloading ]) ]
].!
----- Method: Packages>>name (in category 'as yet unclassified') -----
name
^ name ifNil: [ 'No Name' ]!
----- Method: Packages>>name: (in category 'as yet unclassified') -----
name: aPackageName
"the method which names us is our context"
self setContext: thisContext sender.
name := aPackageName.
self info name: aPackageName.!
----- Method: Packages>>provides (in category 'as yet unclassified') -----
provides
provides ifNil: [ provides := #() ].
(provides includes: self name) ifFalse: [ provides := provides copyWith: self name ].
^ provides!
----- Method: Packages>>provides: (in category 'as yet unclassified') -----
provides: list
provides := list.
(list includes: self name) ifFalse: [ provides := provides copyWith: self name ].
!
----- Method: Packages>>unload (in category 'as yet unclassified') -----
unload
^ self copy beUnloading !
----- Method: Packages>>unload: (in category 'as yet unclassified') -----
unload: aBlock
unloadBlock := aBlock!
----- Method: Packages>>unloadDependsOn: (in category 'as yet unclassified') -----
unloadDependsOn: aList
unloadPriors := aList reject: [ :ea | ea isNil ]
!
----- Method: Packages>>version (in category 'as yet unclassified') -----
version
^ version!
----- Method: Packages>>version: (in category 'as yet unclassified') -----
version: aPackageVersion
"the method which versions us is our context"
self setContext: thisContext sender.
self info version: aPackageVersion.
version := aPackageVersion.!
More information about the Packages
mailing list