[squeak-dev] The Trunk: System-ar.149.mcz

Andreas Raab uploaded a new version of System to project The Trunk:
http://source.squeak.org/trunk/System-ar.149.mcz

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

Name: System-ar.149
Author: ar
Time: 18 September 2009, 10:33:17 am
UUID: 522195b3-d1b9-7f4d-b827-bfea8caee5a7
Ancestors: System-nice.148, System-ar.148

Merge System-nice.148 and System-ar.148.

=============== Diff against System-nice.148 ===============

Item was added:
+ ----- Method: Project>>invalidate (in category 'displaying') -----
+ invalidate
+ "Invalidate the entire project so that a redraw will be forced later."
+ ^self subclassResponsibility!

Item was changed:
  ----- Method: Project>>subProjects (in category 'release') -----
  subProjects
+ "Answer a list of all the subprojects  of the receiver."
+ ^self subclassResponsibility!
- "Answer a list of all the subprojects  of the receiver.  This is nastily idiosyncratic."
-
- ^self isMorphic
- ifTrue:
- [world submorphs
- select: [:m | (m isSystemWindow) and: [m model isKindOf: Project]]
- thenCollect: [:m | m model]]
- ifFalse:
- [(world controllersSatisfying: [:m | m model isKindOf: Project])
- collect: [:c | c model]]!

Item was changed:
  ----- Method: Project>>makeThumbnail (in category 'menu messages') -----
  makeThumbnail
  "Make a thumbnail image of this project from the Display."
