help-smalltalk
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Help-smalltalk] [PATCH] Implement composite design pattern in PackageLo


From: Paolo Bonzini
Subject: [Help-smalltalk] [PATCH] Implement composite design pattern in PackageLoader
Date: Thu, 21 Jun 2007 10:02:38 +0200
User-agent: Thunderbird 2.0.0.4 (Macintosh/20070604)

This allows to rely on more polymorphism and, in the future, will simplify integration of VFS and PackageLoader (so that packages may reside in a single ZIP or TAR file with a separate packages.xml file for each of them).

Paolo
* looking for address@hidden/smalltalk--devo--2.2--patch-403 to compare with
* comparing to address@hidden/smalltalk--devo--2.2--patch-403
M  kernel/PkgLoader.st

* modified files

--- orig/kernel/PkgLoader.st
+++ mod/kernel/PkgLoader.st
@@ -30,7 +30,6 @@
 |
  ======================================================================"
 
-
 Object subclass: #Package
        instanceVariableNames: 'name features prerequisites builtFiles files 
fileIns directory libraries modules callouts namespace sunitScripts'
        classVariableNames: ''
@@ -43,6 +42,45 @@ Package comment:
 information on a Smalltalk package, and can output my description in
 XML.'!
 
+Namespace current: Kernel!
+
+Object subclass: #PackageGroup
+       instanceVariableNames: ''
+       classVariableNames: ''
+       poolDictionaries: ''
+       category: 'Language-Packaging'
+!
+
+PackageGroup comment:
+'I am not part of a standard Smalltalk system. I store internally the
+information on a Smalltalk package, and can output my description in
+XML.'!
+
+PackageGroup subclass: #PackageDirectories
+       instanceVariableNames: 'dirs'
+       classVariableNames: ''
+       poolDictionaries: ''
+       category: 'Language-Packaging'
+!
+
+PackageDirectories comment:
+'I am not part of a standard Smalltalk system. I store internally the
+information on a Smalltalk package, and can output my description in
+XML.'!
+
+PackageGroup subclass: #PackageDirectory
+       instanceVariableNames: 'packages fileName baseDirectories'
+       classVariableNames: ''
+       poolDictionaries: ''
+       category: 'Language-Packaging'
+!
+
+PackageDirectory comment:
+'I am not part of a standard Smalltalk system. I store internally the
+information on a Smalltalk package, and can output my description in
+XML.'!
+
+Namespace current: Smalltalk!
 
 Object subclass: #PackageLoader
        instanceVariableNames: ''
@@ -52,7 +90,7 @@ Object subclass: #PackageLoader
 !
 
 PackageLoader class
-       instanceVariableNames: 'packages loadDate ignoreCallouts'!
+       instanceVariableNames: 'root loadDate ignoreCallouts'!
 
 PackageLoader comment: 
 'I am not part of a standard Smalltalk system. I provide methods for
@@ -60,6 +98,249 @@ retrieving package information from an X
 into a Smalltalk image, correctly handling dependencies.'!
 
 
