'From Squeak3.1alpha of 28 February 2001 [latest update: #4257] on 18 August 2001 at 1:20:05 am'! "Change Set: SqueaklandShrinkFixes-ar Date: 18 August 2001 Author: Andreas Raab A few fixes for Squeakland shrinking. Results in a 5.6MB image (~2.9MB compressed)."! Object subclass: #Authorizer instanceVariableNames: 'users realm ' classVariableNames: '' poolDictionaries: '' category: 'Network-Url'! !Authorizer methodsFor: 'authentication' stamp: 'ar 8/17/2001 18:19'! user: userId "Return the requesting user." ^users at: userId ifAbsent: [ self error: (self class unauthorizedFor: realm) ]! ! !Authorizer class methodsFor: 'as yet unclassified' stamp: 'ar 8/17/2001 18:19'! unauthorizedFor: realm ^'HTTP/1.0 401 Unauthorized', self crlf, 'WWW-Authenticate: Basic realm="Squeak/',realm,'"', String crlfcrlf, 'Unauthorized

Unauthorized for ',realm, '

' ! ! !String class methodsFor: 'instance creation' stamp: 'ar 8/17/2001 18:19'! crlfcrlf ^self crlf , self crlf. ! ! !SystemDictionary methodsFor: 'housekeeping' stamp: 'ar 8/18/2001 01:14'! 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 initialize. "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.! ! !SystemDictionary methodsFor: 'shrinking' stamp: 'ar 8/17/2001 18:57'! discard3D "Smalltalk discard3D" "Discard 3D Support." self discardWonderland. Smalltalk removeKey: #B3DEngineConstants ifAbsent: []. Smalltalk at: #InterpolatingImageMorph ifPresent:[:cls| cls removeFromSystem]. SystemOrganization removeCategoriesMatching: 'Graphics-FXBlt'. SystemOrganization removeCategoriesMatching: 'Graphics-External'. SystemOrganization removeCategoriesMatching: 'Balloon3D-*'. SystemOrganization removeCategoriesMatching: 'Graphics-Tools-*'. Color removeSelector: #asB3DColor. Form removeSelector: #asTexture. Morph removeSelector: #asTexture. FileList removeSelector: #open3DSFile. Point removeSelector: #@. Smalltalk at: #BalloonCanvas ifPresent:[:cc| cc removeSelector: #render:]. Stream removeSelector: #asVRMLStream.! ! !SystemDictionary methodsFor: 'shrinking' stamp: 'ar 8/17/2001 18:30'! discardIRC "Smalltalk discardIRC" SystemOrganization removeCategoriesMatching: 'Network-IRC Chat'. TheWorldMenu compile:'openIRC self inform:''IRC is not present'' '.! ! !SystemDictionary methodsFor: 'shrinking' stamp: 'ar 8/17/2001 18:13'! discardPWS "Smalltalk discardPWS" SystemOrganization removeCategoriesMatching: 'Network-Pluggable Web Server'. FileList removeSelector: #renderFile.! ! !SystemDictionary methodsFor: 'shrinking' stamp: 'ar 8/17/2001 17:25'! discardVMConstruction "Discard the virtual machine construction classes and the Smalltalk-to-C translator. These are only needed by those wishing to build or study the Squeak virtual machine, or by those wishing to construct new primitives via Smalltalk-to-C translation. Updated to suit 2.8 TPR" "remove the code for virtual machines" Smalltalk removeKey: #InterpreterLog ifAbsent: []. "remove the Smalltalk-to-C translator" Smalltalk at: #CCodeGenerator ifPresent: [:codeGen | codeGen removeCompilerMethods]. "remove any plugins" Smalltalk at: #InterpreterPlugin ifPresent:[:cls| (ChangeSet superclassOrder: cls withAllSubclasses asArray) reverseDo: [:c | c removeFromSystem]]. #(B3DSimulRasterizer BalloonDebugEngine BalloonDebugCanvas) do:[:clsName| Smalltalk at: clsName ifPresent:[:cls| cls removeFromSystem]]. SystemOrganization removeCategoriesMatching: 'VMConstruction-*'. SystemOrganization removeCategoriesMatching: 'Squeak-Plugins'. "Various references" #( (Object removeSelector: primitive:parameters:receiver:) (SystemDictionary macroBenchmarks) (SystemDictionary macroBenchmark2) (String primGetInteger32:) (String primPutInteger32:at:) ) do:[:spec| Smalltalk at: spec first ifPresent:[:cls| cls removeSelector: spec last]. ].! ! !SystemDictionary class methodsFor: 'initialization' stamp: 'ar 8/17/2001 18:24'! initialize "SystemDictionary initialize" | oldList | oldList _ StartUpList. StartUpList _ OrderedCollection new. "These get processed from the top down..." #( DisplayScreen Cursor InputSensor ProcessorScheduler "Starts low space watcher and bkground." Delay FileDirectory "Enables file stack dump and opens sources." ShortIntegerArray ShortRunArray CrLfFileStream ) do:[:clsName| Smalltalk at: clsName ifPresent:[:cls| Smalltalk addToStartUpList: cls]. ]. oldList ifNotNil: [oldList do: [:className | Smalltalk at: className ifPresent: [:theClass | Smalltalk addToStartUpList: theClass]]]. #( ImageSegment PasteUpMorph ControlManager ) do:[:clsName| Smalltalk at: clsName ifPresent:[:cls| Smalltalk addToStartUpList: cls]. ]. oldList _ ShutDownList. ShutDownList _ OrderedCollection new. "These get processed from the bottom up..." #( DisplayScreen Form ControlManager PasteUpMorph StrikeFont Color FileDirectory Delay SoundPlayer HttpUrl Password PWS MailDB ImageSegment ) do:[:clsName| Smalltalk at: clsName ifPresent:[:cls| Smalltalk addToShutDownList: cls]. ]. oldList ifNotNil: [oldList reverseDo: [:className | Smalltalk at: className ifPresent: [:theClass | Smalltalk addToShutDownList: theClass]]]. ! ! SystemDictionary initialize!