-
- world isMorph ifTrue: [world displayWorldSafely]. "clean pending damage"
  viewSize ifNil: [viewSize := Display extent // 8].
  thumbnail := Form extent: viewSize depth: Display depth.
  (WarpBlt current toForm: thumbnail)
  sourceForm: Display;
  cellSize: 2;  "installs a colormap"
  combinationRule: Form over;
  copyQuad: (Display boundingBox) innerCorners
  toRect: (0@0 extent: viewSize).
  InternalThreadNavigationMorph cacheThumbnailFor: self.
  ^thumbnail
  !

Item was added:
+ ----- Method: Project>>displaySizeChanged (in category 'displaying') -----
+ displaySizeChanged
+ "Inform the current project that its display size has changed"
+ !

Item was changed:
  ----- Method: Project>>armsLengthCommand:withDescription: (in category 'file in/out') -----
  armsLengthCommand: aCommand withDescription: aString
  | pvm tempProject foolingForm tempCanvas bbox crossHatchColor stride |
  "Set things up so that this aCommand is sent to self as a message
  after jumping to the parentProject.  For things that can't be executed
  while in this project, such as saveAs, loadFromServer, storeOnServer.  See
  ProjectViewMorph step."
 
  self isMorphic ifTrue: [
  world borderWidth: 0. "get rid of the silly default border"
+ tempProject := MorphicProject new.
- tempProject := Project newMorphic.
  foolingForm := world imageForm. "make them think they never left"
  tempCanvas := foolingForm getCanvas.
  bbox := foolingForm boundingBox.
  crossHatchColor := Color yellow alpha: 0.3.
  stride := 20.
  10 to: bbox width by: stride do: [ :x |
  tempCanvas fillRectangle: (x@0 extent: 1@bbox height) fillStyle: crossHatchColor.
  ].
  10 to: bbox height by: stride do: [ :y |
  tempCanvas fillRectangle: (0@y extent: bbox width@1) fillStyle: crossHatchColor.
  ].
 
  tempProject world color: (InfiniteForm with: foolingForm).
  tempProject projectParameters
  at: #armsLengthCmd
  put: (
  DoCommandOnceMorph new
  addText: aString;
  actionBlock: [
  self doArmsLengthCommand: aCommand.
  ] fixTemps
  ).
  tempProject projectParameters
  at: #deleteWhenEnteringNewProject
  put: true.
  tempProject enter.
  ] ifFalse: [
  parentProject ifNil: [^ self inform: 'The top project can''t do that'].
  pvm := parentProject findProjectView: self.
  pvm armsLengthCommand: {self. aCommand}.
  self exit.
  ].
  !

Item was added:
+ ----- Method: Project>>openProject: (in category 'initialization') -----
+ openProject: aProject
+ "Create a new for a new project in the context of the receiver"
+ ^self subclassResponsibility!

Item was changed:
  ----- Method: Project>>imageFormOfSize:depth: (in category 'displaying') -----
  imageFormOfSize: extentPoint depth: d
  | newDisplay |
  newDisplay := DisplayScreen extent: extentPoint depth: d.
+ Display replacedBy: newDisplay do:[self restore].
- Display replacedBy: newDisplay do:[
- world isMorph
- ifTrue:[Display getCanvas fullDrawMorph: world] "Morphic"
- ifFalse:[world restore]. "MVC"
- ].
  ^newDisplay!

Item was added:
+ ----- Method: Project>>restore (in category 'displaying') -----
+ restore
+ "Redraw the entire Project"
+ ^self subclassResponsibility!

Item was changed:
  ----- Method: Project class>>openBlankProjectNamed: (in category 'squeaklet on server') -----
  openBlankProjectNamed: projName
 
  | proj projViewer |
 
+ proj := MorphicProject openViewOn: nil.
- proj := Project newMorphicOn: nil.
  proj changeSet name: projName.
  proj world addMorph: (
  TextMorph new
  beAllFont: ((TextStyle default fontOfSize: 26) emphasized: 1);
  color: Color red;
  contents: 'Welcome to a new project - ',projName
  ).
  proj setParent: self current.
  projViewer := (CurrentProject findProjectView: projName) ifNil: [^proj].
  (projViewer owner isSystemWindow) ifTrue: [
  projViewer owner model: proj].
  ^ projViewer project: proj!

Item was changed:
  ----- Method: Project>>initialize (in category 'initialization') -----
  initialize
  "Initialize the project, seting the CurrentProject as my parentProject and initializing my project preferences from those of the CurrentProject"
+ Project addingProject: self.
-
  changeSet := ChangeSet new.
  transcript := TranscriptStream new.
  displayDepth := Display depth.
  parentProject := CurrentProject.
  isolatedHead := false.
  self initializeProjectPreferences
  !

Item was changed:
  ----- Method: ProjectLoading class>>openName:stream:fromDirectory:withProjectView: (in category 'loading') -----
  openName: aFileName stream: preStream fromDirectory: aDirectoryOrNil
  withProjectView: existingView
  "Reconstitute a Morph from the selected file, presumed to be
  represent a Morph saved via the SmartRefStream mechanism, and open it
  in an appropriate Morphic world."
 
      | morphOrList proj trusted localDir projStream archive mgr
  projectsToBeDeleted baseChangeSet enterRestricted substituteFont
  numberOfFontSubstitutes exceptions |
  (preStream isNil or: [preStream size = 0]) ifTrue: [
  ProgressNotification  signal: '9999 about to enter
  project'. "the hard part is over"
  ^self inform:
  'It looks like a problem occurred while
  getting this project. It may be temporary,
  so you may want to try again,' translated
  ].
  ProgressNotification signal: '2:fileSizeDetermined
  ',preStream size printString.
  preStream isZipArchive
  ifTrue:[ archive := ZipArchive new readFrom: preStream.
  projStream := self
  projectStreamFromArchive: archive]
  ifFalse:[projStream := preStream].
  trusted := SecurityManager default positionToSecureContentsOf:
  projStream.
  trusted ifFalse:
  [enterRestricted := (preStream isTypeHTTP or:
  [aFileName isNil])
  ifTrue: [Preferences securityChecksEnabled]
  ifFalse: [Preferences standaloneSecurityChecksEnabled].
  enterRestricted
  ifTrue: [SecurityManager default enterRestrictedMode
  ifFalse:
  [preStream close.
  ^ self]]].
 
  localDir := Project squeakletDirectory.
  aFileName ifNotNil: [
  (aDirectoryOrNil isNil or: [aDirectoryOrNil pathName
  ~= localDir pathName]) ifTrue: [
  localDir deleteFileNamed: aFileName.
  (localDir fileNamed: aFileName) binary
  nextPutAll: preStream contents;
  close.
  ].
  ].
  morphOrList := projStream asUnZippedStream.
  preStream sleep. "if ftp, let the connection close"
  ProgressNotification  signal: '3:unzipped'.
  ResourceCollector current: ResourceCollector new.
  baseChangeSet := ChangeSet current.
  self useTempChangeSet. "named zzTemp"
  "The actual reading happens here"
  substituteFont := Preferences standardEToysFont copy.
  numberOfFontSubstitutes := 0.
  exceptions := Set new.
  [[morphOrList := morphOrList fileInObjectAndCodeForProject]
  on: FontSubstitutionDuringLoading do: [ :ex |
  exceptions add: ex.
  numberOfFontSubstitutes :=
  numberOfFontSubstitutes + 1.
  ex resume: substituteFont ]]
  ensure: [ ChangeSet  newChanges: baseChangeSet].
  mgr := ResourceManager new initializeFrom: ResourceCollector current.
  mgr fixJISX0208Resource.
  mgr registerUnloadedResources.
  archive ifNotNil:[mgr preLoadFromArchive: archive cacheName:
  aFileName].
  (preStream respondsTo: #close) ifTrue:[preStream close].
  ResourceCollector current: nil.
  ProgressNotification  signal: '4:filedIn'.
  ProgressNotification  signal: '9999 about to enter project'.
  "the hard part is over"
  (morphOrList isKindOf: ImageSegment) ifTrue: [
  proj := morphOrList arrayOfRoots
  detect: [:mm | mm isKindOf: Project]
  ifNone: [^self inform: 'No project found in
  this file'].
  proj projectParameters at: #substitutedFont put: (
  numberOfFontSubstitutes > 0
  ifTrue: [substituteFont]
  ifFalse: [#none]).
  proj projectParameters at: #MultiSymbolInWrongPlace put: false.
  "Yoshiki did not put MultiSymbols into
  outPointers in older images!!"
  morphOrList arrayOfRoots do: [:obj |
  obj fixUponLoad: proj seg: morphOrList "imageSegment"].
  (proj projectParameters at: #MultiSymbolInWrongPlace) ifTrue: [
  morphOrList arrayOfRoots do: [:obj | (obj
  isKindOf: Set) ifTrue: [obj rehash]]].
 
  proj resourceManager: mgr.
  "proj versionFrom: preStream."
  proj lastDirectory: aDirectoryOrNil.
  proj setParent: Project current.
  projectsToBeDeleted := OrderedCollection new.
  existingView ifNil: [
+ ChangeSet allChangeSets add: proj changeSet.
+ Project current openProject: proj.
- Smalltalk isMorphic ifTrue: [
- proj createViewIfAppropriate.
- ] ifFalse: [
- ChangeSet allChangeSets add: proj changeSet.
- ProjectView openAndEnter: proj.
  "Note: in MVC we get no further than the above"
- ].
  ] ifNotNil: [
  (existingView project isKindOf: DiskProxy) ifFalse: [
  existingView project changeSet name:
  ChangeSet defaultName.
  projectsToBeDeleted add: existingView project.
  ].
  (existingView owner isSystemWindow) ifTrue: [
  existingView owner model: proj
  ].
  existingView project: proj.
  ].
  ChangeSet allChangeSets add: proj changeSet.
  Project current projectParameters
  at: #deleteWhenEnteringNewProject
  ifPresent: [ :ignored |
  projectsToBeDeleted add: Project current.
  Project current removeParameter:
  #deleteWhenEnteringNewProject.
  ].
  projectsToBeDeleted isEmpty ifFalse: [
  proj projectParameters
  at: #projectsToBeDeleted
  put: projectsToBeDeleted.
  ].
  ^ ProjectEntryNotification signal: proj
  ].
 
  (morphOrList isKindOf: SqueakPage) ifTrue: [
  morphOrList := morphOrList contentsMorph
  ].
  (morphOrList isKindOf: PasteUpMorph) ifFalse:
  [^ self inform: 'This is not a PasteUpMorph or
  exported Project.' translated].
+ (MorphicProject openViewOn: morphOrList) enter
- (Project newMorphicOn: morphOrList) enter
  !

Item was removed:
- ----- Method: Project class>>new (in category 'instance creation') -----
- new
-
- | new |
-
- new := super new.
- new setProjectHolder: CurrentProject.
- self addingProject: new.
- ^new!

Item was removed:
- ----- Method: Project class>>newMorphic (in category 'instance creation') -----
- newMorphic
- | new |
- "ProjectView open: Project newMorphic"
-
- new := self basicNew.
- self addingProject: new.
- new initMorphic.
- ^new!

Item was removed:
- ----- Method: Project>>createViewIfAppropriate (in category 'displaying') -----
- createViewIfAppropriate
-
- ProjectViewOpenNotification signal ifTrue: [
- Preferences projectViewsInWindows ifTrue: [
- (ProjectViewMorph newProjectViewInAWindowFor: self) openInWorld
- ] ifFalse: [
- (ProjectViewMorph on: self) openInWorld "but where??"
- ].
- ].
- !

Item was removed:
- ----- Method: Project>>setProjectHolder: (in category 'initialization') -----
- setProjectHolder: aProject
-
- self initialize.
- world := ControlManager new.
- !

Item was removed:
- ----- Method: Project class>>newMorphicOn: (in category 'instance creation') -----
- newMorphicOn: aPasteUpOrNil
-
- | newProject |
-
- newProject := self basicNew initMorphic.
- self addingProject: newProject.
- aPasteUpOrNil ifNotNil: [newProject installPasteUpAsWorld: aPasteUpOrNil].
- newProject createViewIfAppropriate.
- ^newProject
- !