+!Kernel.PackageGroup methodsFor: 'printing'!
+
+printOn: aStream
+    "Print the XML source code for the information that the PackageLoader
+     holds on aStream."
+    aStream nextPutAll: '<packages>'; nl.
+    self do: [ :each | each printOn: aStream ].
+    aStream nextPutAll: '</packages>'
+! !
+
+!Kernel.PackageGroup methodsFor: 'accessing'!
+
+at: aString
+    ^self at: aString ifAbsent: [ self error: 'package not found' ]
+!
+
+at: aString ifAbsent: aBlock
+    self subclassResponsibility
+!
+
+do: aBlock
+    self keys do: [ :each | aBlock value: (self at: each) ]
+!
+
+keys
+    self subclassResponsibility
+!
+
+includesKey: aString
+    self subclassResponsibility
+!
+
+extractDependenciesFor: packagesList ifMissing: aBlock
+    "Answer an OrderedCollection containing all the packages which you
+     have to load to enable the packages in packagesList, in an appropriate
+     order. For example
+
+     PackageLoader extractDependenciesFor: #('BloxTestSuite' 'Blox' 'Browser')
+
+     on a newly built image will evaluate to an OrderedCollection containing
+     'Kernel', 'Blox', 'BloxTestSuite' and 'Browser'. Note that
+     Blox has been moved before BloxTestSuite.
+     Pass an error message to aBlock if one or more packages need
+     prerequisites which are not available."
+
+    | toBeLoaded featuresFound dependencies allPrereq allFeatures |
+    toBeLoaded := packagesList asOrderedCollection.
+    toBeLoaded := toBeLoaded collect: [ :each | each asString ].
+    featuresFound := Set withAll: Smalltalk.Features.
+    featuresFound := featuresFound collect: [ :each | each asString ].
+    dependencies := packagesList collect: [ :each | each asString ].
+    [
+       allPrereq := Set new.
+       allFeatures := Set new.
+       dependencies do: [ :name || package |
+           (featuresFound includes: name) ifFalse: [
+               package := self at: name ifAbsent: [ ^aBlock value: name ].
+               allPrereq addAll: package prerequisites.
+               allFeatures addAll: package features
+           ]
+       ].
+
+       "I don't think there will never be lots of packages in newDep (say
+        more than 5), so I think it is acceptable to remove duplicates
+        this naive way.  Note that we remove duplicates from toBeLoaded
+        so that prerequisites are always loaded *before*."
+       toBeLoaded removeAll: allPrereq ifAbsent: [ :doesNotMatter | ].
+       toBeLoaded removeAll: allFeatures ifAbsent: [ :doesNotMatter | ].
+
+       allPrereq removeAll: allFeatures ifAbsent: [ :doesNotMatter | ].
+       featuresFound addAll: allFeatures.
+       toBeLoaded addAllFirst: allPrereq.
+
+       "Proceed recursively with the prerequisites for allPrereq"
+       dependencies := allPrereq.
+       dependencies notEmpty
+    ] whileTrue.
+
+    ^toBeLoaded
+!
+
+
+!Kernel.PackageDirectories class methodsFor: 'instance creation'!
+
+new
+    ^super new initialize
+! !
+
+!Kernel.PackageDirectories methodsFor: 'accessing'!
+
+add: aDirectory
+    ^dirs add: aDirectory
+!
+
+at: aString ifAbsent: aBlock
+    dirs do: [ :each || package |
+       package := each at: aString ifAbsent: [ nil ].
+       package isNil ifFalse: [ ^package ] ].
+    ^aBlock value
+!
+
+keys
+    | keys |
+    keys := Set new.
+    dirs do: [ :each | keys addAll: each keys ].
+    ^keys
+!
+
+includesKey: aString
+    ^dirs anySatisfy: [ :each | each includesKey: aString ]
+!
+
+shouldReload: loadDate
+    ^dirs anySatisfy: [ :each | each shouldReload: loadDate ]
+!
+
+refresh
+    dirs do: [ :each | each refresh ]
+! !
+
+!Kernel.PackageDirectories methodsFor: 'initializing'!
+
+initialize
+    dirs := OrderedCollection new
+! !
+
+
+!Kernel.PackageDirectory class methodsFor: 'accessing'!
+
+new
+    self shouldNotImplement
+!
+
+on: aString baseDirectories: anArray
+    ^super new
+       fileName: aString;
+       baseDirectories: anArray
+! !
+
+!Kernel.PackageDirectory methodsFor: 'accessing'!
+
+fileName
+    ^fileName
+!
+
+fileName: aString
+    fileName := aString
+!
+
+baseDirectories
+    ^baseDirectories
+!
+
+baseDirectories: anArray
+    baseDirectories := anArray
+!
+
+at: aString ifAbsent: aBlock
+    ^packages at: aString asString ifAbsent: aBlock
+!
+
+keys
+    ^packages keys
+!
+
+includesKey: aString
+    ^packages includesKey: aString
+! !
+
+!Kernel.PackageDirectory methodsFor: 'refreshing'!
+
+shouldReload: loadDate
+    | file |
+    file := File name: fileName.
+    file exists ifFalse: [ packages := LookupTable new. ^false ].
+    ^file lastModifyTime > loadDate
+!
+
+refresh
+    "Private - Process the XML source in the packages file, creating
+     Package objects along the way."
+
+    | cdata file stack ch tag package allDirs |
+    allDirs := Smalltalk imageLocal
+       ifTrue: [ { Directory image }, baseDirectories ]
+       ifFalse: [ baseDirectories ].
+    allDirs isEmpty ifTrue: [ ^self ].
+
+    packages := LookupTable new.
+    file := [ FileStream open: fileName mode: FileStream read ]
+       on: Error
+       do: [ :ex | ^self ].
+
+    stack := OrderedCollection new.
+    [ cdata := cdata isNil
+       ifTrue: [ file upTo: $< ]
+       ifFalse: [ cdata, (file upTo: $<) ].
+
+       file atEnd ] whileFalse: [
+       ch := file peek.
+       ch == $! ifTrue: [ file skipTo: $> ].
+       ch == $/ ifTrue: [
+           tag := stack removeLast.
+           file next.
+           (file upTo: $>) = tag ifFalse: [
+               file close.
+               ^self error: 'error in packages file: unmatched end tag ', tag
+           ].
+
+           "I tried to put these from the most common to the least common"
+
+           tag = 'file' ifTrue: [ package files add: cdata ] ifFalse: [
+           tag = 'filein' ifTrue: [ package fileIns add: cdata ] ifFalse: [
+           tag = 'prereq' ifTrue: [ package prerequisites add: cdata ] 
ifFalse: [
+           tag = 'provides' ifTrue: [ package features add: cdata ] ifFalse: [
+           tag = 'module' ifTrue: [ package modules add: cdata ] ifFalse: [
+           tag = 'directory' ifTrue: [ package directory: cdata ] ifFalse: [
+           tag = 'name' ifTrue: [ package name: cdata ] ifFalse: [
+           tag = 'namespace' ifTrue: [ package namespace: cdata ] ifFalse: [
+           tag = 'library' ifTrue: [ package libraries add: cdata ] ifFalse: [
+           tag = 'package' ifTrue: [
+               (package baseDirectories: allDirs)
+                   ifTrue: [ packages at: package name put: package ]] 
ifFalse: [
+           tag = 'built-file' ifTrue: [ package builtFiles add: cdata ] 
ifFalse: [
+           tag = 'sunit' ifTrue: [ package sunitScripts add: cdata ] ifFalse: [
+           tag = 'callout' ifTrue: [ package callouts add: cdata ]]]]]]]]]]]]].
+           cdata := nil.
+       ].
+       ch isAlphaNumeric ifTrue: [
+           stack addLast: (tag := file upTo: $>).
+           tag = 'package' ifTrue: [ package := Package new ].
+           tag = 'disabled-package' ifTrue: [ package := Package new ].
+           cdata := nil
+       ].
+    ].
+    file close.
+    stack isEmpty ifFalse: [
+       self error: 'error in packages file: unmatched start tags', stack 
asArray printString
+    ].
+! !
+
+
+
 !Package methodsFor: 'accessing'!
 
 fileIn
