The Trunk: System-dtl.254.mcz

David T. Lewis uploaded a new version of System to project The Trunk:
http://source.squeak.org/trunk/System-dtl.254.mcz

==================== Summary ====================

Name: System-dtl.254
Author: dtl
Time: 14 February 2010, 10:26:00.712 pm
UUID: 2aeafa4c-96a8-401a-87ed-0efa0b1be62d
Ancestors: System-ul.253

Remove explicit MVC/Morphic dependencies from Preferences class>>setListFontTo:
Implement Project>>textWindows to remove MVC/Morphic dependencies from  Utilities class> storeTextWindowContentsToFileNamed:
Fix bug in #storeTextWindowContentsToFileNamed: in which text windows with duplicate window titles were not saved.
Remove explicit MVC references from SystemDictionary>>majorShrink.
Remove explicit MVC reference from SystemDictionary>>discardOddsAndEnds.

=============== Diff against System-ul.253 ===============

Item was changed:
  ----- Method: SystemDictionary>>discardOddsAndEnds (in category 'shrinking') -----
  discardOddsAndEnds
  "This method throws out lots of classes that are not frequently
  used."
  "Smalltalk discardOddsAndEnds"
  self organization removeSystemCategory: 'System-Serial Port'.
  self organization removeSystemCategory: 'ST80-Symbols'.
  self organization removeSystemCategory: 'Tools-File Contents Browser'.
  self organization removeSystemCategory: 'System-Compression'.
  self organization removeSystemCategory: 'Tools-Explorer'.
  self organization removeSystemCategory: 'System-Digital Signatures'.
  Form removeSelector: #edit.
  self
  at: #FormView
  ifPresent: [:c | c compile: 'defaultControllerClass  ^ NoController' classified: 'controller access'].
  self removeClassNamed: #FormEditorView.
  self removeClassNamed: #FormEditor.
  self organization removeSystemCategory: 'ST80-Paths'.
  "bit editor (remove Form editor first):"
  Form removeSelector: #bitEdit.
  Form removeSelector: #bitEditAt:scale:.
  StrikeFont removeSelector: #edit:.
  self removeClassNamed: #FormButtonCache.
  self removeClassNamed: #FormMenuController.
  self removeClassNamed: #FormMenuView.
  self removeClassNamed: #BitEditor.
  "inspector for Dictionaries of Forms"
  Dictionary removeSelector: #inspectFormsWithLabel:.
  SystemDictionary removeSelector: #viewImageImports.
