'From Squeak3.7alpha of ''11 September 2003'' [latest update: #5497] on 26 October 2003 at 1:48:20 pm'! "Change Set: KCP-0107-ImageNameToSmalltalkImage Date: 24 September 2003 Author: stephane ducasse Extracted image path and name to move that in SmalltalkImage v3: SmalltalkImage current v4: Fixed imageName: v5: fixed one conflict -- md"! Object subclass: #SmalltalkImage instanceVariableNames: '' classVariableNames: 'LastStats SourceFileVersionString ' poolDictionaries: '' category: 'System-Support'! !CodeHolder methodsFor: 'message list' stamp: 'sd 9/30/2003 14:01'! validateMessageSource: sourceString forSelector: aSelector "Check whether there is evidence that method source is invalid" | sourcesName | (self selectedClass compilerClass == Object compilerClass and: [(sourceString asString findString: aSelector keywords first ) ~= 1]) ifTrue: [sourcesName _ FileDirectory localNameFor: SmalltalkImage current sourcesName. self inform: 'There may be a problem with your sources file!! The source code for every method should (usually) start with the method selector but this is not the case with this method!! You may proceed with caution but it is recommended that you get a new source file. This can happen if you download the "' , sourcesName , '" file, or the ".changes" file you use, as TEXT. It must be transfered in BINARY mode, even if it looks like a text file, to preserve the CR line ends. Mac users: This may have been caused by Stuffit Expander. To prevent the files above to be converted to Mac line ends when they are expanded, do this: Start the program, then from Preferences... in the File menu, choose the Cross Platform panel, then select "Never" and press OK. Then expand the compressed archive again. (Occasionally, the source code for a method may legitimately start with a non-alphabetic character -- for example, Behavior method #formalHeaderPartsFor:. In such rare cases, you can happily disregard this warning.)'].! ! !ExternalSettings class methodsFor: '-- all --' stamp: 'sd 9/30/2003 14:01'! preferenceDirectory | prefDirName path | prefDirName := self preferenceDirectoryName. path := SmalltalkImage current vmPath. ^(FileDirectory default directoryExists: prefDirName) ifTrue: [FileDirectory default directoryNamed: prefDirName] ifFalse: [ ((FileDirectory on: path) directoryExists: prefDirName) ifTrue: [(FileDirectory on: path) directoryNamed: prefDirName] ifFalse: [nil]] ! ! !FileDirectory class methodsFor: 'name utilities' stamp: 'sd 9/30/2003 14:01'! startUp "Establish the platform-specific FileDirectory subclass. Do any platform-specific startup." self setDefaultDirectoryFrom: SmalltalkImage current imageName. Preferences startInUntrustedDirectory ifTrue:[ self setDefaultDirectory: SecurityManager default untrustedUserDirectory. "Make sure we have a place to go to" DefaultDirectory assureExistence]. Smalltalk openSourceFiles. ! ! !FileDirectory class methodsFor: 'create/delete file' stamp: 'sd 9/30/2003 14:01'! lookInUsualPlaces: fileName "Check the default directory, the imagePath, and the vmPath (and the vmPath's owner) for this file." | vmp | (FileDirectory default fileExists: fileName) ifTrue: [^ FileDirectory default fileNamed: fileName]. ((vmp _ FileDirectory on: SmalltalkImage current imagePath) fileExists: fileName) ifTrue: [^ vmp fileNamed: fileName]. ((vmp _ FileDirectory on: SmalltalkImage current vmPath) fileExists: fileName) ifTrue: [^ vmp fileNamed: fileName]. ((vmp _ vmp containingDirectory) fileExists: fileName) ifTrue: [^ vmp fileNamed: fileName]. ^ nil! ! !FileDirectory class methodsFor: 'system start up' stamp: 'sd 9/30/2003 14:01'! openSources: fullSourcesName forImage: imageName "Initialize the default directory to the image directory and open the sources and changes files, if possible. Look for the changes file in image directory. Look for the system sources (or an alias to it) first in the VM directory, then in the image directory. Open the changes and sources files and install them in SourceFiles." | sources fd sourcesName | sourcesName _ FileDirectory localNameFor: fullSourcesName. "look for the sources file or an alias to it in the VM's directory" fd _ FileDirectory on: SmalltalkImage current vmPath. (fd fileExists: sourcesName) ifTrue: [sources _ fd readOnlyFileNamed: sourcesName]. sources ifNotNil:[^sources]. "look for the sources file or an alias to it in the image directory" fd _ FileDirectory on: (FileDirectory dirPathFor: imageName). (fd fileExists: sourcesName) ifTrue: [sources _ fd readOnlyFileNamed: sourcesName]. sources ifNotNil:[^sources]. "look for the sources in the current directory" fd _ DefaultDirectory. (fd fileExists: sourcesName) ifTrue: [sources _ fd readOnlyFileNamed: sourcesName]. ^sources ! ! !ImageSegment class methodsFor: 'fileIn/Out' stamp: 'sd 9/30/2003 14:02'! folder | im | "Full path name of segments folder. Be sure to duplicate and rename the folder when you duplicate and rename an image. Is $_ legal in all file systems?" im _ SmalltalkImage current imageName. ^ (im copyFrom: 1 to: im size - 6 "'.image' size"), '_segs'! ! !SmalltalkImage methodsFor: 'image, changes names' stamp: 'sd 9/24/2003 12:51'! imageName "Answer the full path name for the current image." "SmalltalkImage current imageName" self primitiveFailed! ! !SmalltalkImage methodsFor: 'image, changes names' stamp: 'sd 10/11/2003 12:05'! imageName: newName "Set the the full path name for the current image. All further snapshots will use this." ^ self primitiveFailed! ! !SmalltalkImage methodsFor: 'image, changes names' stamp: 'sd 9/24/2003 12:43'! sourceFileVersionString ^ SourceFileVersionString! ! !SmalltalkImage methodsFor: 'image, changes names' stamp: 'sd 9/24/2003 12:44'! sourcesName "Answer the full path to the version-stable source code" ^ self vmPath , SourceFileVersionString , FileDirectory dot , 'sources'! ! !SmalltalkImage methodsFor: 'image, changes names' stamp: 'sd 9/24/2003 12:46'! vmPath "Answer the path for the directory containing the Smalltalk virtual machine. Return the empty string if this primitive is not implemented." "SmalltalkImage current vmPath" ^ ''! ! !SmalltalkImage methodsFor: 'private source file' stamp: 'sd 9/24/2003 12:42'! sourceFileVersionString: aString SourceFileVersionString := aString! ! !SystemDictionary methodsFor: 'housekeeping' stamp: 'sd 9/30/2003 14:02'! condenseSources "Move all the changes onto a compacted sources file." "Smalltalk condenseSources" | f classCount dir newVersionString | Utilities fixUpProblemsWithAllCategory. "The above removes any concrete, spurious '-- all --' categories, which mess up the process." dir _ FileDirectory default. newVersionString _ FillInTheBlank request: 'Please designate the version for the new source code file...' initialAnswer: SourceFileVersionString. newVersionString ifNil: [^ self]. newVersionString = SourceFileVersionString ifTrue: [^ self error: 'The new source file must not be the same as the old.']. SourceFileVersionString _ newVersionString. "Write all sources with fileIndex 1" f _ FileStream newFileNamed: SmalltalkImage current sourcesName. f header; timeStamp. 'Condensing Sources File...' displayProgressAt: Sensor cursorPoint from: 0 to: Smalltalk classNames size during: [:bar | classCount _ 0. Smalltalk allClassesDo: [:class | bar value: (classCount _ classCount + 1). class fileOutOn: f moveSource: true toFile: 1]]. f trailer; close. "Make a new empty changes file" self closeSourceFiles. dir rename: self changesName toBe: self changesName , '.old'. (FileStream newFileNamed: self changesName) header; timeStamp; close. LastQuitLogPosition _ 0. self setMacFileInfoOn: self changesName. self setMacFileInfoOn: SmalltalkImage current sourcesName. self openSourceFiles. self inform: 'Source files have been rewritten!! Check that all is well, and then save/quit.'! ! !SystemDictionary methodsFor: 'image, changes name' stamp: 'sd 10/11/2003 13:25'! changeImageNameTo: aString SmalltalkImage current imageName: aString. LastImageName _ SmalltalkImage current imageName! ! !SystemDictionary methodsFor: 'image, changes name' stamp: 'sd 9/30/2003 14:02'! changesName "Answer the local name for the changes file corresponding to the image file name." "Smalltalk changesName" | imName | imName _ FileDirectory baseNameFor: (FileDirectory localNameFor: SmalltalkImage current imageName). ^ imName, FileDirectory dot, 'changes' ! ! !SystemDictionary methodsFor: 'image, changes name' stamp: 'sd 10/11/2003 12:10'! imageName "Answer the full path name for the current image." "Smalltalk imageName" ^ self deprecated: [self imageNameDeprecatedPrimitive] explanation: 'Use SmalltalkImage crrent imageName' ! ! !SystemDictionary methodsFor: 'image, changes name' stamp: 'sd 10/11/2003 12:10'! imageName: newName "Set the the full path name for the current image. All further snapshots will use this." ^ self deprecated: [self imageNameDeprecatedPrimitive: newName] explanation: 'Use SmalltalkImage crrent imageName' ! ! !SystemDictionary methodsFor: 'image, changes name' stamp: 'sd 10/11/2003 12:09'! imageNameDeprecatedPrimitive "Answer the full path name for the current image." "Smalltalk imageName" self primitiveFailed! ! !SystemDictionary methodsFor: 'image, changes name' stamp: 'sd 10/11/2003 12:09'! imageNameDeprecatedPrimitive: newName "Set the the full path name for the current image. All further snapshots will use this." ^ self primitiveFailed! ! !SystemDictionary methodsFor: 'image, changes name' stamp: 'sd 9/30/2003 14:02'! imagePath "Answer the path for the directory containing the image file." "Smalltalk imagePath" ^ FileDirectory dirPathFor: SmalltalkImage current imageName ! ! !SystemDictionary methodsFor: 'image, changes name' stamp: 'sd 9/24/2003 12:48'! sourcesName "Answer the full path to the version-stable source code" self deprecatedExplanation: 'Use SmalltalkImage current sourcesName'. ^ self vmPath , SourceFileVersionString , FileDirectory dot , 'sources'! ! !SystemDictionary methodsFor: 'image, changes name' stamp: 'sd 9/24/2003 12:50'! vmPath "Answer the path for the directory containing the Smalltalk virtual machine. Return the empty string if this primitive is not implemented." "Smalltalk vmPath" ^ self deprecated: [self vmPathDeprecatedPrimitive] explanation: 'Use SmalltalkImage current vmPath'! ! !SystemDictionary methodsFor: 'image, changes name' stamp: 'sd 9/24/2003 12:49'! vmPathDeprecatedPrimitive "Answer the path for the directory containing the Smalltalk virtual machine. Return the empty string if this primitive is not implemented." "Smalltalk vmPath" ^ ''! ! !SystemDictionary methodsFor: 'snapshot and quit' stamp: 'sd 9/30/2003 14:02'! getFileNameFromUser | newName | newName _ FillInTheBlank request: 'New File Name?' initialAnswer: (FileDirectory localNameFor: SmalltalkImage current imageName). newName = '' ifTrue: [^nil]. ((FileDirectory default includesKey: (self fullNameForImageNamed: newName)) or: [FileDirectory default includesKey: (self fullNameForChangesNamed: newName)]) ifTrue: [ (self confirm: newName, ' already exists. Overwrite?') ifFalse: [^nil]]. ^newName ! ! !SystemDictionary methodsFor: 'snapshot and quit' stamp: 'sd 9/30/2003 14:03'! readDocumentFile "No longer used. Everything is now done in ProjectLauncher." StartupStamp _ '----STARTUP----', Time dateAndTimeNow printString, ' as ', SmalltalkImage current imageName. ! ! !SystemDictionary methodsFor: 'snapshot and quit' stamp: 'sd 9/30/2003 14:03'! saveAsEmbeddedImage "Save the current state of the system as an embedded image" | dir newName newImageName newImageSegDir oldImageSegDir haveSegs | dir _ FileDirectory default. newName _ FillInTheBlank request: 'Select existing VM file' initialAnswer: (FileDirectory localNameFor: ''). newName = '' ifTrue: [^ self]. newName _ FileDirectory baseNameFor: newName asFileName. newImageName _ newName. (dir includesKey: newImageName) ifFalse: [^ self inform: 'Unable to find name ', newName, ' Please choose another name.']. haveSegs _ false. Smalltalk at: #ImageSegment ifPresent: [:theClass | (haveSegs _ theClass instanceCount ~= 0) ifTrue: [oldImageSegDir _ theClass segmentDirectory]]. self logChange: '----SAVEAS (EMBEDDED) ', newName, '----', Date dateAndTimeNow printString. self imageName: (dir fullNameFor: newImageName). LastImageName _ SmalltalkImage current imageName. self closeSourceFiles. haveSegs ifTrue: [Smalltalk at: #ImageSegment ifPresent: [:theClass | newImageSegDir _ theClass segmentDirectory. "create the folder" oldImageSegDir fileNames do: [:theName | "copy all segment files" newImageSegDir copyFileNamed: oldImageSegDir pathName, FileDirectory slash, theName toFileNamed: theName]]]. self snapshot: true andQuit: true embedded: true ! ! !SystemDictionary methodsFor: 'snapshot and quit' stamp: 'sd 9/30/2003 14:03'! saveAsNewVersion "Save the image/changes using the next available version number." "Smalltalk saveAsNewVersion" | newName changesName aName anIndex | aName _ FileDirectory baseNameFor: (FileDirectory default localNameFor: SmalltalkImage current imageName). anIndex _ aName lastIndexOf: FileDirectory dot asCharacter ifAbsent: [nil]. (anIndex notNil and: [(aName copyFrom: anIndex + 1 to: aName size) isAllDigits]) ifTrue: [aName _ aName copyFrom: 1 to: anIndex - 1]. newName _ FileDirectory default nextNameFor: aName extension: FileDirectory imageSuffix. changesName _ self fullNameForChangesNamed: newName. "Check to see if there is a .changes file that would cause a problem if we saved a new .image file with the new version number" (FileDirectory default includesKey: changesName) ifTrue: [^ self inform: 'There is already .changes file of the desired name, ', newName, ' curiously already present, even though there is no corresponding .image file. Please remedy manually and then repeat your request.']. (SourceFiles at: 2) ifNotNil: [self saveChangesInFileNamed: (self fullNameForChangesNamed: newName)]. self saveImageInFileNamed: (self fullNameForImageNamed: newName) ! ! !SystemDictionary methodsFor: 'snapshot and quit' stamp: 'md 10/26/2003 13:29'! snapshot: save andQuit: quit embedded: embeddedFlag "Mark the changes file and close all files. If save is true, save the current state of this Smalltalk in the image file. If quit is true, then exit to the outer shell. The latter part of this method runs when resuming a previously saved image. The resume logic checks for a document file to process when starting up." | resuming msg | Object flushDependents. Object flushEvents. (SourceFiles at: 2) ifNotNil:[ msg _ String streamContents: [ :s | s nextPutAll: '----'; nextPutAll: (save ifTrue: [ quit ifTrue: [ 'QUIT' ] ifFalse: [ 'SNAPSHOT' ] ] ifFalse: [quit ifTrue: [ 'QUIT/NOSAVE' ] ifFalse: [ 'NOP' ]]); nextPutAll: '----'; print: Date dateAndTimeNow; space; nextPutAll: (FileDirectory default localNameFor: SmalltalkImage current imageName); nextPutAll: ' priorSource: '; print: LastQuitLogPosition ]. self assureStartupStampLogged. save ifTrue: [ LastQuitLogPosition _ (SourceFiles at: 2) setToEnd; position ]. self logChange: msg. Transcript cr; show: msg ]. self processShutDownList: quit. Cursor write show. save ifTrue: [resuming _ embeddedFlag ifTrue: [self snapshotEmbeddedPrimitive] ifFalse: [self snapshotPrimitive]. "<-- PC frozen here on image file" resuming == false "guard against failure" ifTrue: ["Time to reclaim segment files is immediately after a save" Smalltalk at: #ImageSegment ifPresent: [:theClass | theClass reclaimObsoleteSegmentFiles]]] ifFalse: [resuming _ false]. quit & (resuming == false) ifTrue: [self quitPrimitive]. Cursor normal show. self setGCParameters. resuming == true ifTrue: [self clearExternalObjects]. self processStartUpList: resuming == true. resuming == true ifTrue:[ SmalltalkImage current setPlatformPreferences. self readDocumentFile]. Smalltalk isMorphic ifTrue: [SystemWindow wakeUpTopWindowUponStartup]. "Now it's time to raise an error" resuming == nil ifTrue: [self error:'Failed to write image file (disk full?)']. ^ resuming! ! !SystemDictionary methodsFor: 'sources, change log' stamp: 'sd 9/30/2003 14:02'! externalizeSources "Write the sources and changes streams onto external files." "Smalltalk externalizeSources" | sourcesName changesName aFile | sourcesName _ SmalltalkImage current sourcesName. (FileDirectory default fileExists: sourcesName) ifTrue: [^ self inform: 'Sorry, you must first move or remove the file named ', sourcesName]. changesName _ self changesName. (FileDirectory default fileExists: changesName) ifTrue: [^ self inform: 'Sorry, you must first move or remove the file named ', changesName]. aFile _ FileStream newFileNamed: sourcesName. aFile nextPutAll: SourceFiles first originalContents. aFile close. self setMacFileInfoOn: sourcesName. SourceFiles at: 1 put: (FileStream readOnlyFileNamed: sourcesName). aFile _ FileStream newFileNamed: self changesName. aFile nextPutAll: SourceFiles last contents. aFile close. "On Mac, set the file type and creator (noop on other platforms)" FileDirectory default setMacFileNamed: self changesName type: 'STch' creator: 'FAST'. SourceFiles at: 2 put: (FileStream oldFileNamed: changesName). self inform: 'Sources successfully externalized'. ! ! !SystemDictionary methodsFor: 'sources, change log' stamp: 'sd 9/30/2003 14:02'! internalizeSources "Smalltalk internalizeSources" "Bring the sources and changes files into memory-resident filestreams, for faster access and freedom from file-system interface. 1/29/96 sw" | reply aName aFile | reply _ self confirm: 'CAUTION -- do not undertake this lightly!! If you have backed up your system and are prepared to face the consequences of the requested internalization of sources, hit Yes. If you have any doubts, hit No to back out with no harm done.'. (reply == true) ifFalse: [^ self inform: 'Okay - abandoned']. aName _ SmalltalkImage current sourcesName. (aFile _ SourceFiles first) == nil ifTrue: [(FileDirectory default fileExists: aName) ifFalse: [^ self halt: 'Cannot locate ', aName, ' so cannot proceed.']. aFile _ FileStream readOnlyFileNamed: aName]. SourceFiles at: 1 put: (ReadWriteStream with: aFile contentsOfEntireFile). aName _ self changesName. (aFile _ SourceFiles last) == nil ifTrue: [(FileDirectory default fileExists: aName) ifFalse: [^ self halt: 'Cannot locate ', aName, ' so cannot proceed.']. aFile _ FileStream readOnlyFileNamed: aName]. SourceFiles at: 2 put: (ReadWriteStream with: aFile contentsOfEntireFile). self inform: 'Okay, sources internalized'! ! !SystemDictionary methodsFor: 'sources, change log' stamp: 'sd 9/30/2003 14:04'! openSourceFiles SmalltalkImage current imageName = LastImageName ifFalse: ["Reset the author initials to blank when the image gets moved" LastImageName _ SmalltalkImage current imageName. Utilities setAuthorInitials: '']. FileDirectory openSources: SmalltalkImage current sourcesName andChanges: self changesName forImage: LastImageName. StandardSourceFileArray install! ! "Postscript: Leave the line above, and replace the rest of this comment by a useful one. Executable statements should follow this comment, and should be separated by periods, with no exclamation points (!!). Be sure to put any further comments in double-quotes, like this one." SmalltalkImage current sourceFileVersionString: 'SqueakV3'!