[squeak-dev] The Trunk: System-ar.149.mcz
commits at source.squeak.org
commits at source.squeak.org
Sat Sep 19 05:34:52 UTC 2009
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 at 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 at 0 extent: 1 at bbox height) fillStyle: crossHatchColor.
].
10 to: bbox height by: stride do: [ :y |
tempCanvas fillRectangle: (0 at y extent: bbox width at 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
- !
More information about the Squeak-dev
mailing list
|