+ self
+ at: #ScreenController
+ ifPresent: [:c | c removeSelector: #viewImageImport].
- ScreenController removeSelector: #viewImageImports.
  self removeClassNamed: #FormHolderView.
  self removeClassNamed: #FormInspectView.
  "experimental updating object viewer:"
  Object removeSelector: #evaluate:wheneverChangeIn:.
  self removeClassNamed: #ObjectViewer.
  self removeClassNamed: #ObjectTracer.
  "miscellaneous classes:"
  self removeClassNamed: #Array2D.
  self removeClassNamed: #DriveACar.
  self removeClassNamed: #EventRecorder.
  self removeClassNamed: #FindTheLight.
  self removeClassNamed: #PluggableTest.
  self removeClassNamed: #SystemMonitor.
  self removeClassNamed: #ProtocolBrowser.
  self removeClassNamed: #ObjectExplorerWrapper.
  self removeClassNamed: #HierarchyBrowser.
  self removeClassNamed: #LinkedMessageSet.
  self removeClassNamed: #ObjectExplorer.
  self removeClassNamed: #PackageBrowser.
  self removeClassNamed: #AbstractHierarchicalList.
  self removeClassNamed: #ChangeList.
  self removeClassNamed: #VersionsBrowser.
  self removeClassNamed: #ChangeRecord.
  self removeClassNamed: #SelectorBrowser.
  self removeClassNamed: #HtmlFileStream.
  self removeClassNamed: #CrLfFileStream.
  self removeClassNamed: #FXGrafPort.
  self removeClassNamed: #FXBlt.
  self
  at: #SampledSound
  ifPresent: [:c | c initialize].
  #(#Helvetica #Palatino #Courier #ComicBold #ComicPlain )
  do: [:k | TextConstants
  removeKey: k
  ifAbsent: []].
  Preferences
  setButtonFontTo: (StrikeFont familyName: #NewYork size: 12).
  Preferences
  setFlapsFontTo: (StrikeFont familyName: #NewYork size: 12).
  #(#GZipConstants #ZipConstants #KlattResonatorIndices )
  do: [:k | self
  removeKey: k
  ifAbsent: []]!

Item was added:
+ ----- Method: Project>>textWindows (in category 'utilities') -----
+ textWindows
+ "Answer a dictionary of all system windows for text display keyed by window title.
+ Generate new window titles as required to ensure unique keys in the dictionary."
+
+ self subclassResponsibility!

Item was changed:
  ----- Method: SystemDictionary>>majorShrink (in category 'shrinking') -----
  majorShrink
  "Undertake a major shrinkage of the image.
  This method throws out lots of the system that is not needed
  for, eg, operation in a hand-held PC. majorShrink produces a
  999k image in Squeak 2.8
  Smalltalk majorShrink; abandonSources; lastRemoval"
  | oldDicts newDicts |
  self isMorphic
  ifTrue: [^ self error: 'You can only run majorShrink in MVC'].
  Project current isTopProject
  ifFalse: [^ self error: 'You can only run majorShrink in the top project'].
  (self confirm: 'All sub-projects will be deleted from this image.
  You should already have made a backup copy,
  or you must save with a different name after shrinking.
  Shall we proceed to discard most of the content in this image?')
  ifFalse: [^ self inform: 'No changes have been made.'].
  "Remove all projects but the current one. - saves 522k"
+ Smalltalk at: #ProjectView ifPresent: [:pvClass |
+ pvClass allInstancesDo: [:pv | pv controller closeAndUnscheduleNoTerminate]].
- ProjectView
- allInstancesDo: [:pv | pv controller closeAndUnscheduleNoTerminate].
  Project current setParent: Project current.
+ Smalltalk at: #Wonderland ifPresent: [:cls |
+ cls removeActorPrototypesFromSystem].
- self
- at: #Wonderland
- ifPresent: [:cls | cls removeActorPrototypesFromSystem].
  Smalltalk at: #Player ifPresent:[:aClass| aClass freeUnreferencedSubclasses].
  MorphicModel removeUninstantiatedModels.
  Utilities classPool at: #ScrapsBook put: nil.
  Utilities zapUpdateDownloader.
  ProjectHistory currentHistory initialize.
  Project rebuildAllProjects.
  "Smalltalk discardVMConstruction."
  "755k"
  self discardSoundSynthesis.
  "544k"
  self discardOddsAndEnds.
  "227k"
  self discardNetworking.
  "234k"
  "Smalltalk discard3D."
  "407k"
  self discardFFI.
  "33k"
  self discardMorphic.
  "1372k"
  Symbol rehash.
  "40k"
  "Above by itself saves about 4,238k"
  "Remove references to a few classes to be deleted, so that they
  won't leave obsolete versions around."
  ChangeSet class compile: 'defaultName
  ^ ''Changes'' ' classified: 'initialization'.
+ Smalltalk at: #ScreenController ifPresent: [:sc |
+ sc removeSelector: #openChangeManager.
+ sc removeSelector: #exitProject.
+ sc removeSelector: #openProject.
+ sc removeSelector: #viewImageImports].
- ScreenController removeSelector: #openChangeManager.
- ScreenController removeSelector: #exitProject.
- ScreenController removeSelector: #openProject.
- ScreenController removeSelector: #viewImageImports.
  "Now delete various other classes.."
  SystemOrganization removeSystemCategory: 'Graphics-Files'.
  SystemOrganization removeSystemCategory: 'System-Object Storage'.
  self removeClassNamed: #ProjectController.
  self removeClassNamed: #ProjectView.
  "Smalltalk removeClassNamed: #Project."
  self removeClassNamed: #Component1.
  self removeClassNamed: #FormSetFont.
  self removeClassNamed: #FontSet.
  self removeClassNamed: #InstructionPrinter.
  self removeClassNamed: #ChangeSorter.
  self removeClassNamed: #DualChangeSorter.
  self removeClassNamed: #EmphasizedMenu.
  self removeClassNamed: #MessageTally.
  StringHolder class removeSelector: #originalWorkspaceContents.
  CompiledMethod removeSelector: #symbolic.
  RemoteString removeSelector: #makeNewTextAttVersion.
  Utilities class removeSelector: #absorbUpdatesFromServer.
  self removeClassNamed: #PenPointRecorder.
  self removeClassNamed: #Path.
  self removeClassNamed: #Base64MimeConverter.
  "Smalltalk removeClassNamed: #EToySystem. Dont bother - its
  very small and used for timestamps etc"
  self removeClassNamed: #RWBinaryOrTextStream.
  self removeClassNamed: #AttributedTextStream.
  self removeClassNamed: #WordNet.
  self removeClassNamed: #SelectorBrowser.
  TextStyle
  allSubInstancesDo: [:ts | ts
  newFontArray: (ts fontArray
  copyFrom: 1
  to: (2 min: ts fontArray size))].
  #(ListParagraph PopUpMenu StandardSystemView) do:[:className|
  Smalltalk at: className ifPresent:[:aClass| aClass initialize].
  ].
  ChangeSet noChanges.
  ChangeSet classPool
  at: #AllChangeSets
  put: (OrderedCollection with: ChangeSet current).
  SystemDictionary removeSelector: #majorShrink.
  [self removeAllUnSentMessages > 0]
  whileTrue: [Smalltalk unusedClasses
  do: [:c | (Smalltalk at: c) removeFromSystem]].
  SystemOrganization removeEmptyCategories.
  self
  allClassesDo: [:c | c zapOrganization].
  self garbageCollect.
  'Rehashing method dictionaries . . .'
  displayProgressAt: Sensor cursorPoint
  from: 0
  to: MethodDictionary instanceCount
  during: [:bar |
  oldDicts := MethodDictionary allInstances.
  newDicts := Array new: oldDicts size.
  oldDicts
  withIndexDo: [:d :index |
  bar value: index.
  newDicts at: index put: d rehashWithoutBecome].
  oldDicts elementsExchangeIdentityWith: newDicts].
  oldDicts := newDicts := nil.
  Project rebuildAllProjects.
  ChangeSet current initialize.
  "seems to take more than one try to gc all the weak refs in
  SymbolTable "
  3
  timesRepeat: [self garbageCollect.
  Symbol compactSymbolTable]!

Item was changed:
  ----- Method: Utilities class>>storeTextWindowContentsToFileNamed: (in category 'miscellaneous') -----
  storeTextWindowContentsToFileNamed: aName
  "Utilities storeTextWindowContentsToFileNamed: 'TextWindows'"
+ | aDict aRefStream |
- | windows aDict aRefStream |
 
+ aDict := Project current textWindows..
- "there is a reference to World, but this method seems to be unused"
-
-
- aDict := Dictionary new.
- Smalltalk isMorphic
- ifTrue:
- [windows := World submorphs select: [:m | m isSystemWindow].
- windows do:
- [:w | | assoc |
- assoc := w titleAndPaneText.
- assoc ifNotNil:
- [w holdsTranscript ifFalse:
- [aDict add: assoc]]]]
- ifFalse:
- [windows := ScheduledControllers controllersSatisfying:
- [:c | (c model isKindOf: StringHolder)].
- windows do:
- [:aController | | textToUse aTextView |
- aTextView := aController view subViews detect: [:m | m isKindOf: PluggableTextView] ifNone: [nil].
- textToUse := aTextView
- ifNil: [aController model contents]
- ifNotNil: [aTextView controller text].  "The latest edits, whether accepted or not"
- aDict at: aController view label put: textToUse]].
-
  aDict size = 0 ifTrue: [^ self inform: 'no windows found to export.'].
-
  aRefStream := ReferenceStream fileNamed: aName.
  aRefStream nextPut: aDict.
  aRefStream close.
  self inform: 'Done!!  ', aDict size printString, ' window(s) exported.'!

Item was changed:
  ----- Method: Preferences class>>setListFontTo: (in category 'fonts') -----
  setListFontTo: aFont
  "Set the list font as indicated"
 
  Parameters at: #standardListFont put: aFont.
+ Smalltalk at: #ListParagraph ifPresent: [:lp | lp initialize].
+ Smalltalk at: #Flaps ifPresent: [:flaps | flaps replaceToolsFlap]!
- ListParagraph initialize.
- Flaps replaceToolsFlap!

Item was removed:
- ----- Method: Utilities class>>openScratchWorkspaceLabeled:contents: (in category 'miscellaneous') -----
- openScratchWorkspaceLabeled: labelString contents: initialContents
- "Open a scratch text view with the given label on the given string. A scratch text view won't warn you about unsaved changes when you close it."
- "Utilities openScratchWorkspaceLabeled: 'Scratch' contents: 'Hello. world!!'"
-
- | model topView stringView |
- model := StringHolder new contents: initialContents.
- topView := StandardSystemView new.
- topView
- model: model;
- label: labelString;
- minimumSize: 180@120.
- topView borderWidth: 1.
- stringView := PluggableTextView on: model
- text: #contents
- accept: nil
- readSelection: #contentsSelection
- menu: #codePaneMenu:shifted:.
- stringView
- askBeforeDiscardingEdits: false;
- window: (0@0 extent: 180@120).
- topView addSubView: stringView.
- topView controller open.
- !