'From Squeak3.1alpha of 28 February 2001 [latest update: #4284] on 23 August 2001 at 7:07:26 pm'! "Change Set: pluginFixes Date: 23 August 2001 Author: Andreas Raab, Michael Rueger Fixes a number of bugs relating to project loading and storing. - added reset inital preference settings to the squeakland release process - fixes saving project to local disc when external resource are present - reload the cached resources when the resource dictionary gets installed the first time."! !PasteUpMorph methodsFor: 'menu & halo' stamp: 'mir 8/23/2001 16:58'! saveOnFile "Ask the user for a filename and save myself on a SmartReferenceStream file. Writes out the version and class structure. The file is fileIn-able. UniClasses will be filed out." | aFileName fileStream ok | self flag: #bob0302. self isWorldMorph ifTrue: [^self project saveAs]. aFileName _ ('my ', self class name) asFileName. "do better?" aFileName _ FillInTheBlank request: 'File name? (".project" will be added to end)' initialAnswer: aFileName. aFileName size == 0 ifTrue: [^ self beep]. self allMorphsDo: [:m | m prepareToBeSaved]. ok _ aFileName endsWith: '.project'. "don't double them" ok _ ok | (aFileName endsWith: '.sp'). ok ifFalse: [aFileName _ aFileName,'.project']. fileStream _ FileStream newFileNamed: aFileName. fileStream fileOutClass: nil andObject: self. "Puts UniClass definitions out anyway"! ! !Project methodsFor: 'file in/out' stamp: 'mir 8/23/2001 17:10'! storeOnServerInnards "Save to disk as an Export Segment. Then put that file on the server I came from, as a new version. Version is literal piece of file name. Mime encoded and http encoded." | resp newName primaryServerDirectory serverVersionPair localDirectory localVersionPair myVersionNumber warning maxNumber suppliedPassword oldResourceUrl | self assureIntegerVersion. "Find out what version" primaryServerDirectory _ self primaryServerIfNil: [ (primaryServerDirectory _ self findAFolderToStoreProjectIn) ifNil: [^self]. oldResourceUrl _ self resourceUrl. primaryServerDirectory == #localOnly ifTrue: [ self storeNewPrimaryURL: FileDirectory default pathName asUrl downloadUrl. nil ] ifFalse: [ self storeNewPrimaryURL: primaryServerDirectory downloadUrl. primaryServerDirectory ]. ]. localDirectory _ self squeakletDirectory. serverVersionPair _ self class mostRecent: self name onServer: primaryServerDirectory. localVersionPair _ self class mostRecent: self name onServer: localDirectory. maxNumber _ myVersionNumber _ self currentVersionNumber. ProgressNotification signal: '2:versionsDetected'. warning _ ''. myVersionNumber < serverVersionPair second ifTrue: [ warning _ warning,'\There are newer version(s) on the server'. maxNumber _ maxNumber max: serverVersionPair second. ]. myVersionNumber < localVersionPair second ifTrue: [ warning _ warning,'\There are newer version(s) in the local directory'. maxNumber _ maxNumber max: localVersionPair second. ]. "8 Nov 2000 - only check on the first attempt to publish" myVersionNumber = 0 ifTrue: [ warning isEmpty ifFalse: [ myVersionNumber = 0 ifTrue: [ warning _ warning,'\THIS PROJECT HAS NEVER BEEN SAVED' ]. warning _ 'WARNING', '\Project: ',self name,warning. resp _ (PopUpMenu labels: 'Store anyway\Cancel' withCRs) startUpWithCaption: (warning, '\Please cancel, rename this project, and see what is there.') withCRs. resp ~= 1 ifTrue: [^ nil] ]. ]. version _ self bumpVersion: maxNumber. oldResourceUrl ifNotNil: [self resourceManager adjustToNewServer: self resourceUrl from: oldResourceUrl]. "write locally - now zipped automatically" newName _ self versionedFileName. lastSavedAtSeconds _ Time totalSeconds. self exportSegmentFileName: newName directory: localDirectory. ProgressNotification signal: '4:localSaveComplete'. "3 is deep in export logic" primaryServerDirectory ifNotNil: [ suppliedPassword _ ''. Preferences passwordsOnPublish ifTrue: [ suppliedPassword _ FillInTheBlank requestPassword: 'Project password' ]. [ self writeFileNamed: newName fromDirectory: localDirectory toServer: primaryServerDirectory. ] on: ProjectPasswordNotification do: [ :ex | ex resume: (suppliedPassword ifNil: ['']) ]. ]. ProgressNotification signal: '9999 save complete'. "Later, store with same name on secondary servers. Still can be race conditions. All machines will go through the server list in the same order." "2 to: servers size do: [:aServer | aServer putFile: local named: newName]." ! ! !ResourceManager methodsFor: 'accessing' stamp: 'mir 8/23/2001 17:20'! adjustToNewServer: newResourceUrl from: oldResourceUrl "Adjust the resource manager to the current download location. A project might have been moved manually to a different location or server." | urlMap oldUrl newUrl | newResourceUrl isEmptyOrNil ifTrue: [^self]. urlMap _ Dictionary new. self resourceMap keysDo: [:locator | "Local file refs are not handled well, so work around here" oldUrl _ ((oldResourceUrl includesSubString: '://') not and: [(locator urlString includesSubString: '://') not]) ifTrue: [oldResourceUrl , locator urlString] ifFalse: [locator urlString asUrlRelativeTo: oldResourceUrl asUrl]. newUrl _ ((newResourceUrl includesSubString: '://') not and: [(locator urlString includesSubString: '://') not]) ifTrue: [newResourceUrl , locator urlString] ifFalse: [locator urlString asUrlRelativeTo: newResourceUrl asUrl]. oldUrl ~= newUrl ifTrue: [urlMap at: oldUrl asString unescapePercents put: newUrl asString unescapePercents]]. self resourceMap rehash. unloaded rehash. urlMap keysAndValuesDo: [:old :new | ResourceManager renameCachedResource: old to: new]! ! !ResourceManager methodsFor: 'loading' stamp: 'mir 8/23/2001 18:33'! preLoadFromArchive: aZipArchive cacheName: aFileName "Load the resources from the given zip archive" | orig nameMap resMap loc stream | self class reloadCachedResources. resMap _ Dictionary new. nameMap _ Dictionary new. unloaded do:[:locator| locator localFileName: nil. nameMap at: locator urlString put: locator. resMap at: locator urlString put: (resourceMap at: locator)]. aZipArchive members do:[:entry| stream _ nil. orig _ resMap at: entry fileName ifAbsent:[nil]. loc _ nameMap at: entry fileName ifAbsent:[nil]. "note: orig and loc may be nil for non-resource members" (orig notNil and:[loc notNil]) ifTrue:[ stream _ entry contentStream. self installResource: orig from: stream locator: loc. stream reset. aFileName ifNil:[self class cacheResource: loc urlString stream: stream] ifNotNil:[self class cacheResource: loc urlString inArchive: aFileName]]. ].! ! !ResourceManager class methodsFor: 'resource caching' stamp: 'ar 8/23/2001 17:52'! resourceCache ^CachedResources ifNil:[ CachedResources _ Dictionary new. self reloadCachedResources. CachedResources].! ! !SystemDictionary methodsFor: 'housekeeping' stamp: 'mir 8/23/2001 18:47'! makeSqueaklandRelease "Smalltalk makeSqueaklandRelease" "NOTE: This method assumes that * ALL WINDOWS HAVE BEEN CLOSED (most importantly all project windows) * ALL GLOBAL FLAPS HAVE BEEN DESTROYED (not just disabled) This method may needs to be run twice - upon the first run you will probably receive an error message saying 'still have obsolete behaviors'. Close the notifier and try again. If there are still obsolete behaviors then go looking for them. Last update: ar 8/18/2001 01:14 for Squeak 3.1" | ss | (self confirm: self version , ' Is this the correct version designation? If not, choose no, and fix it.') ifFalse: [^ self]. "Delete all projects" Project allSubInstancesDo:[:p| (p == Project current) ifFalse:[Project deletingProject: p]. ]. "Fix up for some historical problem" Smalltalk allObjectsDo:[:o| o isMorph ifTrue:[o removeProperty: #undoGrabCommand]. ]. "Hm ... how did this come in?!!" Smalltalk keys do:[:x| (x class == String and:[(Smalltalk at: x) isBehavior]) ifTrue:[Smalltalk removeKey: x]. ]. "Remove stuff from References" References keys do:[:k| References removeKey: k]. "Reset command history" CommandHistory resetAllHistory. "Clean out Undeclared" Undeclared removeUnreferencedKeys. "Reset scripting system" StandardScriptingSystem initialize. "Reset preferences" Preferences chooseInitialSettings; installBrightWindowColors. "Do a nice fat GC" Smalltalk garbageCollect. "Dependents mean that we're holding onto stuff" (Object classPool at: #DependentsFields) size > 1 ifTrue: [self error:'Still have dependents']. "Set a few default preferences" #( (honorDesktopCmdKeys false) (warnIfNoChangesFile false) (warnIfNoSourcesFile false) (showDirectionForSketches true) (menuColorFromWorld false) (unlimitedPaintArea true) (useGlobalFlaps false) (mvcProjectsAllowed false) (projectViewsInWindows false) (automaticKeyGeneration true) (securityChecksEnabled true) (showSecurityStatus false) (startInUntrustedDirectory true) (warnAboutInsecureContent false) (promptForUpdateServer false) (fastDragWindowForMorphic false) ) do:[:spec| Preferences setPreference: spec first toValue: (spec last == #true). ]. "Initialize Browser (e.g., reset recent classes etc)" Browser initialize. "Check for Undeclared" Undeclared isEmpty ifFalse: [self error:'Please clean out Undeclared']. "Remove graphics we don't want" ScriptingSystem deletePrivateGraphics. "Remove a few text styles" #(Helvetica Palatino Courier) do: [:n | TextConstants removeKey: n ifAbsent: []]. "Dump all player uniclasses" Smalltalk at: #Player ifPresent:[:player| player allSubclassesDo:[:cls| cls isSystemDefined ifFalse:[cls removeFromSystem]]]. "Dump all Wonderland uniclasses" Smalltalk at: #WonderlandActor ifPresent:[:wnldActor| wnldActor allSubclassesDo:[:cls| cls isSystemDefined ifFalse:[cls removeFromSystem]]]. "Attempt to get rid of them" Smalltalk garbageCollect. "Now remove larger parts" Smalltalk discardFFI; discard3D; discardSUnit; discardSpeech; discardVMConstruction; discardPWS; discardIRC. "Dump change sets" ChangeSorter removeChangeSetsNamedSuchThat: [:cs| cs name ~= Smalltalk changes name]. "Clear current change set" Smalltalk changes clear. Smalltalk changes name: 'Unnamed1'. Smalltalk garbageCollect. "Reinitialize DataStream; it may hold on to some zapped entitities" DataStream initialize. "Remove refs to old ControlManager" ScheduledControllers _ nil. "Flush obsolete subclasses" Behavior flushObsoleteSubclasses. Smalltalk garbageCollect. Smalltalk obsoleteBehaviors isEmpty ifFalse:[self error:'Still have obsolete behaviors']. "Clear all server entries" ServerDirectory serverNames do: [:each | ServerDirectory removeServerNamed: each]. SystemVersion current resetHighestUpdate. ss _ Set allSubInstances. 'Rehashing all sets' displayProgressAt: Sensor cursorPoint from: 1 to: ss size during:[:bar| 1 to: ss size do:[:i| bar value: i. (ss at: i) rehash. ]. ]. Smalltalk obsoleteClasses isEmpty ifFalse: [self halt]. self halt: 'Ready to condense changes or sources'. SystemDictionary removeSelector: #makeSqueaklandRelease.! ! Project removeSelector: #storeLocallyInnards! Project removeSelector: #storeLocallyOnly! Project removeSelector: #storeLocallyWithProgressInfo!