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.!