[squeak-dev] The Trunk: System-nice.213.mcz

Nicolas Cellier uploaded a new version of System to project The Trunk: http://source.squeak.org/trunk/System-nice.213.mcz

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

Name: System-nice.213 Author: nice Time: 1 January 2010, 1:28:43 am UUID: 88587166-7b03-452a-a58a-18fe89a667be Ancestors: System-ul.212

Don't assign block argument with nil, with closure that is not necessary.

=============== Diff against System-ul.212 ===============

Item was changed: ----- Method: Project>>displayFontProgress (in category 'menu messages') ----- displayFontProgress "Display progress for fonts" + | done b | - | done b pp | done := false. b := ScriptableButton new. b color: Color yellow. b borderWidth: 1; borderColor: Color black. + [ | dots str idx | - pp := [ | dots str idx | dots := #(' - ' ' \ ' ' | ' ' / '). idx := 0. [done] whileFalse:[ str := '$ Fixing fonts $ ' translated. str := str copyReplaceTokens: '$' with: (dots atWrap: (idx := idx + 1)) asString. b label: str font: (TextStyle defaultFont emphasized: 1). b extent: 200@50. b center: Display center. b fullDrawOn: Display getCanvas. (Delay forMilliseconds: 250) wait. ]. ] forkAt: Processor userInterruptPriority. ^[done := true]!

Item was changed: ----- Method: ImageSegment>>rootsIncludingBlocks (in category 'read/write segment') ----- rootsIncludingBlocks "For export segments only. Return a new roots array with more objects. (Caller should store into rootArray.) Collect Blocks and external methods pointed to by them. Put them into the roots list. Then ask for the segment again."

| extras have | userRootCnt ifNil: [userRootCnt := arrayOfRoots size]. extras := OrderedCollection new. outPointers do: [:anOut | anOut class == CompiledMethod ifTrue: [extras add: anOut]. (anOut isBlock) ifTrue: [extras add: anOut]. + (anOut class == MethodContext) ifTrue: [extras add: anOut]]. - (anOut class == MethodContext) ifTrue: [extras add: anOut]. - anOut := nil]. "don't hang onto it"

[have := extras size. extras copy do: [:anOut | anOut isBlock ifTrue: [ anOut home ifNotNil: [ (extras includes: anOut home) ifFalse: [extras add: anOut home]]]. (anOut class == MethodContext) ifTrue: [ anOut method ifNotNil: [ (extras includes: anOut method) ifFalse: [extras add: anOut method]]]]. have = extras size] whileFalse. extras := extras select: [:ea | (arrayOfRoots includes: ea) not]. extras isEmpty ifTrue: [^ nil]. "no change"

^ arrayOfRoots, extras!

Item was changed: ----- Method: Utilities class>>offerCommonRequestsInMorphic (in category 'common requests') ----- offerCommonRequestsInMorphic "Offer up the common-requests menu. If the user chooses one, then evaluate it, and -- provided the value is a number or string -- show it in the Transcript."

"Utilities offerCommonRequests"

| aMenu strings |

(CommonRequestStrings == nil or: [CommonRequestStrings isKindOf: Array]) ifTrue: [self initializeCommonRequestStrings]. strings := CommonRequestStrings contents. aMenu := MenuMorph new. aMenu title: 'Common Requests' translated. aMenu addStayUpItem. strings asString linesDo: [:aString | aString = '-' ifTrue: [aMenu addLine] ifFalse: + [aMenu add: (aString ifEmpty: [' ']) target: self selector: #eval: argument: aString]]. - [aString size == 0 ifTrue: [aString := ' ']. - aMenu add: aString target: self selector: #eval: argument: aString]].

aMenu addLine. aMenu add: 'edit this list' translated target: self action: #editCommonRequestStrings. aMenu popUpInWorld: self currentWorld!

Item was changed: ----- Method: Preferences class>>annotationEditingWindow (in category 'parameters') ----- annotationEditingWindow "Answer a window affording editing of annotations" + | aPanel ins outs current aWindow aButton info standardHeight standardWidth | - | aPanel ins outs current aWindow aButton info standardHeight standardWidth aMorph | standardHeight := 180. standardWidth := (2 sqrt reciprocal * standardHeight) rounded. Smalltalk isMorphic ifFalse: [self error: 'annotations can be edited only in morphic']. aPanel := AlignmentMorph newRow extent: 2 * standardWidth @ standardHeight. ins := AlignmentMorph newColumn extent: standardWidth @ standardHeight. ins color: Color green muchLighter. ins enableDrop: true; beSticky. outs := AlignmentMorph newColumn extent: standardWidth @ standardHeight. outs color: Color red muchLighter. outs enableDrop: true; beSticky. aPanel addMorph: outs; addMorphFront: ins. outs position: ins position + (standardWidth @ 0). current := self defaultAnnotationRequests. info := self annotationInfo. current + do: [:sym | | pair aMorph | - do: [:sym | | pair | pair := info detect: [:aPair | aPair first == sym]. aMorph := StringMorph new contents: pair first. aMorph setBalloonText: pair last. aMorph enableDrag: true. aMorph on: #startDrag send: #startDrag:with: to: aMorph. ins addMorphBack: aMorph]. info do: [:aPair | (current includes: aPair first) + ifFalse: [| aMorph | + aMorph := StringMorph new contents: aPair first. - ifFalse: [aMorph := StringMorph new contents: aPair first. aMorph setBalloonText: aPair last. aMorph enableDrag: true. aMorph on: #startDrag send: #startDrag:with: to: aMorph. outs addMorph: aMorph]]. aPanel layoutChanged. aWindow := SystemWindowWithButton new setLabel: 'Annotations'. aButton := SimpleButtonMorph new target: Preferences; actionSelector: #acceptAnnotationsFrom:; arguments: (Array with: aWindow); label: 'apply'; borderWidth: 0; borderColor: Color transparent; color: Color transparent. aButton submorphs first color: Color blue. aButton setBalloonText: 'After moving all the annotations you want to the left (green) side, and all the ones you do NOT want to the right (pink) side, hit this "apply" button to have your choices take effect.'. aWindow buttonInTitle: aButton; adjustExtraButton. ^ aPanel wrappedInWindow: aWindow"Preferences annotationEditingWindow openInHand"!

Item was changed: ----- Method: ImageSegment>>rootsIncludingBlockMethods (in category 'read/write segment') ----- rootsIncludingBlockMethods "Return a new roots array with more objects. (Caller should store into rootArray.) Any CompiledMethods that create blocks will be in outPointers if the block is held outside of this segment. Put such methods into the roots list. Then ask for the segment again."

+ | myClasses extras | + userRootCnt ifNil: [userRootCnt := arrayOfRoots size]. + extras := OrderedCollection new. + myClasses := OrderedCollection new. + arrayOfRoots do: [:aRoot | aRoot class class == Metaclass ifTrue: [ - | myClasses extras | - userRootCnt ifNil: [userRootCnt := arrayOfRoots size]. - extras := OrderedCollection new. - myClasses := OrderedCollection new. - arrayOfRoots do: [:aRoot | aRoot class class == Metaclass ifTrue: [ myClasses add: aRoot]]. + myClasses isEmpty ifTrue: [^ nil]. "no change" + outPointers do: [:anOut | | gotIt | + anOut class == CompiledMethod ifTrue: [ + "specialized version of who" + gotIt := false. + myClasses detect: [:class | + class selectorsDo: [:sel | + (class compiledMethodAt: sel) == anOut + ifTrue: [extras add: anOut. gotIt := true]]. + gotIt] + ifNone: [] + ]. + ]. + extras := extras select: [:ea | (arrayOfRoots includes: ea) not]. + extras isEmpty ifTrue: [^ nil]. "no change" + ^ arrayOfRoots, extras! - myClasses isEmpty ifTrue: [^ nil]. "no change" - outPointers do: [:anOut | | gotIt | - anOut class == CompiledMethod ifTrue: [ - "specialized version of who" - gotIt := false. - myClasses detect: [:class | - class selectorsDo: [:sel | - (class compiledMethodAt: sel) == anOut - ifTrue: [extras add: anOut. gotIt := true]]. - gotIt] - ifNone: [] - ]. - anOut := nil]. - extras := extras select: [:ea | (arrayOfRoots includes: ea) not]. - extras isEmpty ifTrue: [^ nil]. "no change" - ^ arrayOfRoots, extras!

Item was changed: ----- Method: ImageSegment>>copyFromRoots:sizeHint:areUnique: (in category 'read/write segment') ----- copyFromRoots: aRootArray sizeHint: segSizeHint areUnique: areUnique "Copy a tree of objects into a WordArray segment. The copied objects in the segment are not in the normal Squeak space. [1] For exporting a project. Objects were enumerated by ReferenceStream and aRootArray has them all. [2] For exporting some classes. See copyFromRootsForExport:. (Caller must hold Symbols, or they will not get registered in the target system.) [3] For 'local segments'. outPointers are kept in the image. If this method yields a very small segment, it is because objects just below the roots are pointed at from the outside. (See findRogueRootsImSeg: for a *destructive* diagnostic of who is pointing in.)" | segmentWordArray outPointerArray segSize rootSet uniqueRoots | aRootArray ifNil: [self errorWrongState]. uniqueRoots := areUnique ifTrue: [aRootArray] ifFalse: [rootSet := IdentitySet new: aRootArray size * 3. uniqueRoots := OrderedCollection new. 1 to: aRootArray size do: [:ii | "Don't include any roots twice" (rootSet includes: (aRootArray at: ii)) ifFalse: [ uniqueRoots addLast: (aRootArray at: ii). rootSet add: (aRootArray at: ii)] ifTrue: [userRootCnt ifNotNil: ["adjust the count" ii <= userRootCnt ifTrue: [userRootCnt := userRootCnt - 1]]]]. uniqueRoots]. arrayOfRoots := uniqueRoots asArray. rootSet := uniqueRoots := nil. "be clean" userRootCnt ifNil: [userRootCnt := arrayOfRoots size]. arrayOfRoots do: [:aRoot | aRoot indexIfCompact > 0 ifTrue: [ + self error: 'Compact class ', aRoot name, ' cannot be a root']]. - self error: 'Compact class ', aRoot name, ' cannot be a root']. - aRoot := nil]. "clean up" outPointers := nil. "may have used this instance before" segSize := segSizeHint > 0 ifTrue: [segSizeHint *3 //2] ifFalse: [50000].

["Guess a reasonable segment size" segmentWordArray := WordArrayForSegment new: segSize. [outPointerArray := Array new: segSize // 20] ifError: [ state := #tooBig. ^ self]. "Smalltalk garbageCollect." (self storeSegmentFor: arrayOfRoots into: segmentWordArray outPointers: outPointerArray) == nil] whileTrue: ["Double the segment size and try again" segmentWordArray := outPointerArray := nil. segSize := segSize * 2]. segment := segmentWordArray. outPointers := outPointerArray. state := #activeCopy. endMarker := segment nextObject. "for enumeration of objects" endMarker == 0 ifTrue: [endMarker := 'End' clone]. !