@@ -81,8 +362,7 @@ printOn: aStream
     "Print a representation of the receiver on aStream (it happens
      to be XML."
 
-    aStream nextPutAll: '
-<package>
+    aStream nextPutAll: '<package>
   <name>'; nextPutAll: self name; nextPutAll: '</name>'; nl.
 
     self namespace isNil ifFalse: [
@@ -228,9 +508,9 @@ callouts
     callouts isNil ifTrue: [ callouts := Set new ].
     ^callouts!
 
-baseDirs: baseDirs
+baseDirectories: baseDirectories
     "Resolve the names in the package according to the base directories
-     in baseDirs, which depend on where the packages.xml is found:
+     in baseDirectories, which depend on where the packages.xml is found:
      the three possible places are 1) the system kernel directory's parent
      directory, 2) the local kernel directory's parent directory, 3) the
      local image directory (in order of decreasing priority).
@@ -241,13 +521,13 @@ baseDirs: baseDirs
      directories 2 and 3 are searched.  For a packages.xml directory in
      the local image directory, instead, only directory 3 is searched."
 
-    files := self findBaseDirs: baseDirs for: self files.
-    fileIns := self findBaseDirs: baseDirs for: self fileIns.
-    builtFiles := self findBaseDirs: baseDirs for: self builtFiles.
+    files := self findBaseDirs: baseDirectories for: self files.
+    fileIns := self findBaseDirs: baseDirectories for: self fileIns.
+    builtFiles := self findBaseDirs: baseDirectories for: self builtFiles.
 
     files isNil | fileIns isNil | builtFiles isNil ifTrue: [ ^false ].
 
