forked from CampSmalltalk/STIG
-
Notifications
You must be signed in to change notification settings - Fork 0
/
STIG.pst
3222 lines (2558 loc) · 92.8 KB
/
STIG.pst
1
<?xml version="1.0"?><st-source><!-- Name: STIGBundleName: STIGBundleStructure: a Store.BundleForParcelParcel: nilParcelName: STIGPrerequisiteParcels: #()Date: 5:14:58 PM September 23, 2016 --><time-stamp>From VisualWorks®, 8.2 of July 15, 2016 on September 23, 2016 at 5:14:58 PM</time-stamp><do-it>(Dialog confirm: 'You are filing-in a Parcel source file!\\While this is possible it will not have\the same effect as loading the parcel.\None of the Parcel''s prerequisites will\be loaded and none of its load actions\will be performed.\\Are you sure you want to file-in?' withCRs) ifFalse: [self error: 'Parcel file-in abandoned. Choose terminate or close.']</do-it><name-space><name>STIG</name><environment>Smalltalk</environment><private>false</private><imports> private Smalltalk.* </imports><category></category><attributes><package>STIG</package></attributes></name-space><class><name>DirectoryLayout</name><environment>STIG</environment><super>Core.Object</super><private>false</private><indexed-type>none</indexed-type><inst-vars>package root directoryCache </inst-vars><class-inst-vars></class-inst-vars><imports></imports><category></category><attributes><package>STIG</package></attributes></class><comment><class-id>STIG.DirectoryLayout</class-id><body>Defines a file structure representing a package on a disk including the facilities for reading and writing it.Instance Variables package <PackageModel> root <Filename> root of the repository directoryCache <Dictionary> caches visited directories</body></comment><class><name>Git</name><environment>STIG</environment><super>Core.Object</super><private>false</private><indexed-type>none</indexed-type><inst-vars>globalArgs </inst-vars><class-inst-vars></class-inst-vars><imports></imports><category></category><attributes><package>STIG-Tools</package></attributes></class><class><name>AbstractFromDisk</name><environment>STIG</environment><super>Core.Object</super><private>false</private><indexed-type>none</indexed-type><inst-vars>directory parent </inst-vars><class-inst-vars></class-inst-vars><imports></imports><category></category><attributes><package>STIG</package></attributes></class><class><name>PackageFromDisk</name><environment>STIG</environment><super>STIG.AbstractFromDisk</super><private>false</private><indexed-type>none</indexed-type><inst-vars>packageName propertyBlueprints namespaceBlueprints classBlueprints sharedVariableBlueprints methodBlueprints </inst-vars><class-inst-vars></class-inst-vars><imports></imports><category></category><attributes><package>STIG</package></attributes></class><class><name>BoundVariableFromDisk</name><environment>STIG</environment><super>STIG.AbstractFromDisk</super><private>false</private><indexed-type>none</indexed-type><inst-vars>name reference </inst-vars><class-inst-vars></class-inst-vars><imports></imports><category></category><attributes><package>STIG</package></attributes></class><class><name>PropertiesFromDisk</name><environment>STIG</environment><super>STIG.AbstractFromDisk</super><private>false</private><indexed-type>none</indexed-type><inst-vars></inst-vars><class-inst-vars></class-inst-vars><imports></imports><category></category><attributes><package>STIG</package></attributes></class><class><name>DeltaSets</name><environment>STIG</environment><super>Core.Object</super><private>false</private><indexed-type>none</indexed-type><inst-vars>fromClasses fromMethods fromShares fromProperties fromNamespaces toClasses toMethods toNamespaces toShares toProperties removals additions changes originals </inst-vars><class-inst-vars></class-inst-vars><imports></imports><category></category><attributes><package>STIG</package></attributes></class><class><name>CypressLayout</name><environment>STIG</environment><super>STIG.DirectoryLayout</super><private>false</private><indexed-type>none</indexed-type><inst-vars>classPaths definedClasses commentFile propertyFile version licenseFile copyrightLine </inst-vars><class-inst-vars>specials </class-inst-vars><imports></imports><category></category><attributes><package>STIG</package></attributes></class><comment><class-id>STIG.CypressLayout</class-id><body>Defines structure of a Cypress compatible repository.Instance Variables classPaths <Dictionary key: BindingReference value: (Array of: String)> maps classes/extensions to paths in the repository definedClasses <Array of: BindingReference> caches classes defined by this package commentFile <Object> undocumented propertyFile <Object> undocumented version <Object> undocumentedClass Instance Variables specials <Dictionary> maps binary selector characters to labelsShared Variables CommentFile <String> file name for comments (README) IgnoredNamespaces <Set of: Namespace> these namespaces are not emitted into json files IgnoredProperties <Array of: Symbol> these package properties are not emitted into the property files PropertyFile <String> file name for properties (properties.json)</body></comment><class><name>TravisLayout</name><environment>STIG</environment><super>STIG.DirectoryLayout</super><private>false</private><indexed-type>none</indexed-type><inst-vars></inst-vars><class-inst-vars></class-inst-vars><imports></imports><category></category><attributes><package>STIG</package></attributes></class><comment><class-id>STIG.TravisLayout</class-id><body>Travis' original layout</body></comment><class><name>JSON</name><environment>Smalltalk</environment><super>Core.Object</super><private>false</private><indexed-type>none</indexed-type><inst-vars>stream char </inst-vars><class-inst-vars></class-inst-vars><imports></imports><category></category><attributes><package>STIG-Json</package></attributes></class><shared-variable><name>LogTimes</name><environment>STIG.Git</environment><private>false</private><constant>false</constant><category>debugging</category><initializer>true</initializer><attributes><package>STIG-Tools</package></attributes></shared-variable><shared-variable><name>LogOutput</name><environment>STIG.Git</environment><private>false</private><constant>false</constant><category>debugging</category><initializer>true</initializer><attributes><package>STIG-Tools</package></attributes></shared-variable><shared-variable><name>IgnoredNamespaces</name><environment>STIG.CypressLayout</environment><private>false</private><constant>true</constant><category>constants</category><initializer>Array with: Smalltalk with: Core with: Kernel with: OS </initializer><attributes><package>STIG</package></attributes></shared-variable><shared-variable><name>PropertyFile</name><environment>STIG.CypressLayout</environment><private>false</private><constant>false</constant><category>constants</category><initializer>'properties.ston'</initializer><attributes><package>STIG</package></attributes></shared-variable><shared-variable><name>CommentFile</name><environment>STIG.CypressLayout</environment><private>false</private><constant>false</constant><category>constants</category><initializer>'README'</initializer><attributes><package>STIG</package></attributes></shared-variable><shared-variable><name>IgnoredProperties</name><environment>STIG.CypressLayout</environment><private>false</private><constant>true</constant><category>constants</category><initializer>#(STIGRoot packageName parcelName developmentPrerequisites deploymentPrerequisites prerequisiteDescriptions ignoredPrerequisites disregardedPrerequisites)</initializer><attributes><package>STIG</package></attributes></shared-variable><shared-variable><name>LicenseFile</name><environment>STIG.CypressLayout</environment><private>false</private><constant>false</constant><category>constants</category><initializer>'LICENSE'</initializer><attributes><package>STIG</package></attributes></shared-variable><shared-variable><name>DefaultLayout</name><environment>STIG</environment><private>false</private><constant>false</constant><category>constants</category><initializer>STIG.CypressLayout</initializer><attributes><package>STIG</package></attributes></shared-variable><shared-variable><name>CRswapLF</name><environment>STIG</environment><private>false</private><constant>false</constant><category>constants</category><initializer>| map | map := WordArray withAll: (0 to: 255). map at: 13 + 1 put: 10. map at: 10 + 1 put: 13. 16r80 to: 255 do: [:n | map at: n + 1 put: 255]. map</initializer><attributes><package>STIG</package></attributes></shared-variable><shared-variable><name>DefaultRoot</name><environment>STIG</environment><private>false</private><constant>false</constant><category>constants</category><initializer>'STIGRoot'</initializer><attributes><package>STIG</package></attributes></shared-variable><shared-variable><name>Whitespace</name><environment>JSON</environment><private>false</private><constant>true</constant><category>constants</category><initializer>String with: Character tab with: Character space with: Character cr</initializer><attributes><package>STIG-Json</package></attributes></shared-variable><methods><class-id>STIG.DirectoryLayout</class-id> <category>private-writing</category><body package="STIG">ensureDirectory: aDirectorySequence ^directoryCache at: aDirectorySequence ifAbsentPut: [| actualFilename | actualFilename := root asFilename. aDirectorySequence do: [:each | actualFilename := actualFilename trustedConstruct: (self sanitize: each)]. actualFilename ensureDirectory. actualFilename]</body><body package="STIG">needsMultiByte: aByteArray ^aByteArray includes: 255</body><body package="STIG">output: string to: fd (self outputSingleByteUTF8: string to: fd) ifFalse: [self outputMultiByteUTF8: string to: fd]</body><body package="STIG">outputMultiByteUTF8: string to: fd | buffer bufferIndex written | buffer := ByteArray new: 256 + 3. bufferIndex := 1. 1 to: string size do: [:n | | char | char := string at: n. written := char emitUTF8Into: buffer startingAt: bufferIndex. bufferIndex := bufferIndex + written. bufferIndex >= 256 ifTrue: [fd writeFrom: buffer startingAt: 1 for: bufferIndex - 1. bufferIndex := 1]]. bufferIndex > 1 ifTrue: [fd writeFrom: buffer startingAt: 1 for: bufferIndex - 1]</body><body package="STIG">outputSingleByteUTF8: string to: fd | bytes toWrite written | string class == ByteString ifFalse: [^false]. bytes := ByteArray new: string size. bytes replaceBytesFrom: 1 to: string size with: string startingAt: 1 map: CRswapLF. (self needsMultiByte: bytes) ifTrue: [^false]. toWrite := bytes size. written := 0. [written < toWrite] whileTrue: [| thisWrite | thisWrite := fd writeFrom: bytes startingAt: written + 1 for: toWrite - written. written := written + thisWrite]. ^true</body><body package="STIG">path: aDirectorySequence tail: aFiletail write: aBlock | actualFilename stream fd string | stream := (String new: 256) writeStream. aBlock value: stream. string := stream contents. actualFilename := self ensureDirectory: aDirectorySequence. actualFilename := actualFilename construct: (self sanitize: aFiletail). fd := IOAccessor defaultForFiles new initialize handle: (actualFilename primOpenDirection: 1 creation: 3). self output: string to: fd. fd primClose</body></methods><methods><class-id>STIG.DirectoryLayout</class-id> <category>accessing</category><body package="STIG">packageFromDisk: name ^(PackageFromDisk directory: self root / name) packageName: name; yourself</body><body package="STIG">root ^root</body></methods><methods><class-id>STIG.DirectoryLayout</class-id> <category>initialize-release</category><body package="STIG">initialize directoryCache := Dictionary new</body><body package="STIG">package: model root := model stigRoot asFilename. package := model</body></methods><methods><class-id>STIG.DirectoryLayout</class-id> <category>private</category><body package="STIG">cleanDirectory: aDirectory | fileList allRemoved | fileList := aDirectory directoryContents. allRemoved := true. fileList do: [:each | | filename | filename := aDirectory trustedConstruct: each. filename isDirectory ifTrue: [each = '.git' ifTrue: [allRemoved := false] ifFalse: [allRemoved := allRemoved & (self cleanDirectory: filename)]] ifFalse: [allRemoved := false]]. allRemoved ifTrue: [aDirectory delete]. ^allRemoved</body><body package="STIG">decodeImportsString: aString ^aString withCRs</body><body package="STIG">decodeSelector: aString ^aString last = $. ifTrue: [aString collect: [:each | each = $. ifTrue: [$:] ifFalse: [each]]] ifFalse: [aString first isAlphabetic ifTrue: [aString] ifFalse: [String withAll: ((aString runsSatisfying: #isDigit) collect: [:each | Character codePoint: each asNumber])]]</body><body package="STIG">deltaSetsFrom: aPackage to: disk ^(DeltaSets from: aPackage to: disk) compute</body><body package="STIG">encodeImportsString: aBlueprint ^aBlueprint importsString collect: [:each | each = Character cr ifTrue: [$\] ifFalse: [each]]</body><body package="STIG">encodeSelector: aSymbol ^aSymbol last = $: ifTrue: [aSymbol collect: [:each | each = $: ifTrue: [$.] ifFalse: [each]]] ifFalse: [aSymbol first isAlphabetic ifTrue: [aSymbol] ifFalse: [| output | output := String new writeStream. aSymbol do: [:each | each codePoint printOn: output] separatedBy: [output nextPut: $_]. output contents]]</body><body package="STIG">sanitize: aString ^aString</body><body package="STIG">shortReferencePath: aBindingReference | sequence | sequence := aBindingReference path. ^(sequence beginsWith: #(#Root #Smalltalk)) ifTrue: [sequence allButFirst: 2] ifFalse: [sequence]</body></methods><methods><class-id>STIG.DirectoryLayout</class-id> <category>saving</category><body package="STIG">save: aBlueprint aBlueprint saveToDisk: self</body><body package="STIG">saveAll: aCollection aCollection do: [:each | self save: each]</body><body package="STIG">saveDeltas: deltas directory: fromDisk self saveAll: deltas additions; saveAll: deltas changes. deltas removals do: [:each | each original delete]. self cleanDirectory: fromDisk directory</body><body package="STIG">savePackage: aPackage</body></methods><methods><class-id>STIG.DirectoryLayout class</class-id> <category>instance creation</category><body package="STIG">for: package | layout | layout := DefaultLayout. (package stigRoot asFilename / 'properties.ston') exists ifTrue: [ layout := CypressLayout ]. ^layout new package: package; yourself</body><body package="STIG">new "Answer a newly created and initialized instance." ^super new initialize</body></methods><methods><class-id>STIG.Git</class-id> <category>commands</category><body package="STIG-Tools">addAll self run: #('add' '-A')</body><body package="STIG-Tools">commitAll: aMessage self run: (#('commit' '-a' '--allow-empty-message' '-m') copyWith: aMessage)</body><body package="STIG-Tools">init self run: #('init')</body></methods><methods><class-id>STIG.Git</class-id> <category>private</category><body package="STIG-Tools">packageName ^globalArgs last allButFirst: ('--work-tree=' , DefaultRoot) size + 1</body><body package="STIG-Tools">run: anArgumentArray | time result process exitCode | LogTimes ifTrue: [Transcript cr; show: anArgumentArray first , ': ' , self packageName , '...']. process := ExternalProcess defaultClass new. time := [result := process fork: 'git' arguments: globalArgs , anArgumentArray] timeToRun. LogTimes ifTrue: [Transcript print: time; endEntry]. LogOutput ifTrue: [result trimSeparators isEmpty ifFalse: [Transcript cr; show: result trimSeparators]]. (exitCode := process exitStatus) isZero ifFalse: [self error: exitCode printString , ' - Git error: ' , result]</body></methods><methods><class-id>STIG.Git</class-id> <category>initialize-release</category><body package="STIG-Tools">setPackage: aPackage globalArgs := Array with: '--git-dir=' , (aPackage stigRoot asFilename / aPackage name / '.git') asString with: '--work-tree=' , (aPackage stigRoot asFilename / aPackage name) asString</body></methods><methods><class-id>STIG.Git class</class-id> <category>instance creation</category><body package="STIG-Tools">for: aPackage ^self new setPackage: aPackage</body></methods><methods><class-id>STIG.AbstractFromDisk</class-id> <category>accessing</category><body package="STIG">addBlueprint: aBlueprint parent addBlueprint: aBlueprint</body><body package="STIG">directory ^directory</body><body package="STIG">directory: anObject directory := anObject</body><body package="STIG">directory: tail contentsDo: aBlock | dir | (dir := directory / tail) exists ifFalse: [^self]. dir directoryContents do: [:each | aBlock value: (dir trustedConstruct: each) value: each]</body><body package="STIG">directoryContentsDo: aBlock directory directoryContents do: [:each | aBlock value: (directory trustedConstruct: each) value: each]</body><body package="STIG">packageName ^parent packageName</body><body package="STIG">parent ^parent</body><body package="STIG">parent: anObject parent := anObject</body><body package="STIG">read: layout self subclassResponsibility</body></methods><methods><class-id>STIG.AbstractFromDisk</class-id> <category>private</category><body package="STIG">fileContents: aFile | bytes fd size buffer output totalRead | fd := IOAccessor defaultForFiles new initialize handle: (aFile primOpenDirection: 0 creation: 0). [size := fd fileSize. buffer := ByteArray new: 256. output := ByteArray new writeStream. totalRead := 0. [totalRead < size] whileTrue: [| thisRead | thisRead := fd readInto: buffer startingAt: 1 for: 256. totalRead := totalRead + thisRead. output next: thisRead putAll: buffer startingAt: 1]] ensure: [fd primClose]. bytes := output contents. ^self translateUTF8Bytes: bytes</body><body package="STIG">makeReference: aSequence ^BindingReference path: ((aSequence beginsWith: #('Root' 'Smalltalk')) ifFalse: [#('Root' 'Smalltalk') , aSequence] ifTrue: [aSequence])</body><body package="STIG">translateMultiByteUTF8: aByteArray | output index size firstByte | output := String new writeStream. index := 1. size := aByteArray size. [index <= size] whileTrue: [firstByte := aByteArray at: index. firstByte < 2r10000000 ifTrue: [output nextPut: (firstByte = 10 ifTrue: [13] ifFalse: [firstByte = 13 ifTrue: [10] ifFalse: [firstByte]]) asCharacter. index := index + 1] ifFalse: [firstByte < 2r11000000 ifTrue: [output nextPut: ((firstByte bitAnd: 2r00011111) * 64 + ((aByteArray at: index + 1) bitAnd: 2r00111111)) asCharacter. index := index + 2] ifFalse: [firstByte < 2r11100000 ifTrue: [output nextPut: (((firstByte bitAnd: 2r00001111) * 64 + ((aByteArray at: index + 1) bitAnd: 2r00111111)) * 64 + ((aByteArray at: index + 2) bitAnd: 2r00111111)) asCharacter. index := index + 3] ifFalse: [output nextPut: ((((firstByte bitAnd: 2r00000111) * 64 + ((aByteArray at: index + 1) bitAnd: 2r00111111)) * 64 + ((aByteArray at: index + 2) bitAnd: 2r00111111)) * 64 + ((aByteArray at: index + 3) bitAnd: 2r00111111)) asCharacter. index := index + 3]]]]. ^output contents</body><body package="STIG">translateSingleByteUTF8: aByteArray | translated | translated := ByteArray new: aByteArray size. translated replaceBytesFrom: 1 to: aByteArray size with: aByteArray startingAt: 1 map: CRswapLF. ^(translated includes: 255) ifTrue: [nil] ifFalse: [translated changeClassTo: ByteString]</body><body package="STIG">translateUTF8Bytes: aByteArray ^(self translateSingleByteUTF8: aByteArray) ifNil: [ (aByteArray withEncoding: #utf8) readStream setLineEndConventionFromContents; upToEnd ]</body></methods><methods><class-id>STIG.AbstractFromDisk</class-id> <category>initialize-release</category><body package="STIG">name: aString "subclasses can do more"</body><body package="STIG">parent: aParent directory: aDirectory name: aString self parent: aParent; directory: aDirectory; name: aString</body></methods><methods><class-id>STIG.AbstractFromDisk class</class-id> <category>instance creation</category><body package="STIG">new ^super new initialize</body><body package="STIG">parent: aFromDisk directory: aDirectory name: aName ^self new parent: aFromDisk directory: aDirectory name: aName</body></methods><methods><class-id>STIG.PackageFromDisk</class-id> <category>accessing</category><body package="STIG">addBlueprint: aBlueprint aBlueprint packageName: self packageName. aBlueprint fromDiskAddTo: self</body><body package="STIG">addClassBlueprint: aClassBlueprint classBlueprints addLast: aClassBlueprint</body><body package="STIG">addMethodBlueprint: aMethodBlueprint methodBlueprints addLast: aMethodBlueprint</body><body package="STIG">addNamespaceBlueprint: aNamespaceBlueprint namespaceBlueprints addLast: aNamespaceBlueprint</body><body package="STIG">addPropertyBlueprint: aPropertyBlueprint propertyBlueprints addLast: aPropertyBlueprint</body><body package="STIG">addSharedVariableBlueprint: aSharedVariableBlueprint sharedVariableBlueprints addLast: aSharedVariableBlueprint</body><body package="STIG">blueprints ^propertyBlueprints , namespaceBlueprints , classBlueprints , sharedVariableBlueprints , methodBlueprints</body><body package="STIG">classBlueprints ^classBlueprints</body><body package="STIG">directory: anObject directory := anObject asFilename</body><body package="STIG">methodBlueprints ^methodBlueprints</body><body package="STIG">namespaceBlueprints ^namespaceBlueprints</body><body package="STIG">packageName ^packageName</body><body package="STIG">packageName: anObject packageName := anObject</body><body package="STIG">path "Recursion stopper" ^Array new</body><body package="STIG">propertyBlueprints ^propertyBlueprints</body><body package="STIG">read: layout ^layout readPackage: self</body><body package="STIG">sharedVariableBlueprints ^sharedVariableBlueprints</body></methods><methods><class-id>STIG.PackageFromDisk</class-id> <category>initialize-release</category><body package="STIG">initialize super initialize. propertyBlueprints := OrderedCollection new. namespaceBlueprints := OrderedCollection new. classBlueprints := OrderedCollection new. sharedVariableBlueprints := OrderedCollection new. methodBlueprints := OrderedCollection new</body></methods><methods><class-id>STIG.PackageFromDisk</class-id> <category>image-updating</category><body package="STIG">imagePackage ^(Store.Registry packageNamed: self packageName) ifNil: [Store.PackageModel named: packageName]</body><body package="STIG">updateImage self imagePackage stigFromDisk: self</body></methods><methods><class-id>STIG.PackageFromDisk class</class-id> <category>instance creation</category><body package="STIG">directory: filename ^self new directory: filename</body></methods><methods><class-id>STIG.BoundVariableFromDisk</class-id> <category>accessing</category><body package="STIG">name ^name</body><body package="STIG">name: anObject name := anObject</body><body package="STIG">read: layout layout readBoundVariable: self</body></methods><methods><class-id>STIG.BoundVariableFromDisk</class-id> <category>private</category><body package="STIG">path ^parent path copyWith: name</body><body package="STIG">reference ^reference ifNil: [reference := self makeReference: self path]</body><body package="STIG">reference: aBindingReference reference := aBindingReference</body></methods><methods><class-id>STIG.BoundVariableFromDisk</class-id> <category>printing</category><body package="STIG">printOn: stream stream nextPutAll: 'Bound Variable: '; print: reference</body></methods><methods><class-id>STIG.PropertiesFromDisk</class-id> <category>accessing</category><body package="STIG">read: layout layout readProperties: self</body></methods><methods><class-id>STIG.DeltaSets</class-id> <category>accessing</category><body package="STIG">additions ^additions</body><body package="STIG">changes ^changes</body><body package="STIG">fromClasses ^fromClasses</body><body package="STIG">fromClasses: anObject fromClasses := anObject</body><body package="STIG">fromMethods ^fromMethods</body><body package="STIG">fromMethods: anObject fromMethods := anObject</body><body package="STIG">fromNamespaces ^fromNamespaces</body><body package="STIG">fromNamespaces: anObject fromNamespaces := anObject</body><body package="STIG">fromProperties ^fromProperties</body><body package="STIG">fromProperties: anObject fromProperties := anObject</body><body package="STIG">fromShares ^fromShares</body><body package="STIG">fromShares: anObject fromShares := anObject</body><body package="STIG">originals ^originals</body><body package="STIG">removals ^removals</body><body package="STIG">toClasses ^toClasses</body><body package="STIG">toClasses: anObject toClasses := anObject</body><body package="STIG">toMethods ^toMethods</body><body package="STIG">toMethods: anObject toMethods := anObject</body><body package="STIG">toNamespaces ^toNamespaces</body><body package="STIG">toNamespaces: anObject toNamespaces := anObject</body><body package="STIG">toProperties ^toProperties</body><body package="STIG">toProperties: anObject toProperties := anObject</body><body package="STIG">toShares ^toShares</body><body package="STIG">toShares: anObject toShares := anObject</body></methods><methods><class-id>STIG.DeltaSets</class-id> <category>private</category><body package="STIG">addBlueprints: aSequence to: aBlueprintCollection aSequence isEmpty ifTrue: [^self]. aBlueprintCollection addAllLast: (aSequence any class sortForDoingImageUpdates: aSequence)</body><body package="STIG">compareFromBlueprints: fromBlueprints toBlueprints: toBlueprints | diffs toStack fromStack localRemoved localChanged localAdded fromAgain toAgain localOriginals | toBlueprints sort. fromBlueprints sort. diffs := (SequenceableCollectionDifferences new) comparisonFunction: [:a :b | a refersToSameObject: b]; differencesFrom: fromBlueprints to: toBlueprints. fromStack := OrderedCollection withAll: fromBlueprints. toStack := OrderedCollection withAll: toBlueprints. localRemoved := OrderedCollection new. localChanged := OrderedCollection new. localAdded := OrderedCollection new. localOriginals := OrderedCollection new. fromAgain := OrderedCollection new. toAgain := OrderedCollection new. diffs do: [:eachSubsequence | eachSubsequence isDelete ifTrue: [localRemoved addAll: (fromStack removeFirst: eachSubsequence length)] ifFalse: [eachSubsequence isInsert ifTrue: [localAdded addAll: (toStack removeFirst: eachSubsequence length)] ifFalse: [toAgain addAll: (toStack removeFirst: eachSubsequence length). fromAgain addAll: (fromStack removeFirst: eachSubsequence length)]]]. (fromAgain differences: toAgain) do: [:each | each isInsert ifTrue: [localChanged addAll: each] ifFalse: [each isDelete ifTrue: [localOriginals addAll: each]]]. self addBlueprints: localRemoved to: removals. self addBlueprints: localAdded to: additions. self addBlueprints: localOriginals to: originals. self addBlueprints: localChanged to: changes</body><body package="STIG">compute additions := OrderedCollection new. removals := OrderedCollection new. changes := OrderedCollection new. originals := OrderedCollection new. self compareFromBlueprints: fromProperties toBlueprints: toProperties. self compareFromBlueprints: fromNamespaces toBlueprints: toNamespaces. self compareFromBlueprints: fromClasses toBlueprints: toClasses. self compareFromBlueprints: fromShares toBlueprints: toShares. self compareFromBlueprints: fromMethods toBlueprints: toMethods</body><body package="STIG">trimProperties: ignored toProperties := toProperties reject: [ :each | ignored includes: each key ]. fromProperties := fromProperties reject: [ :each | ignored includes: each key ].</body></methods><methods><class-id>STIG.DeltaSets</class-id> <category>initialize-release</category><body package="STIG">fromSource: aBlueprintProvider self fromProperties: aBlueprintProvider propertyBlueprints. self fromNamespaces: aBlueprintProvider namespaceBlueprints. self fromClasses: aBlueprintProvider classBlueprints. self fromShares: aBlueprintProvider sharedVariableBlueprints. self fromMethods: aBlueprintProvider methodBlueprints</body><body package="STIG">initialize super initialize. fromClasses := Array new. fromMethods := Array new. fromShares := Array new. fromProperties := Array new. fromNamespaces := Array new. toClasses := Array new. toMethods := Array new. toNamespaces := Array new. toShares := Array new. toProperties := Array new</body><body package="STIG">toSource: aBlueprintProvider self toProperties: aBlueprintProvider propertyBlueprints. self toNamespaces: aBlueprintProvider namespaceBlueprints. self toClasses: aBlueprintProvider classBlueprints. self toShares: aBlueprintProvider sharedVariableBlueprints. self toMethods: aBlueprintProvider methodBlueprints</body></methods><methods><class-id>STIG.DeltaSets</class-id> <category>API</category><body package="STIG">buildCompositeChange | composite | composite := Refactory.Browser.CompositeRefactoryChange new. additions do: [:each | each emitAdditionChangesTo: composite]. changes with: originals do: [:eachChange :eachOriginal | eachChange emitModificationChangesTo: composite relativeTo: eachOriginal]. removals reverseDo: [:each | each emitRemovalChangesTo: composite]. ^composite</body><body package="STIG">hasPackagePropertyChanges ^additions, removals, changes anySatisfy: [ :change | (change isKindOf: CodeComponentPropertyBlueprint) and: [ change key ~= #comment ] ]</body></methods><methods><class-id>STIG.DeltaSets</class-id> <category>printing</category><body package="STIG">printOn: aStream aStream nextPut: $+; print: additions size; nextPutAll: ' / '; nextPut: $*; print: changes size; nextPutAll: ' / '; nextPut: $-; print: removals size</body></methods><methods><class-id>STIG.DeltaSets class</class-id> <category>instance creation</category><body package="STIG">from: aFromProvider to: aToProvider ^(self new) fromSource: aFromProvider; toSource: aToProvider; yourself</body><body package="STIG">new "Answer a newly created and initialized instance." ^super new initialize</body></methods><methods><class-id>STIG.CypressLayout</class-id> <category>private-writing</category><body package="STIG">path: aDirectorySequence tail: aFiletail write: aBlock | actualFilename stream fd string | stream := (String new: 256) writeStream. aBlock value: stream. string := stream contents. actualFilename := self ensureDirectory: aDirectorySequence. actualFilename := actualFilename construct: (self sanitize: aFiletail). fd := IOAccessor defaultForFiles new initialize handle: (actualFilename primOpenDirection: 1 creation: 3). self output: string to: fd. fd primClose</body></methods><methods><class-id>STIG.CypressLayout</class-id> <category>loading</category><body package="STIG">readBoundVariable: variable variable directoryContentsDo: [:eachFile :eachTail | (eachFile isDirectory or: [eachTail = self commentFile or: [eachTail = self licenseFile]]) ifFalse: [eachTail = self propertyFile ifTrue: [(variable name endsWith: '.pool') ifTrue: [self readNamespace: eachFile using: variable] ifFalse: [self readClass: eachFile using: variable]] ifFalse: [(eachTail endsWith: '.json') ifTrue: [self readSharedVariable: eachFile using: variable] ifFalse: ["Ignore unrecognized files" ]]]]. variable directory: 'class' contentsDo: [:file :tail | file extension = '.st' ifTrue: [self readMethod: file tail: tail instance: false using: variable]]. variable directory: 'instance' contentsDo: [:file :tail | file extension = '.st' ifTrue: [self readMethod: file tail: tail instance: true using: variable]]. ^variable</body><body package="STIG">readClass: aFilename using: fromDisk | blueprint properties file superref reference | properties := JSON read: (fromDisk fileContents: aFilename) readStream. reference := self makeReference: properties. fromDisk reference: reference. (fromDisk name endsWith: '.extension') ifTrue: [^self]. blueprint := ClassBlueprint new. blueprint original: aFilename. blueprint reference: reference. blueprint importsString: (self decodeImportsString: (properties at: '_vw_imports' ifAbsent: [''])). blueprint isPrivate: (properties at: '_vw_private' ifAbsent: [ false ]). blueprint instanceVariables: (properties at: 'instvars' ifAbsent: [Array new]). blueprint classInstanceVariables: (properties at: 'classinstvars' ifAbsent: [Array new]). blueprint attributes: (properties at: '_vw_attributes' ifAbsent: [ Array new ]). blueprint behaviorType: (properties at: '_vw_type' ifAbsent: [ #none ]) asSymbol. superref := ((properties at: 'superNamespace' ifAbsent: [nil]) ifNil: [''] ifNotNil: [ :ns | ns, '.' ]), (properties at: 'super'). blueprint superclassReference: (Compiler evaluate: superref) fullName asQualifiedReference makeUnambiguous. blueprint comment: ((file := aFilename directory / self commentFile) exists ifTrue: [fromDisk fileContents: file] ifFalse: ['']). fromDisk addBlueprint: blueprint. ^fromDisk</body><body package="STIG">readComment: aFilename using: fromDisk | blueprint | blueprint := CodeComponentPropertyBlueprint new. blueprint key: #comment. blueprint original: aFilename. blueprint value: (fromDisk fileContents: aFilename). fromDisk addBlueprint: blueprint. ^fromDisk</body><body package="STIG">readLicense: aFilename using: fromDisk | blueprint | blueprint := CodeComponentPropertyBlueprint new. blueprint key: #notice. blueprint original: aFilename. blueprint value: (fromDisk fileContents: aFilename). fromDisk addBlueprint: blueprint. ^fromDisk</body><body package="STIG">readMethod: aFilename tail: aTail instance: isInstance using: fromDisk | blueprint selector source | selector := aTail allButLast: 3. source := (fromDisk fileContents: aFilename) readStream. blueprint := MethodBlueprint of: aFilename. blueprint isInstanceBehavior: isInstance. blueprint classReference: fromDisk reference. blueprint selector: (self decodeSelector: selector) asSymbol. (source upTo: Character cr) = '"' ifFalse: [ self error: 'method file format error!' ]. (source upTo: Character space) = 'notice:' ifFalse: [ self error: 'method file format error!' ]. source upTo: Character cr. (source upTo: Character space) = 'category:' ifFalse: [ self error: 'method file format error!' ]. blueprint category: (source upTo: Character cr). (source upTo: Character cr) = '"' ifFalse: [ self error: 'method file format error!' ]. blueprint source: source upToEnd. fromDisk addBlueprint: blueprint. ^fromDisk</body><body package="STIG">readNamespace: aFilename using: fromDisk | blueprint properties file reference | properties := JSON read: (fromDisk fileContents: aFilename) readStream. reference := self makeReference: properties. fromDisk reference: reference. blueprint := NamespaceBlueprint new. blueprint original: aFilename. blueprint reference: reference. blueprint importsString: (self decodeImportsString: (properties at: 'imports' ifAbsent: [''])). blueprint isPrivate: (properties at: 'private' ifAbsent: [ false ]). blueprint comment: ((file := aFilename directory / self commentFile) exists ifTrue: [fromDisk fileContents: file] ifFalse: ['']). fromDisk addBlueprint: blueprint. ^fromDisk</body><body package="STIG">readPackage: aPackage aPackage directoryContentsDo: [:eachFile :eachTail | eachFile isDirectory ifTrue: [ (BoundVariableFromDisk parent: aPackage directory: eachFile name: eachTail) read: self ] ifFalse: [ eachTail = self commentFile ifTrue: [ self readComment: eachFile using: aPackage ]. eachTail = self licenseFile ifTrue: [ self readLicense: eachFile using: aPackage ]. eachTail = self propertyFile ifTrue: [ self readProperties: eachFile using: aPackage ] ] ]. ^aPackage</body><body package="STIG">readProperties: aFilename using: fromDisk | properties | properties := JSON read: (fromDisk fileContents: aFilename) readStream. properties keysAndValuesDo: [ :key :value || blueprint | blueprint := CodeComponentPropertyBlueprint new. blueprint key: key asSymbol. blueprint original: aFilename. blueprint value: value. fromDisk addBlueprint: blueprint]. ^fromDisk</body><body package="STIG">readSharedVariable: aFilename using: fromDisk | blueprint properties reference | properties := JSON read: (fromDisk fileContents: aFilename) readStream. reference := self makeReference: properties. blueprint := SharedVariableBlueprint new. blueprint original: aFilename. blueprint reference: reference. blueprint category: (properties at: 'category' ifAbsent: [ nil ]). blueprint isPrivate: (properties at: 'private' ifAbsent: [ false ]). blueprint isConstant: (properties at: 'constant' ifAbsent: [ false ]). blueprint initializer: (properties at: 'initializer' ifAbsent: [ nil ]). fromDisk addBlueprint: blueprint. ^fromDisk</body></methods><methods><class-id>STIG.CypressLayout</class-id> <category>accessing</category><body package="STIG">commentFile ^commentFile ifNil: [ commentFile := CommentFile ]</body><body package="STIG">licenseFile ^licenseFile ifNil: [ licenseFile := LicenseFile ]</body><body package="STIG">packageFromDisk: name ^(PackageFromDisk directory: self root / (name, '.package')) packageName: name; yourself</body><body package="STIG">propertyFile ^propertyFile ifNil: [ propertyFile := PropertyFile ]</body></methods><methods><class-id>STIG.CypressLayout</class-id> <category>saving</category><body package="STIG">saveClass: blueprint | path name properties ns class | name := blueprint reference name. class := blueprint reference value. path := (Array with: blueprint packageName, '.package' with: name, '.class'). blueprint comment size = 0 ifFalse: [ self path: path tail: self commentFile write: [ :ws | ws nextPutAll: blueprint comment] ]. properties := Dictionary new. properties at: 'name' put: name. (IgnoredNamespaces includes: (ns := blueprint reference environment)) ifFalse: [ properties at: 'namespace' put: ns fullName ]. blueprint superclassReference ifNotNil: [ properties at: 'super' put: blueprint superclassReference name. (IgnoredNamespaces includes: (ns := blueprint superclassReference environment)) ifFalse: [ properties at: 'superNamespace' put: ns fullName ] ]. blueprint behaviorType == #none ifFalse: [ properties at: '_vw_type' put: blueprint behaviorType ]. blueprint instanceVariables isEmpty ifFalse: [ properties at: 'instvars' put: blueprint instanceVariables ]. blueprint classInstanceVariables isEmpty ifFalse: [ properties at: 'classinstvars' put: blueprint classInstanceVariables ]. class classVariablesString isEmpty ifFalse: [ properties at: 'classvars' put: (class classVariablesString trimBlanks tokensBasedOn: $ ) asArray ]. blueprint importsString isEmpty ifFalse: [ properties at: '_vw_imports' put: (self encodeImportsString: blueprint) ]. blueprint isPrivate ifTrue: [ properties at: '_vw_private' put: blueprint isPrivate ]. blueprint attributes isEmpty ifFalse: [ properties at: '_vw_attributes' put: blueprint attributes ]. copyrightLine ifNotNil: [ properties at: '_cypress_copyright' put: copyrightLine ]. self path: path tail: self propertyFile write: [ :ws | properties jsonWriteOn: ws ]</body><body package="STIG">saveDeltas: deltas directory: fromDisk deltas hasPackagePropertyChanges ifTrue: [ self savePackage: fromDisk ]. definedClasses := deltas toClasses collect: [ :each | each reference ]. classPaths := Dictionary new. self saveAll: deltas additions. self saveAll: deltas changes. deltas removals do: [:each | each original delete]. self cleanDirectory: fromDisk directory</body><body package="STIG">saveMethod: blueprint | path tail reference classDirectory properties | reference := blueprint classReference. classDirectory := classPaths at: reference ifAbsentPut: [ | dir | dir := Array with: blueprint packageName, '.package'. (definedClasses includes: reference) ifTrue: [ dir := dir copyWith: reference name, '.class' ] ifFalse: [ dir := dir copyWith: reference name, '.extension'. properties := Dictionary new at: 'name' put: reference name; yourself. (IgnoredNamespaces includes: reference environment) ifFalse: [ properties at: 'namespace' put: reference environment fullName ]. self path: dir tail: self propertyFile write: [ :ws | properties jsonWriteOn: ws ]. dir ] ]. path := classDirectory copyWith: (blueprint isInstanceBehavior ifTrue: ['instance'] ifFalse: ['class']). tail := self encodeSelector: blueprint selector. self path: path tail: tail, '.st' write: [:ws | ws nextPut: $"; cr; nextPutAll: 'notice: '; nextPutAll: (copyrightLine ifNil: ['']); cr; nextPutAll: 'category: '; nextPutAll: blueprint category; cr; nextPut: $"; cr; nextPutAll: blueprint source]</body><body package="STIG">saveNamespace: aNamespaceBlueprint | path properties name ns | name := aNamespaceBlueprint reference name. path := Array with: aNamespaceBlueprint packageName, '.package' with: aNamespaceBlueprint reference name, '.pool'. aNamespaceBlueprint comment size = 0 ifFalse: [ self path: path tail: self commentFile write: [ :ws | ws nextPutAll: aNamespaceBlueprint comment ] ]. properties := Dictionary new. properties at: 'name' put: name. (IgnoredNamespaces includes: (ns := aNamespaceBlueprint reference environment)) ifFalse: [ properties at: 'namespace' put: ns fullName ]. aNamespaceBlueprint importsString isEmpty ifFalse: [ properties at: 'imports' put: (self encodeImportsString: aNamespaceBlueprint) ]. aNamespaceBlueprint isPrivate ifTrue: [ properties at: 'private' put: aNamespaceBlueprint isPrivate ]. self path: path tail: self propertyFile write: [ :ws | properties jsonWriteOn: ws ]</body><body package="STIG">savePackage: aPackage | path blueprints comment ignore | path := Array with: aPackage packageName, '.package'. (comment := aPackage imagePackage comment) size = 0 ifFalse: [ self path: path tail: self commentFile write: [ :ws | ws nextPutAll: comment ] ]. aPackage imagePackage copyrightNotice ifNotNil: [ :license | (license occurrencesOf: Character cr) > 3 ifTrue: [ self path: path tail: self licenseFile write: [ :ws | ws nextPutAll: license ] ] ]. ignore := IgnoredProperties, #(comment notice). blueprints := aPackage imagePackage propertyBlueprints reject: [ :bp | ignore includes: bp key ]. blueprints := blueprints inject: Dictionary new into: [ :d :bp | d at: bp key put: bp value; yourself ]. copyrightLine ifNotNil: [ blueprints at: '_cypress_copyright' put: copyrightLine ]. self path: path tail: self propertyFile write: [ :ws | blueprints jsonWriteOn: ws ]</body><body package="STIG">saveProperty: aPropertyBlueprint "package properties are saved differently"</body><body package="STIG">saveSharedVariable: aSharedVariableBlueprint | path properties namespace reference | reference := aSharedVariableBlueprint reference. namespace := reference environment. path := Array with: aSharedVariableBlueprint packageName, '.package' with: namespace name, (namespace isForClass ifTrue: [ '.class' ] ifFalse: [ '.pool' ]). properties := Dictionary new. properties at: 'category' put: aSharedVariableBlueprint category. properties at: 'name' put: reference name. (IgnoredNamespaces includes: namespace) ifFalse: [ properties at: 'namespace' put: namespace fullName ]. aSharedVariableBlueprint isConstant ifTrue: [ properties at: 'constant' put: aSharedVariableBlueprint isConstant ]. aSharedVariableBlueprint isPrivate ifTrue: [ properties at: 'private' put: aSharedVariableBlueprint isPrivate ]. aSharedVariableBlueprint initializer ifNotNil: [ properties at: 'initializer' put: aSharedVariableBlueprint initializer]. self path: path tail: aSharedVariableBlueprint reference name, '.json' write: [ :ws | properties jsonWriteOn: ws ]</body></methods><methods><class-id>STIG.CypressLayout</class-id> <category>private</category><body package="STIG">decodeSelector: aString | specials ws rs | aString last = $. ifTrue: [^aString replaceAll: $. with: $:; yourself]. (aString first isAlphabetic or: [ aString first = $_ ]) ifTrue: [^aString]. specials := self class specials. ws := String new writeStream. rs := aString readStream. rs next "skip the carret". [ rs atEnd ] whileFalse: [ ws nextPut: (specials at: (rs upTo: $.)) ]. ^ws contents</body><body package="STIG">deltaSetsFrom: aPackage to: disk | deltas | deltas := DeltaSets from: aPackage to: disk. deltas trimProperties: (IgnoredProperties copyWith: #_cypress_copyright). ^deltas compute</body><body package="STIG">encodeSelector: aSymbol ^aSymbol last = $: ifTrue: [aSymbol collect: [:each | each = $: ifTrue: [$.] ifFalse: [each]]] ifFalse: [(aSymbol first isAlphabetic or: [ aSymbol first = $_ ]) ifTrue: [aSymbol] ifFalse: [| output specials | specials := self class specials. output := String new writeStream. output nextPut: $^. aSymbol do: [:each | output nextPutAll: (specials at: each) ] separatedBy: [output nextPut: $.]. output contents]]</body><body package="STIG">makeReference: properties | ref | ref := (properties at: 'namespace' ifAbsent: [ nil ]) ifNil: [ 'Root.Smalltalk.' ] ifNotNil: [ :ns | 'Root.Smalltalk.', ns, '.' ]. ref := ref, (properties at: 'name'). ref := ref asQualifiedReference. ^ref bindingOrNil ifNil: [ ref ] ifNotNil: [ :binding | binding absoluteName asQualifiedReference makeUnambiguous ]</body></methods><methods><class-id>STIG.CypressLayout</class-id> <category>initialize-release</category><body package="STIG">format: properties (properties at: 'commentFile' ifAbsent: nil) ifNotNil: [ :v | commentFile := v ]. (properties at: 'licenseFile' ifAbsent: nil) ifNotNil: [ :v | licenseFile := v ]. (properties at: 'propertyFile' ifAbsent: nil) ifNotNil: [ :v | propertyFile := v ]. (properties at: 'copyrightLine' ifAbsent: nil) ifNotNil: [ :v | copyrightLine := v ].</body><body package="STIG">package: model | file | super package: model. copyrightLine := model stigCopyright. file := model stigRoot asFilename / 'properties.ston'. file exists ifTrue: [ self format: (JSON read: file contentsOfEntireFile readStream) ]</body></methods><methods><class-id>STIG.CypressLayout class</class-id> <category>instance creation</category><body package="STIG">initializeSpecials | map | map := Dictionary new. map at: $+ put: 'plus'; at: $- put: 'minus'; at: $= put: 'equals'; at: $< put: 'less'; at: $> put: 'more'; at: $, put: 'comma'; at: $% put: 'percent'; at: $& put: 'and'; at: $| put: 'pipe'; at: $* put: 'star'; at: $/ put: 'slash'; at: $\ put: 'backslash'; at: $~ put: 'tilde'; at: $? put: 'wat'; at: $@ put: 'at'. map keys do: [ :key | map at: (map at: key) put: key ]. ^map</body><body package="STIG">specials ^specials ifNil: [ specials := self initializeSpecials ]</body></methods><methods><class-id>STIG.TravisLayout</class-id> <category>saving</category><body package="STIG">saveClass: aClassBlueprint | path | path := (Array with: aClassBlueprint packageName) , (self shortReferencePath: aClassBlueprint reference). self path: path tail: '0.class' write: [:ws | aClassBlueprint superclassReference ifNotNil: [ws nextPutAll: 'super:'. ws store: aClassBlueprint superclassReference. ws cr]. aClassBlueprint behaviorType == #none ifFalse: [ws nextPutAll: 'type:'. ws store: aClassBlueprint behaviorType. ws cr]. aClassBlueprint instanceVariables isEmpty ifFalse: [ws nextPutAll: 'instvars:'. ws store: aClassBlueprint instanceVariables. ws cr]. aClassBlueprint classInstanceVariables isEmpty ifFalse: [ws nextPutAll: 'classvars:'. ws store: aClassBlueprint classInstanceVariables. ws cr]. aClassBlueprint importsString isEmpty ifFalse: [ws nextPutAll: 'import:'. ws nextPutAll: (self encodeImportsString: aClassBlueprint). ws cr]. aClassBlueprint isPrivate ifTrue: [ws nextPutAll: 'private:'. ws store: aClassBlueprint isPrivate. ws cr]. aClassBlueprint attributes isEmpty ifFalse: [ws nextPutAll: 'attributes:'. ws store: aClassBlueprint attributes. ws cr]. aClassBlueprint comment size = 0 ifFalse: [ws nextPutAll: 'comment:'. ws cr. ws nextPutAll: aClassBlueprint comment]]</body><body package="STIG">saveMethod: aMethodBlueprint | path tail | path := (Array with: aMethodBlueprint packageName) , (self shortReferencePath: aMethodBlueprint classReference). tail := (aMethodBlueprint isInstanceBehavior ifTrue: [''] ifFalse: ['^']) , (self encodeSelector: aMethodBlueprint selector). self path: path tail: tail write: [:ws | ws nextPutAll: aMethodBlueprint category; cr; nextPutAll: aMethodBlueprint source]</body><body package="STIG">saveNamespace: aNamespaceBlueprint | path | path := (Array with: aNamespaceBlueprint packageName) , (self shortReferencePath: aNamespaceBlueprint reference). self path: path tail: '0.namespace' write: [:ws | aNamespaceBlueprint importsString isEmpty ifFalse: [ws nextPutAll: 'import:'. ws nextPutAll: (self encodeImportsString: aNamespaceBlueprint). ws cr]. aNamespaceBlueprint isPrivate ifTrue: [ws nextPutAll: 'private:'. ws store: aNamespaceBlueprint isPrivate. ws cr]. aNamespaceBlueprint comment size = 0 ifFalse: [ws nextPutAll: 'comment:'. ws cr. ws nextPutAll: aNamespaceBlueprint comment]]</body><body package="STIG">saveProperty: aPropertyBlueprint | path | path := Array with: aPropertyBlueprint codeComponentName with: '_.Properties'. self path: path tail: aPropertyBlueprint key write: [:ws | ws store: aPropertyBlueprint value]</body><body package="STIG">saveSharedVariable: aSharedVariableBlueprint | path | path := (Array with: aSharedVariableBlueprint packageName) , (self shortReferencePath: aSharedVariableBlueprint reference). self path: path tail: '0.share' write: [:ws | ws nextPutAll: aSharedVariableBlueprint category. ws cr. aSharedVariableBlueprint isConstant ifTrue: [ws nextPutAll: 'constant:'. ws store: aSharedVariableBlueprint isConstant. ws cr]. aSharedVariableBlueprint isPrivate ifTrue: [ws nextPutAll: 'private:'. ws store: aSharedVariableBlueprint isPrivate. ws cr]. aSharedVariableBlueprint initializer ifNotNil: [ws nextPutAll: 'init:'. ws cr. ws nextPutAll: aSharedVariableBlueprint initializer]]</body></methods><methods><class-id>STIG.TravisLayout</class-id> <category>loading</category><body package="STIG">readBoundVariable: variable variable directoryContentsDo: [:eachFile :eachTail | eachFile isDirectory ifTrue: [(BoundVariableFromDisk parent: variable directory: eachFile name: eachTail) read: self ] ifFalse: [self readFile: eachFile tail: eachTail using: variable]]. ^variable</body><body package="STIG">readClass: aFilename using: fromDisk | rs lookup dispatch blueprint | blueprint := ClassBlueprint new. blueprint original: aFilename. blueprint reference: fromDisk reference. blueprint importsString: ''. blueprint isPrivate: false. blueprint instanceVariables: Array new. blueprint classInstanceVariables: Array new. blueprint attributes: Array new. blueprint behaviorType: #none. blueprint comment: ''. rs := (fromDisk fileContents: aFilename) readStream. lookup := #('super:' 'instvars:' 'import:' 'type:' 'classvars:' 'private:' 'attributes:'). dispatch := #(#load:superclassReference: #load:instanceVariables: #load:importsString: #load:behaviorType: #load:classInstanceVariables: #load:isPrivate: #load:attributes:). [rs atEnd] whileFalse: [| line | line := rs upTo: Character cr. line = 'comment:' ifTrue: [blueprint comment: rs upToEnd] ifFalse: [| index | index := lookup findFirst: [:each | line beginsWith: each]. self perform: (dispatch at: index) with: blueprint with: (line allButFirst: (lookup at: index) size)]]. fromDisk addBlueprint: blueprint. ^fromDisk</body><body package="STIG">readDefinition: aFilename tail: aTail using: fromDisk '0.class' = aTail ifTrue: [self readClass: aFilename using: fromDisk] ifFalse: ['0.share' = aTail ifTrue: [self readSharedVariable: aFilename using: fromDisk] ifFalse: ['0.namespace' = aTail ifTrue: [self readNamespace: aFilename using: fromDisk] ifFalse: [self unreachableCode]]]. ^fromDisk</body><body package="STIG">readFile: aFilename tail: aTail using: fromDisk ^aTail first = $0 ifTrue: [self readDefinition: aFilename tail: aTail using: fromDisk] ifFalse: [self readMethod: aFilename tail: aTail using: fromDisk]</body><body package="STIG">readMethod: aFilename tail: aTail using: fromDisk | blueprint rs | blueprint := MethodBlueprint of: aFilename. aTail first = $0 ifTrue: [^fromDisk] ifFalse: [aTail first = $^ ifTrue: [blueprint isInstanceBehavior: false] ifFalse: [blueprint isInstanceBehavior: true]]. blueprint classReference: fromDisk reference. blueprint selector: (self decodeSelector: (aTail allButFirst: 1)) asSymbol. rs := (fromDisk fileContents: aFilename) readStream. blueprint category: (rs upTo: Character cr). blueprint source: rs upToEnd. fromDisk addBlueprint: blueprint. ^fromDisk</body><body package="STIG">readNamespace: aFilename using: fromDisk | rs lookup dispatch blueprint | blueprint := NamespaceBlueprint new. blueprint original: aFilename. blueprint reference: fromDisk reference. blueprint importsString: ''. blueprint isPrivate: false. blueprint comment: ''. rs := (fromDisk fileContents: aFilename) readStream. lookup := #('import:' 'private:'). dispatch := #(#load:importsString: #load:isPrivate:). [rs atEnd] whileFalse: [| line | line := rs upTo: Character cr. line = 'comment:' ifTrue: [blueprint comment: rs upToEnd] ifFalse: [| index | index := lookup findFirst: [:each | line beginsWith: each]. fromDisk perform: (dispatch at: index) with: blueprint with: (line allButFirst: (lookup at: index) size)]]. fromDisk addBlueprint: blueprint. ^fromDisk</body><body package="STIG">readPackage: aPackage aPackage directoryContentsDo: [:eachFile :eachTail | '.git' = eachTail ifFalse: [eachFile isDirectory ifTrue: [| type | type := '_.Properties' = eachTail ifTrue: [PropertiesFromDisk] ifFalse: [BoundVariableFromDisk]. (type parent: aPackage directory: eachFile name: eachTail) read: self ]]]. ^aPackage</body><body package="STIG">readProperties: properties properties directoryContentsDo: [:eachFile :eachTail | eachFile isDirectory ifFalse: [| blueprint | blueprint := CodeComponentPropertyBlueprint new. blueprint key: eachTail asSymbol. blueprint original: eachFile. blueprint value: (Compiler evaluate: (properties fileContents: eachFile)). properties addBlueprint: blueprint]]. ^properties</body><body package="STIG">readSharedVariable: aFilename using: fromDisk | rs lookup dispatch blueprint | blueprint := SharedVariableBlueprint new. blueprint original: aFilename. blueprint reference: fromDisk reference. rs := (fromDisk fileContents: aFilename) readStream. blueprint category: (rs upTo: Character cr). blueprint isPrivate: false. blueprint isConstant: false. lookup := #('private:' 'constant:'). dispatch := #(#load:isPrivate: #load:isConstant:). [rs atEnd] whileFalse: [| line | line := rs upTo: Character cr. line = 'init:' ifTrue: [blueprint initializer: rs upToEnd] ifFalse: [| index | index := lookup findFirst: [:each | line beginsWith: each]. fromDisk perform: (dispatch at: index) with: blueprint with: (line allButFirst: (lookup at: index) size)]]. fromDisk addBlueprint: blueprint. ^fromDisk</body></methods><methods><class-id>STIG.TravisLayout</class-id> <category>private</category><body package="STIG">load: aBlueprint attributes: aString aBlueprint attributes: (Compiler evaluate: aString)</body><body package="STIG">load: aBlueprint behaviorType: aString aBlueprint behaviorType: (Compiler evaluate: aString)</body><body package="STIG">load: aBlueprint classInstanceVariables: aString aBlueprint classInstanceVariables: (Compiler evaluate: aString)</body><body package="STIG">load: aBlueprint importsString: aString aBlueprint importsString: (self decodeImportsString: aString)</body><body package="STIG">load: aBlueprint instanceVariables: aString aBlueprint instanceVariables: (Compiler evaluate: aString)</body><body package="STIG">load: aBlueprint isConstant: aString aBlueprint isConstant: (Compiler evaluate: aString)</body><body package="STIG">load: aBlueprint isPrivate: aString aBlueprint isPrivate: (Compiler evaluate: aString)</body><body package="STIG">load: aBlueprint superclassReference: aString aBlueprint superclassReference: (Compiler evaluate: aString) asString asQualifiedReference makeUnambiguous</body></methods><methods><class-id>JSON</class-id> <category>private</category><body package="STIG-Json">get ^char ifNil: [ stream next ] ifNotNil: [ :c | char := nil. c ]</body><body package="STIG-Json">peek ^char ifNil: [ char := stream next ]</body><body package="STIG-Json">read: count ^char ifNil: [ stream next: count ] ifNotNil: [ | out | out := String new: count. out at: 1 put: self get. stream next: count - 1 into: out startingAt: 2. out ]</body><body package="STIG-Json">skipWhitespace | c | [ Whitespace includes: (c := self get) ] whileTrue. char := c</body></methods><methods><class-id>JSON</class-id> <category>private-parsing</category><body package="STIG-Json">parse self skipWhitespace. char := self peek. char = ${ ifTrue: [ ^self parseObject ]. char = $[ ifTrue: [ ^self parseArray ]. char = $" ifTrue: [ ^self parseString ]. char = $n ifTrue: [ ^self parseNull ]. char = $t ifTrue: [ ^self parseTrue ]. char = $f ifTrue: [ ^self parseFalse ]. char isDigit ifTrue: [ ^self parseNumber ]. self error: 'Invalid JSON'</body><body package="STIG-Json">parseArray | array | self get = $[ ifFalse: [ self error: 'Failed parsing array' ]. array := Array new writeStream. self skipWhitespace. [ self peek = $] ] whileFalse: [ array nextPut: self parse. (self skipWhitespace; peek) = $, ifTrue: [ self get; skipWhitespace ] ]. self get. ^array contents</body><body package="STIG-Json">parseFalse (self read: 5) = 'false' ifTrue: [^false]. self error: 'Failed parsing false'</body><body package="STIG-Json">parseNull (self read: 4) = 'null' ifTrue: [^nil]. self error: 'Failed parsing null'</body><body package="STIG-Json">parseNumber | number digit | number := String new writeStream. [ (digit := self get) isDigit ] whileTrue: [ number nextPut: digit ]. char := digit. ^Number readFrom: number contents readStream</body><body package="STIG-Json">parseObject | object | self get = ${ ifFalse: [ self error: 'Failed parsing object' ]. object := Dictionary new. self skipWhitespace. [ self peek = $} ] whileFalse: [ | key value | key := self parseString. (self skipWhitespace; get) = $: ifFalse: [ self error: 'Failed parsing object' ]. value := self skipWhitespace; parse. object at: key put: value. (self skipWhitespace; peek) = $, ifTrue: [ self get; skipWhitespace ] ]. self get. ^object</body><body package="STIG-Json">parseSpecialCharacter | c | c := self get. c = $\ ifTrue: [ ^$\ ]. c = $" ifTrue: [ ^$" ]. c = $n ifTrue: [ ^Character cr ]. c = $t ifTrue: [ ^Character tab ]. c = $u ifTrue: [ ^self parseUnicodeCodePoint: (self read: 4) asLowercase ]. self error: 'Failed parsing special character'</body><body package="STIG-Json">parseString | string c | string := String new writeStream. self get = $" ifFalse: [ self error: 'Failed parsing String' ]. [ (c := self get) = $" ] whileFalse: [ c = $\ ifTrue: [ c := self parseSpecialCharacter ]. string nextPut: c ]. ^string contents</body><body package="STIG-Json">parseTrue (self read: 4) = 'true' ifTrue: [^true]. self error: 'Failed parsing true'</body><body package="STIG-Json">parseUnicodeCodePoint: digits | hex codePoint | hex := '0123456789abcdef'. codePoint := digits inject: 0 into: [ :nr :c | nr * 16 + (hex indexOf: c) - 1 ]. ^codePoint asCharacter</body></methods><methods><class-id>JSON</class-id> <category>accessing</category><body package="STIG-Json">readFrom: source stream := source. ^self parse</body></methods><methods><class-id>JSON class</class-id> <category>instance creation</category><body package="STIG-Json">read: aStream ^self new readFrom: aStream</body></methods><methods><class-id>Core.Dictionary</class-id> <category>printing</category><body package="STIG-Json">jsonWriteOn: stream tabs: tabs stream nextPut: ${; tab. self isEmpty ifTrue: [ stream nextPut: $}. ^self ]. self keys sorted do: [ :key | stream nextPut: $"; nextPutAll: key; nextPutAll: '" : '. (self at: key) jsonWriteOn: stream tabs: tabs + 1 ] separatedBy: [ stream nextPut: $,; cr. tabs + 1 timesRepeat: [ stream tab ] ]. stream nextPutAll: ' }'</body></methods><methods><class-id>Core.Number</class-id> <category>printing</category><body package="STIG-Json">jsonWriteOn: stream tabs: tabs stream print: self</body></methods><methods><class-id>Core.UndefinedObject</class-id> <category>printing</category><body package="STIG-Json">jsonWriteOn: stream tabs: tabs stream nextPutAll: 'null'</body></methods><methods><class-id>Core.ArrayedCollection</class-id> <category>printing</category><body package="STIG-Json">jsonWriteOn: stream tabs: tabs stream nextPut: $[; tab. self isEmpty ifTrue: [ stream nextPut: $]. ^self ]. (1 to: self size) do: [ :i | (self at: i) jsonWriteOn: stream tabs: tabs + 1 ] separatedBy: [ stream nextPut: $,; cr. tabs + 1 timesRepeat: [ stream tab ] ]. stream nextPutAll: ' ]'</body></methods><methods><class-id>Core.False</class-id> <category>printing</category><body package="STIG-Json">jsonWriteOn: stream tabs: tabs stream nextPutAll: 'false'</body></methods><methods><class-id>Core.Object</class-id> <category>printing</category><body package="STIG-Json">jsonWriteOn: stream self jsonWriteOn: stream tabs: 0</body><body package="STIG-Json">jsonWriteOn: stream tabs: tabs | keys | stream nextPut: ${. keys := self class instVarNames. keys isEmpty ifTrue: [ stream nextPut: $}. ^self ]. keys do: [ :var | stream nextPut: $"; nextPutAll: var; nextPutAll: '" : '. (self instVarAt: var) jsonWriteOn: stream tabs: tabs + 1 ] separatedBy: [ stream nextPut: $,; cr. tabs + 1 timesRepeat: [ stream tab ] ]. stream nextPutAll: ' }'</body></methods><methods><class-id>Core.KeyedCollection</class-id> <category>printing</category><body package="STIG-Json">jsonWriteOn: stream tabs: tabs stream nextPut: ${; tab. self isEmpty ifTrue: [ stream nextPut: $}. ^self ]. self keys sorted do: [ :key | stream nextPut: $"; nextPutAll: key; nextPutAll: '" : '. (self at: key) jsonWriteOn: stream tabs: tabs + 1 ] separatedBy: [ stream nextPut: $,; cr. tabs + 1 timesRepeat: [ stream tab ] ]. stream nextPutAll: ' }'</body></methods><methods><class-id>Core.True</class-id> <category>printing</category><body package="STIG-Json">jsonWriteOn: stream tabs: tabs stream nextPutAll: 'true'</body></methods><methods><class-id>Core.CharacterArray</class-id> <category>printing</category><body package="STIG-Json">jsonWriteOn: stream tabs: tabs stream nextPut: $". self do: [ :c | c codePoint < 128 ifTrue: [ ('"\' includes: c) ifTrue: [ stream nextPut: $\ ]. stream nextPut: c ] ifFalse: [ stream nextPutAll: '\u'. c codePoint printOn: stream base: 16 digitsToPad: 4 highDigit: 4 ] ]. stream nextPut: $"</body></methods><methods><class-id>Refactory.Browser.BrowserNavigator</class-id> <category>STIG</category><body package="STIG-Tools">stigCommitPackages | message | message := Dialog request: 'Commit Message:' initialAnswer: 'commit message' onCancel: [^self]. message := message trimSeparators. self packages do: [:eachPackage | eachPackage stigToDisk. (STIG.Git for: eachPackage) addAll. (STIG.Git for: eachPackage) commitAll: message]</body><body package="STIG-Tools">stigInitPackages self packages do: [:eachPackage | eachPackage stigToDisk. (STIG.Git for: eachPackage) init]</body><body package="STIG-Tools">stigReconcileDisk: diskBlueprints toImage: imageBlueprints | diffs diskStack imageStack toRemove toUpdate againDisk againImage | diskBlueprints sort. imageBlueprints sort. diffs := (SequenceableCollectionDifferences new) comparisonFunction: [:a :b | a refersToSameObject: b]; differencesFrom: diskBlueprints to: imageBlueprints. diskStack := OrderedCollection withAll: diskBlueprints. imageStack := OrderedCollection withAll: imageBlueprints. toRemove := OrderedCollection new. toUpdate := OrderedCollection new. againDisk := OrderedCollection new. againImage := OrderedCollection new. diffs do: [:eachSubsequence | eachSubsequence isDelete ifTrue: [toRemove addAll: (diskStack removeFirst: eachSubsequence length)] ifFalse: [eachSubsequence isInsert ifTrue: [toUpdate addAll: (imageStack removeFirst: eachSubsequence length)] ifFalse: [againImage addAll: (imageStack removeFirst: eachSubsequence length). againDisk addAll: (diskStack removeFirst: eachSubsequence length)]]]. diffs := againDisk differences: againImage. (diffs select: #isInsert) do: [:eachSubsequence | toUpdate addAll: eachSubsequence]. toRemove do: [:each | each original delete]. ^toUpdate</body><body package="STIG-Tools">stigUpdatePackage: aPackage</body></methods><methods><class-id>Refactory.Browser.AddNameSpaceChange</class-id> <category>initialize-release</category><body package="STIG">fromBlueprint: aNamespaceBlueprint imports := self parseImports: aNamespaceBlueprint importsString. isPrivate := aNamespaceBlueprint isPrivate. objectName := aNamespaceBlueprint reference asString. nameSpaceName := aNamespaceBlueprint reference environmentName. self package: aNamespaceBlueprint livePackage. definition := '<1s> defineNameSpace: #<2s> private: <3p> imports: <4p> category: ''''' expandMacrosWithArguments: (Array with: nameSpaceName with: aNamespaceBlueprint reference simpleName with: isPrivate with: aNamespaceBlueprint importsString)</body></methods><methods><class-id>Tools.SharedVariableBlueprint</class-id> <category>converting</category><body package="STIG">emitAdditionChangesTo: aCompositeChange aCompositeChange addChange: (Refactory.Browser.AddSharedVariableChange new fromBlueprint: self)</body><body package="STIG">emitRemovalChangesTo: aCompositeChange aCompositeChange addChange: (Refactory.Browser.RemoveSharedVariableChange objectName: reference asString)</body></methods><methods><class-id>Tools.SharedVariableBlueprint</class-id> <category>accessing</category><body package="STIG">fromDiskAddTo: aFromDisk aFromDisk addSharedVariableBlueprint: self</body><body package="STIG">saveToDisk: aToDisk aToDisk saveSharedVariable: self</body></methods><methods><class-id>Core.Character class</class-id> <category>instance creation</category><body package="STIG">fromUTF8Bytes: aByteArray at: anIndex</body></methods><methods><class-id>Core.Character</class-id> <category>composing</category><body package="STIG">emitUTF8Into: aByteArray startingAt: anIndex | code | code := self codePoint. ^code < 16r80 ifTrue: [aByteArray at: anIndex put: (code = 13 ifTrue: [10] ifFalse: [code = 10 ifTrue: [13] ifFalse: [code]]). 1] ifFalse: [code < 16r800 ifTrue: [aByteArray at: anIndex put: (code bitShift: -6) + 16rC0. aByteArray at: anIndex + 1 put: (code bitAnd: 16r3F) + 16r80. 2] ifFalse: [code < 16r10000 ifTrue: [aByteArray at: anIndex put: (code bitShift: -12) + 16rE0. aByteArray at: anIndex + 1 put: ((code bitShift: -6) bitAnd: 16r3F) + 16r80. aByteArray at: anIndex + 2 put: (code bitAnd: 16r3F) + 16r80. 3] ifFalse: [aByteArray at: anIndex put: (code bitShift: -18) + 16rF0. aByteArray at: anIndex + 1 put: ((code bitShift: -12) bitAnd: 16r3F) + 16r80. aByteArray at: anIndex + 2 put: ((code bitShift: -6) bitAnd: 16r3F) + 16r80. aByteArray at: anIndex + 3 put: (code bitAnd: 16r3F) + 16r80. 4]]]</body></methods><methods><class-id>Tools.CodeComponentPropertyBlueprint</class-id> <category>converting</category><body package="STIG">emitAdditionChangesTo: aCompositeChange | change | change := (Refactory.Browser.CodeComponentPropertyChange component: (isBundle ifTrue: [Store.Registry bundleNamed: codeComponentName] ifFalse: [Store.Registry packageNamed: codeComponentName])) propertyKey: key; propertyValue: value; yourself. aCompositeChange addChange: change</body><body package="STIG">emitRemovalChangesTo: aCompositeChange | change | change := (Refactory.Browser.CodeComponentPropertyChange component: (isBundle ifTrue: [Store.Registry bundleNamed: codeComponentName] ifFalse: [Store.Registry packageNamed: codeComponentName])) propertyKey: key; propertyValue: nil; yourself. aCompositeChange addChange: change</body></methods><methods><class-id>Tools.CodeComponentPropertyBlueprint</class-id> <category>accessing</category><body package="STIG">fromDiskAddTo: aFromDisk aFromDisk addPropertyBlueprint: self</body><body package="STIG">livePackage ^isBundle ifTrue: [Store.Registry bundleNamed: codeComponentName] ifFalse: [Store.Registry packageNamed: codeComponentName]</body><body package="STIG">packageName: aString self codeComponentName: aString. self isBundle: false</body></methods><methods><class-id>Tools.CodeComponentPropertyBlueprint</class-id> <category>printing</category><body package="STIG">printOn: aStream aStream nextPutAll: codeComponentName; nextPutAll: '::'; nextPutAll: key; nextPutAll: ' = '; print: value</body></methods><methods><class-id>Tools.CodeComponentPropertyBlueprint</class-id> <category>comparing</category><body package="STIG">refersToSameObject: aPropertyBlueprint ^key = aPropertyBlueprint key and: [codeComponentName = aPropertyBlueprint codeComponentName and: [isBundle = aPropertyBlueprint isBundle]]</body></methods><methods><class-id>Tools.CodeComponentPropertyBlueprint</class-id> <category>accessing</category><body package="STIG">saveToDisk: aToDisk aToDisk saveProperty: self</body></methods><methods><class-id>OS.Filename</class-id> <category>instance creation</category><body package="STIG">trustedConstruct: aFilepath ^self class new named: (self constructString: aFilepath)</body></methods><methods><class-id>Tools.ClassBlueprint</class-id> <category>converting</category><body package="STIG">asDefinitionUpdateChange ^Refactory.Browser.AddClassChange new fromBlueprint: self</body></methods><methods><class-id>Tools.ClassBlueprint</class-id> <category>accessing</category><body package="STIG">classInstanceVariablesString ^self instanceVariablesString: classInstanceVariables</body></methods><methods><class-id>Tools.ClassBlueprint</class-id> <category>converting</category><body package="STIG">emitRemovalChangesTo: aCompositeChange aCompositeChange addChange: (Refactory.Browser.RemoveClassChange objectName: reference asString)</body></methods><methods><class-id>Tools.ClassBlueprint</class-id> <category>accessing</category><body package="STIG">fromDiskAddTo: aFromDisk aFromDisk addClassBlueprint: self</body></methods><methods><class-id>Tools.ClassBlueprint</class-id> <category>testing</category><body package="STIG">hasSameDefinition: aBlueprint "We assume we know its for the same reference" ^(super hasSameDefinition: aBlueprint) and: [instanceVariables = aBlueprint instanceVariables and: [superclassReference = aBlueprint superclassReference and: [behaviorType = aBlueprint behaviorType and: [classInstanceVariables = aBlueprint classInstanceVariables and: [attributes = aBlueprint attributes]]]]]</body></methods><methods><class-id>Tools.ClassBlueprint</class-id> <category>accessing</category><body package="STIG">instanceVariablesString ^self instanceVariablesString: instanceVariables</body><body package="STIG">instanceVariablesString: aSequence ^aSequence isEmpty ifTrue: [String new] ifFalse: [aSequence fold: [:a :b | a , ' ' , b]]</body><body package="STIG">neededReference ^superclassReference</body><body package="STIG">saveToDisk: aToDisk aToDisk saveClass: self</body></methods><methods><class-id>Refactory.Browser.AddClassChange</class-id> <category>initialize-release</category><body package="STIG">fromBlueprint: aClassBlueprint imports := self parseImports: aClassBlueprint importsString. isPrivate := aClassBlueprint isPrivate. superclassName := aClassBlueprint superclassReference ifNotNil: #asString. instanceVariableNames := aClassBlueprint instanceVariables. classInstanceVariableNames := aClassBlueprint classInstanceVariables. indexedType := aClassBlueprint behaviorType. objectName := aClassBlueprint reference asString. nameSpaceName := aClassBlueprint reference environmentName. self package: aClassBlueprint livePackage. definition := '<1s> defineClass: #<2s> superclass: <3p> indexedType: <4p> private: <5p> instanceVariableNames: <6p> classInstanceVariableNames: <7p> imports: <8p> category: ''''' expandMacrosWithArguments: (Array with: nameSpaceName with: aClassBlueprint reference simpleName with: aClassBlueprint superclassReference with: indexedType) , (Array with: isPrivate with: aClassBlueprint instanceVariablesString with: aClassBlueprint classInstanceVariablesString with: aClassBlueprint importsString)</body></methods><methods><class-id>Tools.BindingBlueprint</class-id> <category>accessing</category><body package="STIG">livePackage ^Store.Registry packageNamed: packageName</body></methods><methods><class-id>Tools.BindingBlueprint</class-id> <category>comparing</category><body package="STIG">refersToSameObject: aBindingBlueprint ^reference = aBindingBlueprint reference</body></methods><methods><class-id>Refactory.Browser.AddSharedVariableChange</class-id> <category>initialize-release</category><body package="STIG">fromBlueprint: aSharedVariableBlueprint isConstant := aSharedVariableBlueprint isConstant. isPrivate := aSharedVariableBlueprint isPrivate. category := aSharedVariableBlueprint category. initializer := aSharedVariableBlueprint initializer. objectName := aSharedVariableBlueprint reference asString. nameSpaceName := aSharedVariableBlueprint reference environmentName. self package: aSharedVariableBlueprint livePackage. definition := '<1s> defineSharedVariable: #<2s> private: <3p> constant: <4p> category: <5p> initializer: <6p>' expandMacrosWithArguments: (Array with: nameSpaceName with: aSharedVariableBlueprint reference simpleName) , (Array with: isPrivate with: isConstant with: category with: initializer)</body></methods><methods><class-id>Tools.MethodBlueprint</class-id> <category>converting</category><body package="STIG">emitAdditionChangesTo: aCompositeChange | change | change := Refactory.Browser.AddMethodChange new. change source: self source. change objectName: self classReference asString. change isMeta: self isInstanceBehavior not. change protocols: self category. aCompositeChange addChange: change</body><body package="STIG">emitRemovalChangesTo: aCompositeChange aCompositeChange addChange: (Refactory.Browser.RemoveMethodChange remove: selector from: self liveClass)</body></methods><methods><class-id>Tools.MethodBlueprint</class-id> <category>accessing</category><body package="STIG">fromDiskAddTo: aFromDisk aFromDisk addMethodBlueprint: self</body></methods><methods><class-id>Tools.MethodBlueprint</class-id> <category>comparing</category><body package="STIG">refersToSameObject: aMethodBlueprint ^selector = aMethodBlueprint selector and: [classReference = aMethodBlueprint classReference and: [isInstanceBehavior == aMethodBlueprint isInstanceBehavior]]</body></methods><methods><class-id>Tools.MethodBlueprint</class-id> <category>accessing</category><body package="STIG">saveToDisk: aToDisk aToDisk saveMethod: self</body></methods><methods><class-id>Store.PackageModel</class-id> <category>STIG</category><body package="STIG">stigCopyright ^self copyrightNotice ifNil: [ nil ] ifNotNil: [ :notice || stream line | stream := notice readStream. [ stream atEnd or: [ (line := stream upTo: Character cr) beginsWith: 'Copyright' ] ] whileFalse. (line beginsWith: 'Copyright') ifTrue: [ line ] ifFalse: [ nil ] ]</body><body package="STIG">stigDeltasFromDisk | layout fromDisk | layout := DirectoryLayout for: self. fromDisk := ((layout packageFromDisk: self name) read: layout). ^layout deltaSetsFrom: self to: fromDisk</body><body package="STIG">stigFromDisk | layout | layout := DirectoryLayout for: self. self stigFromDisk: ((layout packageFromDisk: self name) read: layout)</body><body package="STIG">stigFromDisk: aFromDisk | deltas layout | layout := DirectoryLayout for: self. deltas := layout deltaSetsFrom: self to: aFromDisk. deltas buildCompositeChange execute</body><body package="STIG">stigRoot ^(self propertyAt: #STIGRoot ifAbsent: [ nil ]) ifNil: [ DefaultRoot ]</body><body package="STIG">stigToDisk | fromDisk deltas layout | layout := DirectoryLayout for: self. fromDisk := layout packageFromDisk: self name. fromDisk directory ensureDirectory. fromDisk read: layout. deltas := layout deltaSetsFrom: fromDisk to: self. layout saveDeltas: deltas directory: fromDisk</body></methods><methods><class-id>Tools.NamespaceBlueprint class</class-id> <category>utility</category><body package="STIG">sortForDoingImageUpdates: aCollection | result byNeed notYetAdded canBeAdded groupToAdd | result := OrderedCollection new. byNeed := aCollection groupedBy: #neededReference. notYetAdded := (aCollection collect: #reference) asSet. [byNeed isEmpty] whileFalse: [canBeAdded := byNeed keys reject: [:eachNeededReference | notYetAdded includes: eachNeededReference]. canBeAdded do: [:eachKey | groupToAdd := byNeed removeKey: eachKey. groupToAdd do: [:each | notYetAdded remove: each reference]. result addAll: groupToAdd]]. ^result</body></methods><methods><class-id>Tools.NamespaceBlueprint</class-id> <category>converting</category><body package="STIG">asCommentUpdateChange ^(Refactory.Browser.CommentChange new) objectName: reference asString; comment: self comment; yourself</body><body package="STIG">asDefinitionUpdateChange ^Refactory.Browser.AddNameSpaceChange new fromBlueprint: self</body><body package="STIG">emitAdditionChangesTo: aCompositeChange aCompositeChange addChange: self asDefinitionUpdateChange; addChange: self asCommentUpdateChange</body><body package="STIG">emitModificationChangesTo: aCompositeChange relativeTo: anOriginalBlueprint (anOriginalBlueprint hasSameDefinition: self) ifFalse: [aCompositeChange addChange: (Refactory.Browser.AddNameSpaceChange new fromBlueprint: self)]. (anOriginalBlueprint hasSameComment: self) ifFalse: [aCompositeChange addChange: self asCommentUpdateChange]</body><body package="STIG">emitRemovalChangesTo: aCompositeChange aCompositeChange addChange: (Refactory.Browser.RemoveNameSpaceChange objectName: reference asString)</body></methods><methods><class-id>Tools.NamespaceBlueprint</class-id> <category>accessing</category><body package="STIG">fromDiskAddTo: aFromDisk aFromDisk addNamespaceBlueprint: self</body></methods><methods><class-id>Tools.NamespaceBlueprint</class-id> <category>testing</category><body package="STIG">hasSameComment: aBlueprint "We assume we know its for the same reference" ^comment = aBlueprint comment</body><body package="STIG">hasSameDefinition: aBlueprint "We assume we know its for the same reference" ^importsString = aBlueprint importsString and: [isPrivate = aBlueprint isPrivate]</body></methods><methods><class-id>Tools.NamespaceBlueprint</class-id> <category>accessing</category><body package="STIG">neededReference ^BindingReference path: (self reference path allButLast: 1)</body><body package="STIG">saveToDisk: aToDisk aToDisk saveNamespace: self</body></methods><methods><class-id>Tools.AbstractBlueprint class</class-id> <category>utility</category><body package="STIG">sortForDoingImageUpdates: aCollection "subclasses might do more" ^aCollection</body></methods><methods><class-id>Tools.AbstractBlueprint</class-id> <category>converting</category><body package="STIG">emitAdditionChangesTo: aCompositeChange ^self subclassResponsibility</body><body package="STIG">emitModificationChangesTo: aCompositeChange relativeTo: originalBlueprint "Some subclasses get more specific than this." ^self emitAdditionChangesTo: aCompositeChange</body><body package="STIG">emitRemovalChangesTo: aCompositeChange ^self subclassResponsibility</body></methods><methods><class-id>Tools.AbstractBlueprint</class-id> <category>accessing</category><body package="STIG">livePackage ^self subclassResponsibility</body></methods><methods><class-id>Tools.AbstractBlueprint</class-id> <category>comparing</category><body package="STIG">refersToSameObject: aBlueprint ^self subclassResponsibility</body></methods><methods><class-id>Refactory.Browser.BrowserNavigator</class-id> <category>menus</category><body package="STIG-Tools">stigCommitMenuItem <itemInMenu: #(#pundleMenu #stigMenu) position: 10.1> ^(MenuItem labeled: 'Commit') value: [self stigCommitPackages]</body><body package="STIG-Tools">stigDiffMenuItem <itemInMenu: #(#pundleMenu #stigMenu) position: 10.6> ^(MenuItem labeled: 'Diff') value: [ self packages with: (self packages collect: #stigDeltasFromDisk) do: [ :package :delta | Transcript cr; cr; print: package; tab; print: delta; tab; print: Timestamp now. delta additions do: [:each | Transcript cr; nextPut: $+; print: each ]. delta changes with: delta originals do: [:eachChange :eachOriginal | Transcript cr; nextPut: $*; print: eachChange ]. delta removals reverseDo: [:each | Transcript cr; nextPut: $-; print: each ] ] ]</body><body package="STIG-Tools">stigInitMenuItem <itemInMenu: #(#pundleMenu #stigMenu) position: 90.1> ^(MenuItem labeled: 'Init') value: [self stigInitPackages]</body><body package="STIG-Tools">stigReadMenuItem <itemInMenu: #(#pundleMenu #stigMenu) position: 10.1> ^(MenuItem labeled: 'Read') value: [self packages do: [:eachPackage | eachPackage stigFromDisk]]</body><body package="STIG-Tools">stigSetRootMenuItem <itemInMenu: #(#pundleMenu #stigMenu) position: 90.5> ^(MenuItem labeled: 'Set Root') value: [ ( Dialog request: 'Root directory for this project?' initialAnswer: (self packages first propertyAt: #STIGRoot) onCancel: []) ifNotNil: [ :root | self packages do: [ :package | package propertyAt: #STIGRoot put: root ] ] ]</body><body package="STIG-Tools">stigSubmenuItem <itemInMenu: #(#pundleMenu) position: 15.0> ^(MenuItem labeled: 'STIG') nameKey: #stigMenu; submenu: Menu new; yourself</body><body package="STIG-Tools">stigWriteMenuItem <itemInMenu: #(#pundleMenu #stigMenu) position: 10.1> ^(MenuItem labeled: 'Write') value: [self packages do: #stigToDisk]</body></methods><do-it>"Imported Classes:"</do-it><do-it>self error: 'Attempting to file-in parcel imports. Choose terminate or close'</do-it><class><name>Object</name><environment>Core</environment><super></super><private>false</private><indexed-type>none</indexed-type><inst-vars></inst-vars><class-inst-vars></class-inst-vars><imports></imports><category>Kernel-Objects</category><attributes><package>Kernel-Objects</package></attributes></class><class><name>AbstractBlueprint</name><environment>Tools</environment><super>Core.Object</super><private>false</private><indexed-type>none</indexed-type><inst-vars>original </inst-vars><class-inst-vars></class-inst-vars><imports></imports><category></category><attributes><package>Tools-Blueprints</package></attributes></class><class><name>BindingBlueprint</name><environment>Tools</environment><super>Tools.AbstractBlueprint</super><private>false</private><indexed-type>none</indexed-type><inst-vars>reference packageName isPrivate </inst-vars><class-inst-vars></class-inst-vars><imports></imports><category></category><attributes><package>Tools-Blueprints</package></attributes></class><class><name>NamespaceBlueprint</name><environment>Tools</environment><super>Tools.BindingBlueprint</super><private>false</private><indexed-type>none</indexed-type><inst-vars>importsString comment </inst-vars><class-inst-vars></class-inst-vars><imports></imports><category></category><attributes><package>Tools-Blueprints</package></attributes></class><class><name>Character</name><environment>Core</environment><super>Core.Magnitude</super><private>false</private><indexed-type>immediate</indexed-type><inst-vars></inst-vars><class-inst-vars></class-inst-vars><imports></imports><category>Magnitude-General</category><attributes><package>Magnitude-General</package></attributes></class><class><name>ArrayedCollection</name><environment>Core</environment><super>Core.SequenceableCollection</super><private>false</private><indexed-type>none</indexed-type><inst-vars></inst-vars><class-inst-vars></class-inst-vars><imports></imports><category>Collections-Abstract</category><attributes><package>Collections-Abstract</package></attributes></class><class><name>CharacterArray</name><environment>Core</environment><super>Core.ArrayedCollection</super><private>false</private><indexed-type>none</indexed-type><inst-vars></inst-vars><class-inst-vars></class-inst-vars><imports></imports><category>Collections-Text</category><attributes><package>Collections-Text</package></attributes></class><class><name>UndefinedObject</name><environment>Core</environment><super>Core.Object</super><private>false</private><indexed-type>none</indexed-type><inst-vars></inst-vars><class-inst-vars></class-inst-vars><imports></imports><category>Kernel-Objects</category><attributes><package>Kernel-Objects</package></attributes></class><class><name>Filename</name><environment>OS</environment><super>Core.Object</super><private>false</private><indexed-type>none</indexed-type><inst-vars>osName publicName logicalName </inst-vars><class-inst-vars></class-inst-vars><imports></imports><category>OS-Support</category><attributes><package>OS-Support</package></attributes></class><class><name>PackageModel</name><environment>Store</environment><super>Store.PundleModel</super><private>false</private><indexed-type>none</indexed-type><inst-vars>models </inst-vars><class-inst-vars></class-inst-vars><imports></imports><category>PackageCategories</category><attributes><package>PackageCategories</package></attributes></class><class><name>Dictionary</name><environment>Core</environment><super>Core.Set</super><private>false</private><indexed-type>objects</indexed-type><inst-vars></inst-vars><class-inst-vars></class-inst-vars><imports></imports><category>Collections-Unordered</category><attributes><package>Collections-Unordered</package></attributes></class><class><name>KeyedCollection</name><environment>Core</environment><super>Core.Collection</super><private>false</private><indexed-type>none</indexed-type><inst-vars></inst-vars><class-inst-vars></class-inst-vars><imports></imports><category>Collections-Abstract</category><attributes><package>Collections-Abstract</package></attributes></class><class><name>AddNameSpaceChange</name><environment>Refactory.Browser</environment><super>Refactory.Browser.ExecuteCodeChange</super><private>false</private><indexed-type>none</indexed-type><inst-vars>imports </inst-vars><class-inst-vars></class-inst-vars><imports></imports><category>Browser-Change Objects</category><attributes><package>Browser-ChangeObjects</package></attributes></class><class><name>SharedVariableBlueprint</name><environment>Tools</environment><super>Tools.BindingBlueprint</super><private>false</private><indexed-type>none</indexed-type><inst-vars>category initializer isConstant </inst-vars><class-inst-vars></class-inst-vars><imports></imports><category></category><attributes><package>Tools-Blueprints</package></attributes></class><class><name>MethodBlueprint</name><environment>Tools</environment><super>Tools.AbstractBlueprint</super><private>false</private><indexed-type>none</indexed-type><inst-vars>classReference selector isInstanceBehavior packageName source category </inst-vars><class-inst-vars></class-inst-vars><imports></imports><category></category><attributes><package>Tools-Blueprints</package></attributes></class><class><name>AddSharedVariableChange</name><environment>Refactory.Browser</environment><super>Refactory.Browser.ExecuteCodeChange</super><private>false</private><indexed-type>none</indexed-type><inst-vars>isConstant initializer </inst-vars><class-inst-vars></class-inst-vars><imports></imports><category>Browser-Change Objects</category><attributes><package>Browser-ChangeObjects</package></attributes></class><class><name>AddClassChange</name><environment>Refactory.Browser</environment><super>Refactory.Browser.ExecuteCodeChange</super><private>false</private><indexed-type>none</indexed-type><inst-vars>superclassName instanceVariableNames classInstanceVariableNames imports indexedType attributes </inst-vars><class-inst-vars></class-inst-vars><imports></imports><category>Browser-Change Objects</category><attributes><package>Browser-ChangeObjects</package></attributes></class><class><name>False</name><environment>Core</environment><super>Core.Boolean</super><private>false</private><indexed-type>none</indexed-type><inst-vars></inst-vars><class-inst-vars></class-inst-vars><imports></imports><category>Kernel-Objects</category><attributes><package>Kernel-Objects</package></attributes></class><class><name>ClassBlueprint</name><environment>Tools</environment><super>Tools.NamespaceBlueprint</super><private>false</private><indexed-type>none</indexed-type><inst-vars>superclassReference attributes behaviorType instanceVariables classInstanceVariables </inst-vars><class-inst-vars></class-inst-vars><imports></imports><category></category><attributes><package>Tools-Blueprints</package></attributes></class><class><name>True</name><environment>Core</environment><super>Core.Boolean</super><private>false</private><indexed-type>none</indexed-type><inst-vars></inst-vars><class-inst-vars></class-inst-vars><imports></imports><category>Kernel-Objects</category><attributes><package>Kernel-Objects</package></attributes></class><class><name>Number</name><environment>Core</environment><super>Core.ArithmeticValue</super><private>false</private><indexed-type>none</indexed-type><inst-vars></inst-vars><class-inst-vars></class-inst-vars><imports></imports><category>Magnitude-Numbers</category><attributes><package>Magnitude-Numbers</package></attributes></class><class><name>BrowserNavigator</name><environment>Refactory.Browser</environment><super>Refactory.Browser.AbstractBrowserNavigator</super><private>false</private><indexed-type>none</indexed-type><inst-vars>history future </inst-vars><class-inst-vars></class-inst-vars><imports></imports><category>Browser-Navigator</category><attributes><package>Browser-BrowserUI</package></attributes></class><class><name>CodeComponentPropertyBlueprint</name><environment>Tools</environment><super>Tools.AbstractBlueprint</super><private>false</private><indexed-type>none</indexed-type><inst-vars>codeComponentName key value isBundle </inst-vars><class-inst-vars></class-inst-vars><imports></imports><category></category><attributes><package>Tools-Blueprints</package></attributes></class></st-source>