Bert Freudenberg uploaded a new version of Collections to project The Trunk:
http://source.squeak.org/trunk/Collections-bf.761.mcz
==================== Summary ====================
Name: Collections-bf.761
Author: bf
Time: 20 July 2017, 12:42:02.196604 pm
UUID: 5b68150c-4eb0-4210-9fac-c4aa09623b6d
Ancestors: Collections-eem.760
Remove ByteArray>>at:put: and fix the fallback code in ByteArray>>#replaceFrom:to:with:startingAt: to match prim 105
=============== Diff against Collections-eem.760 ===============
Item was removed:
- ----- Method: ByteArray>>at:put: (in category 'accessing') -----
- at: index put: value
- <primitive: 61> "try primitiveAtPut, convert value to integer if that fails and try again"
- ^ self byteAt: index put: value asInteger
- !
Item was changed:
----- Method: ByteArray>>replaceFrom:to:with:startingAt: (in category 'private') -----
replaceFrom: start to: stop with: replacement startingAt: repStart
"Primitive. This destructively replaces elements from start to stop in the receiver starting at index, repStart, in the collection, replacement. Answer the receiver. Range checks are performed in the primitive only. Optional. See Object documentation whatIsAPrimitive."
<primitive: 105>
+ replacement isString
+ ifFalse:
+ [super replaceFrom: start to: stop with: replacement startingAt: repStart]
+ ifTrue:
+ [ "use String>>byteAt: to mimic prim 105"
+ | index repOff |
+ repOff := repStart - start.
+ index := start - 1.
+ [(index := index + 1) <= stop]
+ whileTrue: [self at: index put: (replacement byteAt: repOff + index)]]
+ !
- super replaceFrom: start to: stop with: replacement startingAt: repStart!
Nicolas Cellier uploaded a new version of Kernel to project The Trunk:
http://source.squeak.org/trunk/Kernel-nice.1109.mcz
==================== Summary ====================
Name: Kernel-nice.1109
Author: nice
Time: 23 July 2017, 2:42:14.918543 pm
UUID: 1496608c-48fd-4bb2-b572-46e8b61421a9
Ancestors: Kernel-eem.1108
Define gcd: and lcm: for Fraction.
For example, 1/5 and 1/7 are both whole multiple of 1/35 (which is their gcd).
=============== Diff against Kernel-eem.1108 ===============
Item was added:
+ ----- Method: Fraction>>gcd: (in category 'arithmetic') -----
+ gcd: aFraction
+ | d |
+ d := denominator gcd: aFraction denominator.
+ ^(numerator *(aFraction denominator/d) gcd: aFraction numerator*(denominator/d)) / (denominator/d*aFraction denominator)!
Item was added:
+ ----- Method: Fraction>>lcm: (in category 'arithmetic') -----
+ lcm: n
+ "Answer the least common multiple of the receiver and n."
+
+ ^self // (self gcd: n) * n!
Item was changed:
----- Method: Integer>>gcd: (in category 'mathematical functions') -----
gcd: anInteger
"See Knuth, Vol 2, 4.5.2, Algorithm L"
"Initialize"
| higher u v k uHat vHat a b c d vPrime vPrimePrime q t |
+ anInteger denominator = 1 ifFalse: [^anInteger gcd: self].
higher := SmallInteger maxVal highBit.
u := self abs max: (v := anInteger abs).
v := self abs min: v.
[v class == SmallInteger]
whileFalse:
[(uHat := u bitShift: (k := higher - u highBit)) class == SmallInteger
ifFalse:
[k := k - 1.
uHat := uHat bitShift: -1].
vHat := v bitShift: k.
a := 1.
b := 0.
c := 0.
d := 1.
"Test quotient"
[(vPrime := vHat + d) ~= 0
and: [(vPrimePrime := vHat + c) ~= 0 and: [(q := uHat + a // vPrimePrime) = (uHat + b // vPrime)]]]
whileTrue:
["Emulate Euclid"
c := a - (q * (a := c)).
d := b - (q * (b := d)).
vHat := uHat - (q * (uHat := vHat))].
"Multiprecision step"
b = 0
ifTrue:
[v := u rem: (u := v)]
ifFalse:
[t := u * a + (v * b).
v := u * c + (v * d).
u := t]].
^ v gcd: u!
Item was changed:
----- Method: SmallInteger>>gcd: (in category 'arithmetic') -----
gcd: anInteger
"See SmallInteger (Integer) | gcd:"
| n m |
+ anInteger denominator = 1 ifFalse: [^anInteger gcd: self].
n := self.
m := anInteger.
[n = 0]
whileFalse:
[n := m \\ (m := n)].
^ m abs!
Marcel Taeumel uploaded a new version of Morphic to project The Trunk:
http://source.squeak.org/trunk/Morphic-mt.1347.mcz
==================== Summary ====================
Name: Morphic-mt.1347
Author: mt
Time: 18 July 2017, 10:11:56.69381 am
UUID: f95fc4b5-03e5-2f45-9a3f-087fb10cae98
Ancestors: Morphic-eem.1346
Regarding window colors and window listing, improve robustness for models that do not subclass Model and forget to provide #windowColorToUse.
Note that we could have added that message to Object but I do prefer not to clutter the interface any further.
=============== Diff against Morphic-eem.1346 ===============
Item was changed:
----- Method: TheWorldMainDockingBar>>listWindowsOn: (in category 'submenu - windows') -----
listWindowsOn: menu
| windows |
windows := self allVisibleWindows sorted: [:winA :winB |
((winA model isNil or: [winB model isNil]) or: [winA model name = winB model name])
ifTrue: [winA label < winB label]
ifFalse: [winA model name < winB model name]].
windows ifEmpty: [
menu addItem: [ :item |
item
contents: 'No Windows' translated;
isEnabled: false ] ].
windows do: [ :each |
+ | windowColor |
+ windowColor := (each model respondsTo: #windowColorToUse)
+ ifTrue: [each model windowColorToUse]
+ ifFalse: [UserInterfaceTheme current get: #uniformWindowColor for: Model].
menu addItem: [ :item |
item
contents: (self windowMenuItemLabelFor: each);
+ icon: (self colorIcon: windowColor);
- icon: (each model ifNotNil: [self colorIcon: each model windowColorToUse]);
target: each;
selector: #comeToFront;
subMenuUpdater: self
selector: #windowMenuFor:on:
arguments: { each };
action: [ each beKeyWindow; expand ] ] ].
menu
addLine;
add: 'Close all windows' target: self selector: #closeAllWindowsUnsafe;
addItem: [:item | item
contents: 'Close all windows without changes';
target: self;
icon: MenuIcons smallBroomIcon;
selector: #closeAllWindows];
add: 'Close all windows but workspaces' target: self selector: #closeAllWindowsButWorkspaces.!
Eliot Miranda uploaded a new version of Collections to project The Trunk:
http://source.squeak.org/trunk/Collections-eem.760.mcz
==================== Summary ====================
Name: Collections-eem.760
Author: eem
Time: 12 July 2017, 5:29:57.850345 pm
UUID: 622a9db4-e0d8-4c28-886a-d9b71a8fac49
Ancestors: Collections-pre.759
Make Interval>>, answer another Interval if possible, so that (1 to: 2), (3 to: 4) answers (1 to: 4) not #(1 2 3 4).
Correct a misapprension in String>>hash.
Use the preferred var:type: and nuke an unused declaration in some translated primitives.
=============== Diff against Collections-pre.759 ===============
Item was changed:
----- Method: ByteString class>>indexOfAscii:inString:startingAt: (in category 'primitives') -----
indexOfAscii: anInteger inString: aString startingAt: start
| stringSize |
<primitive: 'primitiveIndexOfAsciiInString' module: 'MiscPrimitivePlugin'>
+ <var: #aString type: #'unsigned char *'>
- <var: #aCharacter declareC: 'int anInteger'>
- <var: #aString declareC: 'unsigned char *aString'>
stringSize := aString size.
start to: stringSize do: [:pos |
(aString basicAt: pos) = anInteger ifTrue: [^ pos]].
+ ^ 0!
- ^ 0
- !
Item was changed:
----- Method: ByteString>>findSubstring:in:startingAt:matchTable: (in category 'comparing') -----
findSubstring: key in: body startingAt: start matchTable: matchTable
"Answer the index in the string body at which the substring key first occurs, at or beyond start. The match is determined using matchTable, which can be used to effect, eg, case-insensitive matches. If no match is found, zero will be returned.
The algorithm below is not optimum -- it is intended to be translated to C which will go so fast that it wont matter."
| index |
<primitive: 'primitiveFindSubstring' module: 'MiscPrimitivePlugin'>
+ <var: #key type: #'unsigned char *'>
+ <var: #body type: #'unsigned char *'>
+ <var: #matchTable type: #'unsigned char *'>
- <var: #key declareC: 'unsigned char *key'>
- <var: #body declareC: 'unsigned char *body'>
- <var: #matchTable declareC: 'unsigned char *matchTable'>
key size = 0 ifTrue: [^ 0].
(start max: 1) to: body size - key size + 1 do:
[:startIndex |
index := 1.
+ [(matchTable at: (body basicAt: startIndex+index-1) + 1)
+ = (matchTable at: (key basicAt: index) + 1)]
+ whileTrue:
- [(matchTable at: (body basicAt: startIndex+index-1) + 1)
- = (matchTable at: (key basicAt: index) + 1)]
- whileTrue:
[index = key size ifTrue: [^ startIndex].
index := index+1]].
^ 0
"
' ' findSubstring: 'abc' in: 'abcdefabcd' startingAt: 1 matchTable: CaseSensitiveOrder 1
' ' findSubstring: 'abc' in: 'abcdefabcd' startingAt: 2 matchTable: CaseSensitiveOrder 7
' ' findSubstring: 'abc' in: 'abcdefabcd' startingAt: 8 matchTable: CaseSensitiveOrder 0
' ' findSubstring: 'abc' in: 'abcdefABcd' startingAt: 2 matchTable: CaseSensitiveOrder 0
' ' findSubstring: 'abc' in: 'abcdefABcd' startingAt: 2 matchTable: CaseInsensitiveOrder 7
"!
Item was added:
+ ----- Method: Interval>>, (in category 'adding') -----
+ , otherCollection
+ "Override to answer an Interval if otherCollection is an adjacent and congruent interval."
+ ^(otherCollection isInterval
+ and: [otherCollection increment = step
+ and: [otherCollection first = (self last + step)]])
+ ifTrue: [self class from: start to: otherCollection last by: step]
+ ifFalse: [super, otherCollection]!
Item was changed:
----- Method: String>>hash (in category 'comparing') -----
hash
"#hash is implemented, because #= is implemented"
"ar 4/10/2005: I had to change this to use ByteString hash as initial
hash in order to avoid having to rehash everything and yet compute
the same hash for ByteString and WideString.
md 16/10/2006: use identityHash as initialHash, as behavior hash will
+ use String hash (name) to have a better hash soon.
+ eem 4/17/2017 it's not possible to use String hash (name) for the
+ initial hash because that would be recursive."
+ ^self class stringHash: self initialHash: ByteString identityHash!
- use String hash (name) to have a better hash soon"
- ^ self class stringHash: self initialHash: ByteString identityHash!
Eliot Miranda uploaded a new version of EToys to project The Trunk:
http://source.squeak.org/trunk/EToys-eem.305.mcz
==================== Summary ====================
Name: EToys-eem.305
Author: eem
Time: 12 July 2017, 5:17:21.792431 pm
UUID: 6180f254-4baa-41f9-a31d-adb1fa208d77
Ancestors: EToys-eem.304
Fix the ScriptCompiler's evaluate:in:to:notifying:ifFail:logged: method for non-cil contexts (e.g. the ContextVariablesInspector bottom right pane in the debugger). The old code used aContext methodClass which would exclude the variables of a receiver whose class inherited the method, rather than implemented it directly (e.g. debug (1@2) printString and in the context inspector on the Point(Object)>>printString activation try and evaluate x@y. Using methodClass excludes Point's inst vars.
At the same time eliminate its reliance on DoIt: and DoItIn:
=============== Diff against EToys-eem.304 ===============
Item was changed:
----- Method: ScriptCompiler>>evaluate:in:to:notifying:ifFail:logged: (in category 'as yet unclassified') -----
evaluate: textOrStream in: aContext to: receiver notifying: aRequestor ifFail: failBlock logged: logFlag
"Compiles the sourceStream into a parse tree, then generates code into a
method. This method is then installed in the receiver's class so that it
can be invoked. In other words, if receiver is not nil, then the text can
refer to instance variables of that receiver (the Inspector uses this). If
aContext is not nil, the text can refer to temporaries in that context (the
Debugger uses this). If aRequestor is not nil, then it will receive a
+ notify:at: message before the attempt to evaluate is aborted."
- notify:at: message before the attempt to evaluate is aborted. Finally, the
- compiled method is invoked from here as DoIt or (in the case of
- evaluation in aContext) DoItIn:. The method is subsequently removed
- from the class, but this will not get done if the invocation causes an
- error which is terminated. Such garbage can be removed by executing:
- Smalltalk allBehaviorsDo: [:cl | cl removeSelector: #DoIt; removeSelector:
- #DoItIn:]."
+ | methodNode method value toLog itsSelectionString itsSelection |
- | class methodNode method value selector toLog itsSelectionString itsSelection |
- class := (aContext == nil ifTrue: [receiver] ifFalse: [aContext receiver]) class.
methodNode := self parser new
parse: textOrStream readStream
+ class: (self classForReceiver: receiver context: aContext)
- class: class
noPattern: true
context: aContext
notifying: aRequestor
+ ifFail: [^ failBlock value]
+ for: receiver.
+ method := methodNode generate: (CompiledMethodTrailer empty sourceCode: methodNode sourceText; yourself).
- ifFail: [^ failBlock value] for: receiver.
- method := methodNode generate: (CompiledMethodTrailer empty sourceCode: (methodNode sourceText); yourself).
self interactive ifTrue:
[method := method copyWithTempNames: methodNode tempNames].
+ value := receiver
+ withArgs: (aContext ifNil: [#()] ifNotNil: [{aContext}])
+ executeMethod: method.
- selector := aContext isNil
- ifTrue: [#DoIt]
- ifFalse: [#DoItIn:].
- class addSelectorSilently: selector withMethod: method.
- value := aContext isNil
- ifTrue: [receiver DoIt]
- ifFalse: [receiver DoItIn: aContext].
- InMidstOfFileinNotification signal
- ifFalse: [class basicRemoveSelector: selector].
logFlag ifTrue:
[toLog := ((aRequestor respondsTo: #selection) and:
[(itsSelection := aRequestor selection) notNil] and:
[(itsSelectionString := itsSelection asString) isEmptyOrNil not] )
ifTrue:
[itsSelectionString]
ifFalse:
[textOrStream readStream contents].
SystemChangeNotifier uniqueInstance evaluated: toLog context: aContext].
+ ^value!
- ^ value!
Eliot Miranda uploaded a new version of Compiler to project The Trunk:
http://source.squeak.org/trunk/Compiler-eem.357.mcz
==================== Summary ====================
Name: Compiler-eem.357
Author: eem
Time: 12 July 2017, 5:14:16.035903 pm
UUID: 3965b31d-87f6-47e3-b23e-57dd1dd273b9
Ancestors: Compiler-eem.356
Fix the Compiler's evaluate:in: methods for non-cil contexts (e.g. the ContextVariablesInspector bottom right pane in the debugger). The old code used aContext methodClass which would exclude the variables of a receiver whose class inherited the method, rather than implemented it directly (e.g. debug (1@2) printString and in the context inspector on the Point(Object)>>printString activation try and evaluate x@y. Using methodClass excludes Point's inst vars.
=============== Diff against Compiler-eem.356 ===============
Item was added:
+ ----- Method: Compiler>>classForReceiver:context: (in category 'private') -----
+ classForReceiver: receiver context: contextOrNil
+ "Answer the class to compile in for a receiver and aContext.
+ If aContext is non-nil use its receiver's class (if we use the context's
+ methodClass we may exclude instance variables of the receiver).
+ Access the class of the receiver via the mirror primitive to avoid issues with proxies."
+
+ ^thisContext objectClass: (contextOrNil ifNil: [receiver] ifNotNil: [contextOrNil receiver])!
Item was changed:
----- Method: Compiler>>compiledMethodFor:in:to:notifying:ifFail: (in category 'public access') -----
compiledMethodFor: textOrStream in: aContext to: receiver notifying: aRequestor ifFail: failBlock
"Compiles the sourceStream into a parse tree, then generates code
into a method, and answers it. If receiver is not nil, then the text can
refer to instance variables of that receiver (the Inspector uses this).
If aContext is not nil, the text can refer to temporaries in that context
(the Debugger uses this). If aRequestor is not nil, then it will receive a
notify:at: message before the attempt to evaluate is aborted."
+ | methodNode method |
- | methodNode method theClass |
- theClass := (aContext == nil ifTrue: [receiver] ifFalse: [aContext receiver]) class.
methodNode := self
compileNoPattern: textOrStream
+ in: (self classForReceiver: receiver context: aContext)
- in: theClass
context: aContext
notifying: aRequestor
ifFail: [^failBlock value].
method := self interactive
ifTrue: [ methodNode generateWithTempNames ]
ifFalse: [ methodNode generate ].
^method!
Item was changed:
----- Method: Compiler>>evaluate:in:to:environment:notifying:ifFail:logged: (in category 'public access logging') -----
evaluate: textOrStream in: aContext to: receiver environment: anEnvironment notifying: aRequestor ifFail: failBlock logged: logFlag
"Same as #evaluate:in:to:notifying:ifFail:logged: but with an explicit environment"
- | theClass |
- theClass := (aContext == nil ifTrue: [receiver class] ifFalse: [aContext methodClass]).
^self
evaluateCue: (CompilationCue
source: textOrStream
context: aContext
receiver: receiver
+ class: (self classForReceiver: receiver context: aContext)
- class: theClass
environment: anEnvironment
requestor: aRequestor)
ifFail: failBlock
logged: logFlag!
Item was changed:
----- Method: Compiler>>evaluate:in:to:notifying:ifFail: (in category 'public access') -----
evaluate: textOrStream in: aContext to: receiver notifying: aRequestor ifFail: failBlock
"Compiles the sourceStream into a parse tree, then generates code into
a method. If aContext is not nil, the text can refer to temporaries in that
context (the Debugger uses this). If aRequestor is not nil, then it will receive
a notify:at: message before the attempt to evaluate is aborted. Finally, the
compiled method is invoked from here via withArgs:executeMethod:, hence
the system no longer creates Doit method litter on errors."
| theClass |
+ theClass := self classForReceiver: receiver context: aContext.
- theClass := aContext ifNil: [receiver class] ifNotNil: [:ctx | ctx methodClass].
^self
evaluateCue: (CompilationCue
source: textOrStream
context: aContext
receiver: receiver
class: theClass
environment: theClass environment
requestor: aRequestor)
ifFail: failBlock!
Item was changed:
----- Method: Compiler>>evaluate:in:to:notifying:ifFail:logged: (in category 'public access logging') -----
evaluate: textOrStream in: aContext to: receiver notifying: aRequestor ifFail: failBlock logged: logFlag
"Compiles the sourceStream into a parse tree, then generates code into
a method. If aContext is not nil, the text can refer to temporaries in that
context (the Debugger uses this). If aRequestor is not nil, then it will receive
a notify:at: message before the attempt to evaluate is aborted. Finally, the
compiled method is invoked from here via withArgs:executeMethod:, hence
the system no longer creates Doit method litter on errors."
| theClass |
+ theClass := self classForReceiver: receiver context: aContext.
- theClass := (aContext == nil ifTrue: [receiver class] ifFalse: [aContext methodClass]).
^self
evaluateCue: (CompilationCue
source: textOrStream
context: aContext
receiver: receiver
class: theClass
environment: theClass environment
requestor: aRequestor)
ifFail: failBlock
logged: logFlag!
Eliot Miranda uploaded a new version of Tools to project The Trunk:
http://source.squeak.org/trunk/Tools-eem.765.mcz
==================== Summary ====================
Name: Tools-eem.765
Author: eem
Time: 12 July 2017, 5:09:06.400984 pm
UUID: 7859773d-1bc1-4955-920b-121cac1570cd
Ancestors: Tools-pre.764
Fix bug in DictionaryInspector when browsing references but selecting an inst var of the receiver.
=============== Diff against Tools-pre.764 ===============
Item was changed:
----- Method: DictionaryInspector>>selectionReferences (in category 'menu') -----
selectionReferences
"Create a browser on all references to the association of the current selection."
+ self selectionIndex <= self numberOfFixedFields ifTrue: [^ self changed: #flash].
- self selectionIndex = 0 ifTrue: [^ self changed: #flash].
object class == MethodDictionary ifTrue: [^ self changed: #flash].
+ self systemNavigation browseAllCallsOn: (object associationAt: (keyArray at: selectionIndex - self numberOfFixedFields))!
- self systemNavigation browseAllCallsOn: (object associationAt: (keyArray at: selectionIndex - self numberOfFixedFields)).
- !
Eliot Miranda uploaded a new version of EToys to project The Trunk:
http://source.squeak.org/trunk/EToys-eem.304.mcz
==================== Summary ====================
Name: EToys-eem.304
Author: eem
Time: 12 July 2017, 10:09:25.400282 am
UUID: ae9828e4-4a18-4fb5-ad3f-027689693cfa
Ancestors: EToys-eem.303
Make allExtantPlayers robust in the presence of a newly instantiated EtoysPresenter, which is something that happens during project loading. With this change I can now load saved projects.
=============== Diff against EToys-eem.303 ===============
Item was changed:
----- Method: EtoysPresenter>>allExtantPlayers (in category 'intialize') -----
allExtantPlayers
"The initial intent here was to produce a list of Player objects associated with any Morph in the tree beneath the receiver's associatedMorph. whether it is the submorph tree or perhaps off on unseen bookPages. We have for the moment moved away from that initial intent, and in the current version we only deliver up players associated with the submorph tree only. <-- this note dates from 4/21/99
Call #flushPlayerListCache; to force recomputation."
| fullList |
playerList ifNotNil:
[^ playerList].
+ associatedMorph ifNil:
+ [^ #()].
fullList := associatedMorph allMorphs select:
[:m | m player ~~ nil] thenCollect: [:m | m player].
fullList copy do:
[:aPlayer |
aPlayer class scripts do:
[:aScript | aScript isTextuallyCoded ifFalse:
[aScript currentScriptEditor ifNotNil: [:ed |
| objectsReferredToByTiles |
objectsReferredToByTiles := ed allMorphs
select:
[:aMorph | (aMorph isKindOf: TileMorph) and: [aMorph type == #objRef]]
thenCollect:
[:aMorph | aMorph actualObject].
fullList addAll: objectsReferredToByTiles]]]].
^ playerList := fullList asSet asArray sort:
[:a :b | a externalName < b externalName]!
Eliot Miranda uploaded a new version of Morphic to project The Trunk:
http://source.squeak.org/trunk/Morphic-eem.1346.mcz
==================== Summary ====================
Name: Morphic-eem.1346
Author: eem
Time: 11 July 2017, 4:59:01.683267 pm
UUID: b8f78376-c9f0-4abe-8fd1-0edba1f3c1c4
Ancestors: Morphic-eem.1345
EToys expects MorphicProject>>exportSegmentWithChangeSet:fileName:directory:withoutInteraction: to send cleanUpReferences, but not base Squeak. So make it an optional send.
=============== Diff against Morphic-eem.1345 ===============
Item was changed:
----- Method: MorphicProject>>exportSegmentWithChangeSet:fileName:directory:withoutInteraction: (in category 'file in/out') -----
exportSegmentWithChangeSet: aChangeSetOrNil fileName: aFileName
directory: aDirectory withoutInteraction: noInteraction
"Store my project out on the disk as an *exported*
ImageSegment. All outPointers will be in a form that can be resolved
in the target image. Name it <project name>.extSeg. Whatdo we do
about subProjects, especially if they are out as local image
segments? Force them to come in?
Player classes are included automatically."
| is str ans revertSeg roots holder collector fd mgr stacks |
"Files out a changeSet first, so that a project can contain
its own classes"
world ifNil: [^ false].
world presenter ifNil: [^ false].
ScrapBook default emptyScrapBook.
+ (world respondsTo: #cleanUpReferences) ifTrue:
+ [world cleanUpReferences].
- world cleanUpReferences.
world currentHand pasteBuffer: nil. "don't write the paste buffer."
world currentHand mouseOverHandler initialize. "forget about any
references here"
"Display checkCurrentHandForObjectToPaste."
Command initialize.
world clearCommandHistory.
world fullReleaseCachedState; releaseViewers.
world cleanseStepList.
world localFlapTabs size = world flapTabs size ifFalse: [
noInteraction ifTrue: [^ false].
self error: 'Still holding onto Global flaps'].
world releaseSqueakPages.
Smalltalk at: #ScriptEditorMorph ifPresent: [:s |
s writingUniversalTiles: (self projectParameterAt: #universalTiles ifAbsent: [false])].
holder := Project allProjects. "force them in to outPointers, where
DiskProxys are made"
"Just export me, not my previous version"
revertSeg := self parameterAt: #revertToMe.
self removeParameter: #revertToMe.
roots := OrderedCollection new.
roots add: self; add: world; add: transcript; add: aChangeSetOrNil; add: thumbnail; add: world activeHand.
"; addAll: classList; addAll: (classList collect: [:cls | cls class])"
roots := roots reject: [ :x | x isNil]. "early saves may not have
active hand or thumbnail"
fd := aDirectory directoryNamed: self resourceDirectoryName.
fd assureExistence.
"Clean up resource references before writing out"
mgr := self resourceManager.
self resourceManager: nil.
ResourceCollector current: ResourceCollector new.
ResourceCollector current localDirectory: fd.
ResourceCollector current baseUrl: self resourceUrl.
ResourceCollector current initializeFrom: mgr.
ProgressNotification signal: '2:findingResources' extra:
'(collecting resources...)' translated.
"Must activate old world because this is run at #armsLength.
Otherwise references to ActiveWorld, ActiveHand, or ActiveEvent
will not be captured correctly if referenced from blocks or user code."
world becomeActiveDuring:[
is := ImageSegment copySmartRootsExport: roots asArray.
"old way was (is := ImageSegment new
copyFromRootsForExport: roots asArray)"
].
self resourceManager: mgr.
collector := ResourceCollector current.
ResourceCollector current: nil.
ProgressNotification signal: '2:foundResources' extra: ''.
is state = #tooBig ifTrue: [
collector replaceAll.
^ false].
str := ''.
"considered legal to save a project that has never been entered"
(is outPointers includes: world) ifTrue: [
str := str, '\Project''s own world is not in the segment.' translated withCRs].
str isEmpty ifFalse: [
ans := UIManager default chooseFrom: {
'Do not write file' translated.
'Write file anyway' translated.
'Debug' translated.
} title: str.
ans = 1 ifTrue: [
revertSeg ifNotNil: [projectParameters at:
#revertToMe put: revertSeg].
collector replaceAll.
^ false].
ans = 3 ifTrue: [
collector replaceAll.
self halt: 'Segment not written' translated]].
stacks := is findStacks.
is
writeForExportWithSources: aFileName
inDirectory: fd
changeSet: aChangeSetOrNil.
SecurityManager default signFile: aFileName directory: fd.
"Compress all files and update check sums"
collector forgetObsolete.
self storeResourceList: collector in: fd.
self storeHtmlPageIn: fd.
self storeManifestFileIn: fd.
self writeStackText: stacks in: fd registerIn: collector.
"local proj.005.myStack.t"
self compressFilesIn: fd to: aFileName in: aDirectory
resources: collector.
"also deletes the resource directory"
"Now update everything that we know about"
mgr updateResourcesFrom: collector.
revertSeg ifNotNil: [projectParameters at: #revertToMe put: revertSeg].
holder.
collector replaceAll.
world flapTabs do: [:ft |
(ft respondsTo: #unhibernate) ifTrue: [ft unhibernate]].
is arrayOfRoots do: [:obj |
obj isScriptEditorMorph ifTrue: [obj unhibernate]].
^ true
!