-    baseDirs
+    baseDirectories
        do: [ :dir || name |
             name := Directory append: self directory to: dir.
             (Directory exists: name) ifTrue: [ directory := name. ^true ] ].
@@ -255,21 +535,21 @@ baseDirs: baseDirs
     ^false
 !
 
-findBaseDirs: baseDirs for: aCollection
+findBaseDirs: baseDirectories for: aCollection
     "Resolve the names in aCollection according to the base directories
-     in baseDirs, and return the collection with the full filenames, or
+     in baseDirectories, and return the collection with the full filenames, or
      nil if no directory was found for one or more file in aCollection."
     ^aCollection collect: [ :fileName || name |
-        name := self findBaseDirs: baseDirs forFile: fileName.
+        name := self findBaseDirs: baseDirectories forFile: fileName.
         name isNil ifTrue: [ ^nil ] ifFalse: [ name ]]
 !
 
-findBaseDirs: baseDirs forFile: fileName
+findBaseDirs: baseDirectories forFile: fileName
     "Try appending 'self directory' and fileName to each of the directory
-     in baseDirs, and return the path to the first tried filename that exists.
-     Return nil if no directory is found that contains the file."
+     in baseDirectories, and return the path to the first tried filename that
+     exists.  Return nil if no directory is found that contains the file."
     | name |
