| package | package := Package name: 'CJDCodeExtractor'. package paxVersion: 0; basicComment: 'Copyright 2003 Christopher J. Demers Use at your own risk. Do not redistribute changes without permission. CJD 4-2-2002 Extract all code required for package to eb deployed into a file that can be filed into an virgin image. This will include resources.'. package basicPackageVersion: '0.002'. package classNames add: #CJDCodeExtractor; yourself. package methodNames add: #Package -> #cjdAllPrerequisitesRobust; add: #Package -> #cjdAllPrerequisitesRobust:; yourself. package binaryGlobalNames: (Set new yourself). package globalAliases: (Set new yourself). package allResourceNames: (Set new yourself). package setPrerequisites: (IdentitySet new add: '..\Object Arts\Dolphin\Base\Dolphin'; yourself). package! "Class Definitions"! Object subclass: #CJDCodeExtractor instanceVariableNames: 'sourceFiler rootPackage prerequisitePackages' classVariableNames: '' poolDictionaries: '' classInstanceVariableNames: ''! "Global Aliases"! "Loose Methods"! !Package methodsFor! cjdAllPrerequisitesRobust "cdemers - 11/30/2001 Added to return prerequsites and handle cyclic refferences." "Private - Answer a collection of all the Packages objects which must be loaded in before the receiver may be loaded in." | beenThere | beenThere := Set new: 10. ^self cjdAllPrerequisitesRobust: beenThere! cjdAllPrerequisitesRobust: beenThere "cdemers - 11/30/2001 Added to return prerequsites and handle cyclic refferences." "(self name = 'MitSciEMACUI') ifTrue: [self halt]." | required | required := self prerequisites. required copy do: [:each | "(self name = 'MitSciEMACSearle') ifTrue: [self halt]. (each name = 'MitSciEMACUI') ifTrue: [self halt]." (beenThere includes: each) ifFalse: [beenThere add: each. required addAll: (each cjdAllPrerequisitesRobust: beenThere)]]. ^required! ! !Package categoriesFor: #cjdAllPrerequisitesRobust!accessing!private! ! !Package categoriesFor: #cjdAllPrerequisitesRobust:!accessing!private! ! "End of package definition"! "Source Globals"! "Classes"! CJDCodeExtractor guid: (GUID fromString: '{E1C930C3-6558-4C79-8A3B-B551822983DE}')! CJDCodeExtractor comment: ''! !CJDCodeExtractor categoriesForClass!Unclassified! ! !CJDCodeExtractor methodsFor! environment "Private - Answer the global name associated with the receiver." ^Smalltalk! excludeFromExportPackages ^self systemPackages! extractForPackage: packageName toPath: pathName "cdemers - 4/2/2002" rootPackage := PackageManager current packageNamed: packageName. sourceFiler := ChunkSourceFiler on: (FileStream write: (File composePath: pathName stem: rootPackage name extension: 'pac')). prerequisitePackages := rootPackage cjdAllPrerequisitesRobust. prerequisitePackages add: rootPackage. "Remove the packages we do not want to export." prerequisitePackages := prerequisitePackages reject: [:eachPackage | self excludeFromExportPackages includes: eachPackage name]. "cdemers - 7/30/2002 Fine out package header." self writeMainPackageHeader. "Source Globals (pools) Only." prerequisitePackages do: [:eachPackage | self fileOutSourceGlobalsForPackage: eachPackage]. "Class Deffinitons Only." self fileOutClassDefinitionsForAllPackages. "prerequisitePackages do: [:eachPackage | self fileOutClassDefinitionsForPackage: eachPackage]." "Binary Globals Only." prerequisitePackages do: [:eachPackage | self fileOutBinaryGlobalsForPackage: eachPackage]. "Class Code Only." prerequisitePackages doWithProgress: [:eachPackage | self fileOutClassesForPackage: eachPackage] caption: 'Code exporting...'. "Loose Methods Only." prerequisitePackages do: [:eachPackage | self fileOutLooseMethodsForPackage: eachPackage]. "Resource Deffinitions Only." prerequisitePackages doWithProgress: [:eachPackage | self fileOutResourcesForPackage: eachPackage] caption: 'Resources exporting...'. sourceFiler close. MessageBox notify: 'Done Exporting!!'! fileOutBinaryGlobalsForPackage: package "Private - cdemers - 4/2/2002" package binaryGlobalNames do: [:each | (sourceFiler stream) nextPutAll: 'Smalltalk at: #' , each , ' put: nil!!'; cr]. ^package fileOutBinaryGlobalsOn: sourceFiler! fileOutClassDefinitionsForAllPackages "Private - cdemers - 4/2/2002" | classes | classes := Set new. prerequisitePackages do: [:eachPrerequsit | classes addAll: eachPrerequsit classes]. (self environment allClasses intersection: classes) do: [:eachClass | sourceFiler fileOutDefinitionOfClass: eachClass "eachClass fileOutDefinitionOn: fileStream"]! fileOutClassDefinitionsForPackage: package "Private - cdemers - 4/2/2002 File out just the class deffinitions for package." package fileOutClassDefinitionsOn: sourceFiler! fileOutClassesForPackage: package "Private - cdemers - 4/2/2002 File out just the classes for package." package fileOutClassesOn: sourceFiler! fileOutLooseMethodsForPackage: package "Private - cdemers - 4/2/2002 File out just the loose method deffinitions for package." package fileOutLooseMethodsOn: sourceFiler! fileOutResourceDefinitionsForPackage: package "Private - cdemers - 4/2/2002 File out just the resource deffinitions for package." package fileOutResourceDefinitionsOn: sourceFiler! fileOutResourcesForPackage: package "Private - cdemers - 4/2/2002 File out just the resource deffinitions for package." package fileOutResourcesOn: sourceFiler! fileOutSourceGlobalsForPackage: package "Private - cdemers - 4/2/2002 File out just the source globals (pools) for package." package fileOutSourceGlobalsOn: sourceFiler! hasTrailingStatementSeperator: aMethodCodeString "Private - CJD 7-2-2001 Check aString to see if it has a trailing statement seperator. This may be overkill, I had been using a much simpler approach to check this, but I suppose I should do this more robust check for the sake of completeness. Returns true if aMethodCodeString ends with a statement seperator (.) or false if it does not." | inComment inString lastSeperator lastStatement | "Find the last statement seperator." inString := inComment := false. lastSeperator := aMethodCodeString findLast: [:ch | ch = $" ifTrue: [inComment := inComment not]. ch = $' ifTrue: [inString := inString not]. ch = $. & (inString | inComment) not]. "Now see if there is another statement after it." inString := inComment := false. lastStatement := aMethodCodeString findLast: [:ch | ch = $" ifTrue: [inComment := inComment not]. ch = $' ifTrue: [inString := inString not]. ch isAlphaNumeric & (inString | inComment) not]. ^lastSeperator - lastStatement > 0.! systemPackages "Private - cdemers - 4/2/2002 Return a collection of all OA packages." ^##((PackageManager current packages select: [:eachPackage | (( '*Object Arts*' match: eachPackage path) or: [ '*Refactory*' match: eachPackage path]) or: [ '*ToolsPlus*' match: eachPackage path]]) collect: [:eachPackage | eachPackage name]) "^#('Hello World' 'XML DOM' 'Windows Registry' 'Web Plugin Builder' 'Notepad' 'ActiveX Control Hosting' 'ActiveX Control Browser' 'OLE Structured Storage' 'Standard Edition Tools' 'OLE COM' 'AvatarChat' 'Web Deployment Kit' 'Hello World (Console)' 'Database Connection' 'Windows Shell' 'ActiveX Categories' 'Scribble' 'Application Deployment Kit' 'DolphinSure' 'Playground' 'Internet Explorer' 'Dolphin' 'AgentObjects' 'EnumRECT' 'Sockets Connection' 'ActiveX Automation' 'Etch-a-Sketch' 'ActiveX Scripting' 'Simple Web Browser' 'ColorPickerApplet' 'Chat' 'OLE Persistence Base' 'ActiveX Connection Points' 'RegEdit' 'Value Edition Tools' 'Hello World Applet' 'Calculator' 'Development System' 'Calculator (Console)' 'Catenate' 'PersonalMoney' 'Video Library')"! writeMainPackageHeader "Private - cdemers - 7/30/2002 Write the main package header." | scriptString | sourceFiler stream nextPutAll: '| package | package := Package name: ''' , rootPackage name , '''. package paxVersion: 0; basicComment: ''Deployment Package''. package basicPackageVersion: ''0.0.0''.'; cr; cr. sourceFiler stream nextPutAll: 'package basicScriptAt: #preinstall put: '''. prerequisitePackages do: [:eachPackage | scriptString := (eachPackage scriptAt: #preinstall) copyWithout: $!!. "Too heavy handed, but works in a pinch for now." scriptString notEmpty ifTrue: [sourceFiler stream cr; nextPutAll: '"From ' , eachPackage name , '"'; cr; "\/ Yucky code, but I am in a hurry." nextPutAll: (scriptString printString copyFrom: 2 to: scriptString printString size - 1). (self hasTrailingStatementSeperator: scriptString) ifFalse: [sourceFiler stream nextPut: $.]. sourceFiler stream cr]]. sourceFiler stream nextPutAll: '''.'; cr; cr. rootPackage savePAXStripperBytesOn: sourceFiler stream. sourceFiler stream cr. prerequisitePackages do: [:eachPrerequsit | eachPrerequsit savePAXNamesOn: sourceFiler stream]. sourceFiler stream nextPutAll: ' package setPrerequisites: (IdentitySet new). package!!'; cr.! ! !CJDCodeExtractor categoriesFor: #environment!private! ! !CJDCodeExtractor categoriesFor: #excludeFromExportPackages!private! ! !CJDCodeExtractor categoriesFor: #extractForPackage:toPath:!public! ! !CJDCodeExtractor categoriesFor: #fileOutBinaryGlobalsForPackage:!private! ! !CJDCodeExtractor categoriesFor: #fileOutClassDefinitionsForAllPackages!private! ! !CJDCodeExtractor categoriesFor: #fileOutClassDefinitionsForPackage:!private! ! !CJDCodeExtractor categoriesFor: #fileOutClassesForPackage:!private! ! !CJDCodeExtractor categoriesFor: #fileOutLooseMethodsForPackage:!private! ! !CJDCodeExtractor categoriesFor: #fileOutResourceDefinitionsForPackage:!private! ! !CJDCodeExtractor categoriesFor: #fileOutResourcesForPackage:!private! ! !CJDCodeExtractor categoriesFor: #fileOutSourceGlobalsForPackage:!private! ! !CJDCodeExtractor categoriesFor: #hasTrailingStatementSeperator:!private! ! !CJDCodeExtractor categoriesFor: #systemPackages!private! ! !CJDCodeExtractor categoriesFor: #writeMainPackageHeader!private! ! !CJDCodeExtractor class methodsFor! extractForPackage: packageName toPath: fileName "cdemers - 7/30/2002 Main entry point, make a new instance, and extract the code." | obj | obj := self new. obj extractForPackage: packageName toPath: fileName. ^obj! ! !CJDCodeExtractor class categoriesFor: #extractForPackage:toPath:!public! ! "Binary Globals"! "Resources"!