-    baseDirs do: [ :dir |
+    baseDirectories do: [ :dir |
        name := Directory append: self directory to: dir.
        name := Directory append: fileName to: name.
        (File exists: name) ifTrue: [ ^name ] ].
@@ -303,7 +583,7 @@ primFileIn
      dependencies and C callout availability"
     | dir namespace |
 
-    (Smalltalk hasFeatures: self name asSymbol) ifTrue: [ ^self ].
+    (Smalltalk hasFeatures: self name) ifTrue: [ ^self ].
     OutputVerbosity > 0 ifTrue: [
         Transcript
            nextPutAll: 'Loading package ', self name;
@@ -325,75 +605,75 @@ primFileIn
     self fileIns do: [ :each | FileStream fileIn: each ].
     Directory working: dir.
     Namespace current: namespace.
-    Smalltalk addFeature: self name asSymbol.
-    self features do: [ :each | Smalltalk addFeature: each asSymbol ].
+    Smalltalk addFeature: self name.
+    self features do: [ :each | Smalltalk addFeature: each ].
 ! !
 
 !PackageLoader class methodsFor: 'accessing'!
 
 packageAt: package
     "Answer a Package object for the given package"
-    self refreshDependencies.
-    ^packages at: package asString
+    self refresh.
+    ^root at: package asString
 !
 
 directoryFor: package
     "Answer a complete path to the given package's files"
-    ^(self packageAt: package) directory.
+    ^(self packageAt: package) directory
 !
 
 builtFilesFor: package
     "Answer a Set of Strings containing the filenames of the given package's
      machine-generated files (relative to the directory answered by
      #directoryFor:)"
-    ^(self packageAt: package) builtFiles.
+    ^(self packageAt: package) builtFiles
 !
 
 filesFor: package
     "Answer a Set of Strings containing the filenames of the given package's
      files (relative to the directory answered by #directoryFor:)"
-    ^(self packageAt: package) files.
+    ^(self packageAt: package) files
 !
 
 fileInsFor: package
     "Answer a Set of Strings containing the filenames of the given package's
      file-ins (relative to the directory answered by #directoryFor:)"
-    ^(self packageAt: package) fileIns.
+    ^(self packageAt: package) fileIns
 !
 
 sunitScriptFor: package
     "Answer a Strings containing a SUnit script that describes the package's
      test suite."
-    ^(self packageAt: package) sunitScript.
+    ^(self packageAt: package) sunitScript
 !
 
 calloutsFor: package
     "Answer a Set of Strings containing the filenames of the given package's
      required callouts (relative to the directory answered by #directoryFor:)"
-    ^(self packageAt: package) callouts.
+    ^(self packageAt: package) callouts
 !
 
 librariesFor: package
     "Answer a Set of Strings containing the filenames of the given package's
      libraries (relative to the directory answered by #directoryFor:)"
-    ^(self packageAt: package) libraries.
+    ^(self packageAt: package) libraries
 !
 
 modulesFor: package
     "Answer a Set of Strings containing the filenames of the given package's
      modules (relative to the directory answered by #directoryFor:)"
-    ^(self packageAt: package) modules.
+    ^(self packageAt: package) modules
 !
 
 featuresFor: package
     "Answer a Set of Strings containing the features provided by the given
      package."
-    ^(self packageAt: package) features.
+    ^(self packageAt: package) features
 !
 
 prerequisitesFor: package
     "Answer a Set of Strings containing the prerequisites for the given 
package"
-    ^(self packageAt: package) prerequisites.
+    ^(self packageAt: package) prerequisites
 !
 
 ignoreCallouts
@@ -409,10 +689,11 @@ ignoreCallouts: aBoolean
 
 flush
     "Set to reload the `packages.xml' file the next time it is needed."
-    loadDate := nil
+    loadDate := nil.
+    root := nil
 !
 
-refreshDependencies
+refresh
     "Reload the `packages.xml' file in the image and kernel directories.
      The three possible places are 1) the kernel directory's parent
      directory, 2) the `.st' subdirectory of the user's home directory, 3) the
@@ -425,74 +706,26 @@ refreshDependencies
      finally, only directory 3 is searched."
     | state |
     loadDate isNil ifFalse: [
-       self stillValid ifTrue: [ ^self ]
+       (root shouldReload: loadDate) ifFalse: [ ^self ]
     ].
 
     loadDate := Date dateAndTimeNow.
-    packages := LookupTable new.
-    self
-       processPackageFile: self packageFileName
-       baseDirectories: { Directory userBase.  Directory kernel, '/..' }.
-    self
-       processPackageFile: self userPackageFileName
-       baseDirectories: { Directory userBase }.
-    self
-       processPackageFile: self localPackageFileName
-       baseDirectories: #().
+    root := Kernel.PackageDirectories new.
+    root add: (Kernel.PackageDirectory
+                 on: self packageFileName 
+                 baseDirectories: { Directory userBase.  Directory kernel, 
'/..' }).
+    root add: (Kernel.PackageDirectory
+                 on: self userPackageFileName 
+                 baseDirectories: { Directory userBase.  }).
+    root add: (Kernel.PackageDirectory
+                 on: self localPackageFileName 
+                 baseDirectories: #()).
+    root refresh
 ! !
 
 
 !PackageLoader class methodsFor: 'loading'!
 
-extractDependenciesFor: packagesList onError: aBlock
-    "Answer an OrderedCollection containing all the packages which you
-     have to load to enable the packages in packagesList, in an appropriate
-     order. For example
-
-     PackageLoader extractDependenciesFor: #('BloxTestSuite' 'Blox' 'Browser')
-
-     on a newly built image will evaluate to an OrderedCollection containing
-     'Kernel', 'Blox', 'BloxTestSuite' and 'Browser'. Note that
-     Blox has been moved before BloxTestSuite.
-     Pass an error message to aBlock if one or more packages need
-     prerequisites which are not available."
-
-    | toBeLoaded featuresFound dependencies allPrereq allFeatures |
-    toBeLoaded := packagesList asOrderedCollection.
-    featuresFound := Set withAll: Smalltalk.Features.
-    dependencies := packagesList.
-    [
-       allPrereq := Set new.
-       allFeatures := Set new.
-       dependencies do: [ :each |
-           (featuresFound includes: each asSymbol) ifFalse: [
-               (self isLoadable: each)
-                   ifFalse: [ ^aBlock value: 'package not available: ', each ].
-               allPrereq addAll: (self prerequisitesFor: each).
-               allFeatures addAll: (self featuresFor: each)
-           ]
-       ].
-
-       "I don't think there will never be lots of packages in newDep (say
-        (more than 5), so I think it is acceptable to remove duplicates
-        this naive way.
-        Note that we remove duplicates from toBeLoaded so that prerequisites
-        are always loaded *before*."
-       toBeLoaded removeAll: allPrereq ifAbsent: [ :doesNotMatter | ].
-       toBeLoaded removeAll: allFeatures ifAbsent: [ :doesNotMatter | ].
-
-       allPrereq removeAll: allFeatures ifAbsent: [ :doesNotMatter | ].
-       featuresFound addAll: allFeatures.
-       toBeLoaded addAllFirst: allPrereq.
-
-       "Proceed recursively with the prerequisites for allPrereq"
-       dependencies := allPrereq.
-       dependencies notEmpty
-    ] whileTrue.
-
-    ^toBeLoaded
-!
-
 fileInPackage: package
     "File in the given package into GNU Smalltalk."
     self fileInPackages: {package}
@@ -501,9 +734,10 @@ fileInPackage: package
 fileInPackages: packagesList
     "File in all the packages in packagesList into GNU Smalltalk."
     | toBeLoaded |
-    toBeLoaded := self
+    self refresh.
+    toBeLoaded := root
        extractDependenciesFor: packagesList
-       onError: [ :errorMessage | ^self error: errorMessage ].
+       ifMissing: [ :name | ^self error: 'package not available: ', name ].
        
     toBeLoaded do: [ :each | (self packageAt: each) primFileIn ]
 ! !
@@ -515,21 +749,17 @@ canLoad: package
     "Answer whether all the needed pre-requisites for package are available."
     self
        extractDependenciesFor: {package}
-       onError: [ :errorMessage | ^false ].
+       ifMissing: [ :name | ^false ].
     ^true
 ! !
 
 
 !PackageLoader class methodsFor: 'private'!
 
-hasCallout: feature
-    "Private - Answer whether the given callout is present in GNU Smalltalk"
-!
-
 isLoadable: feature
     "Private - Answer whether the packages file includes an entry for 
`feature'"
-    self refreshDependencies.
-    ^packages includesKey: feature asString
+    self refresh.
+    ^root includesKey: feature asString
 ! !
 
 
@@ -547,100 +777,20 @@ localPackageFileName
     ^Directory image, '/packages.xml'
 !
 
-printXmlOn: aStream
-    "Print the XML source code for the information that the PackageLoader
-     holds on aStream."
-    aStream nextPutAll: '<packages>'.
-    packages keys asSortedCollection do: [ :each |
-       (self packageAt: each) printOn: aStream.
-    ].
-    aStream nextPutAll: '</packages>'
-!
-
 rebuildPackageFile
     "Recreate the XML file from the information that the PackageLoader
      holds.  This is a dangerous method, also because the PackageLoader
      does not know about disabled packages."
     | file |
-    [
-       file := FileStream
-           open: Directory image, '/packages.xml'
-           mode: FileStream write.
+    self refresh.
+    file := FileStream
+       open: Directory image, '/packages.xml'
+       mode: FileStream write.
 
+    [
        file nextPutAll: '<!-- GNU Smalltalk packages description file -->'.
        file nl; nl.
-        self printXmlOn: file
+        root printOn: file
     ] ensure: [ file close ]
-!
-
-processPackageFile: fileName baseDirectories: anArray
-    "Private - Process the XML source in the packages file, creating
-     Package objects along the way."
-
-    | cdata file stack ch tag package baseDirs |
-    baseDirs := Smalltalk imageLocal
-       ifTrue: [ { Directory image }, anArray ]
-       ifFalse: [ anArray ].
-    baseDirs isEmpty ifTrue: [ ^self ].
-
-    file := [ FileStream open: fileName mode: FileStream read ]
-       on: Error
-       do: [ :ex | ex return: nil ].
-
-    file isNil ifTrue: [ ^self ].
-    stack := OrderedCollection new.
-    [ cdata := cdata isNil
-       ifTrue: [ file upTo: $< ]
-       ifFalse: [ cdata, (file upTo: $<) ].
-
-       file atEnd ] whileFalse: [
-       ch := file peek.
-       ch == $! ifTrue: [ file skipTo: $> ].
-       ch == $/ ifTrue: [
-           tag := stack removeLast.
-           file next.
-           (file upTo: $>) = tag ifFalse: [
-               file close.
-               ^self error: 'error in packages file: unmatched end tag ', tag
-           ].
-
-           "I tried to put these from the most common to the least common"
-
-           tag = 'file' ifTrue: [ package files add: cdata ] ifFalse: [
-           tag = 'filein' ifTrue: [ package fileIns add: cdata ] ifFalse: [
-           tag = 'prereq' ifTrue: [ package prerequisites add: cdata ] 
ifFalse: [
-           tag = 'provides' ifTrue: [ package features add: cdata ] ifFalse: [
-           tag = 'module' ifTrue: [ package modules add: cdata ] ifFalse: [
-           tag = 'directory' ifTrue: [ package directory: cdata ] ifFalse: [
-           tag = 'name' ifTrue: [ package name: cdata ] ifFalse: [
-           tag = 'namespace' ifTrue: [ package namespace: cdata ] ifFalse: [
-           tag = 'library' ifTrue: [ package libraries add: cdata ] ifFalse: [
-           tag = 'package' ifTrue: [
-               (package baseDirs: baseDirs)
-                   ifTrue: [ packages at: package name put: package ]] 
ifFalse: [
-           tag = 'built-file' ifTrue: [ package builtFiles add: cdata ] 
ifFalse: [
-           tag = 'sunit' ifTrue: [ package sunitScripts add: cdata ] ifFalse: [
-           tag = 'callout' ifTrue: [ package callouts add: cdata ]]]]]]]]]]]]].
-           cdata := nil.
-       ].
-       ch isAlphaNumeric ifTrue: [
-           stack addLast: (tag := file upTo: $>).
-           tag = 'package' ifTrue: [ package := Package new ].
-           tag = 'disabled-package' ifTrue: [ package := Package new ].
-           cdata := nil
-       ].
-    ].
-    file close.
-    stack isEmpty ifFalse: [
-       self error: 'error in packages file: unmatched start tags', stack 
asArray printString
-    ].
-!
-
-stillValid
-    ^{ self packageFileName. self userPackageFileName. self 
localPackageFileName } 
-       allSatisfy: [ :name || file |
-           file := File name: name.
-           file exists not or: [ file lastModifyTime < loadDate ]
-       ]
 ! !
 




reply via email to

[Prev in Thread] Current Thread [Next in Thread]