Squeak-dev August 2011

squeak-dev@lists.squeakfoundation.org

55 participants
171 discussions

The Trunk: System-ul.451.mcz
by commits＠source.squeak.org 04 Aug '11

04 Aug '11

Levente Uzonyi uploaded a new version of System to project The Trunk: http://source.squeak.org/trunk/System-ul.451.mcz ==================== Summary ==================== Name: System-ul.451 Author: ul Time: 3 August 2011, 1:53:21.094 am UUID: 12173273-4139-304d-b495-6d34396d067c Ancestors: System-eem.450 Removed unnecessary blocks. =============== Diff against System-eem.450 =============== Item was changed: ----- Method: AbstractLauncher>>parameterAt:ifAbsent: (in category 'private') ----- parameterAt: parName ifAbsent: aBlock "Return the parameter named parName. Evaluate the block if parameter does not exist." ^self parameters at: parName asUppercase + ifAbsent: aBlock! - ifAbsent: [aBlock value]! Item was changed: ----- Method: ImageSegment>>allInstancesOf:do: (in category 'instance change shape') ----- allInstancesOf: aClass do: aBlock | withSymbols oldInstances segSize | "Bring me in, locate instances of aClass and submit them to the block. Write me out again." (state = #onFile or: [state = #onFileWithSymbols]) ifFalse: [^ self]. withSymbols := state = #onFileWithSymbols. (outPointers includes: aClass) ifFalse: [^ self]. "If has instances, they point out at the class" state = #onFile ifTrue: [Cursor read showWhile: [self readFromFile]]. segSize := segment size. self install. oldInstances := OrderedCollection new. self allObjectsDo: [:obj | obj class == aClass ifTrue: [ oldInstances add: obj]]. + oldInstances do: aBlock. "do the work" - oldInstances do: [:inst | aBlock value: inst]. "do the work" self copyFromRoots: arrayOfRoots sizeHint: segSize. self extract. withSymbols ifTrue: [self writeToFileWithSymbols] ifFalse: [self writeToFile]. ! Item was changed: ----- Method: ImageSegment>>ifOutPointer:thenAllObjectsDo: (in category 'instance change shape') ----- ifOutPointer: anObject thenAllObjectsDo: aBlock | withSymbols segSize | "If I point out to anObject, bring me in, Submit all my objects to the block. Write me out again." (state = #onFile or: [state = #onFileWithSymbols]) ifFalse: [^ self]. withSymbols := state = #onFileWithSymbols. (outPointers includes: anObject) ifFalse: [^ self]. state = #onFile ifTrue: [Cursor read showWhile: [self readFromFile]]. segSize := segment size. self install. + self allObjectsDo: aBlock. "do the work" - self allObjectsDo: [:obj | aBlock value: obj]. "do the work" self copyFromRoots: arrayOfRoots sizeHint: segSize. self extract. withSymbols ifTrue: [self writeToFileWithSymbols] ifFalse: [self writeToFile]. ! Item was changed: ----- Method: MczInstaller>>useNewChangeSetDuring: (in category 'utilities') ----- useNewChangeSetDuring: aBlock | changeHolder oldChanges newChanges | changeHolder := (ChangeSet respondsTo: #newChanges:) ifTrue: [ChangeSet] ifFalse: [Smalltalk]. oldChanges := (ChangeSet respondsTo: #current) ifTrue: [ChangeSet current] ifFalse: [Smalltalk changes]. newChanges := ChangeSet new name: (ChangeSet uniqueNameLike: self extractPackageName). changeHolder newChanges: newChanges. + aBlock ensure: [changeHolder newChanges: oldChanges].! - [aBlock value] ensure: [changeHolder newChanges: oldChanges].! Item was changed: ----- Method: Preferences class>>parameterAt:ifAbsent: (in category 'parameters') ----- parameterAt: aKey ifAbsent: aBlock "Answer the parameter saved at the given key; if there is no such key in the Parameters dictionary, evaluate aBlock" + ^ Parameters at: aKey ifAbsent: aBlock! - ^ Parameters at: aKey ifAbsent: [aBlock value]! Item was changed: ----- Method: Project>>projectParameterAt:ifAbsent: (in category 'project parameters') ----- projectParameterAt: aSymbol ifAbsent: aBlock "Answer the project parameter stored at the given symbol, or the result of evaluating the block" + ^ self projectParameters at: aSymbol ifAbsent: aBlock! - ^ self projectParameters at: aSymbol ifAbsent: [aBlock value]! Item was changed: ----- Method: Project>>projectPreferenceAt:ifAbsent: (in category 'project parameters') ----- projectPreferenceAt: aSymbol ifAbsent: aBlock "Answer the project preference stored at the given symbol, or the result of evaluating the block" + ^ self projectPreferenceFlagDictionary at: aSymbol ifAbsent: aBlock! - ^ self projectPreferenceFlagDictionary at: aSymbol ifAbsent: [aBlock value]! Item was changed: ----- Method: Project>>withChildrenDo: (in category 'accessing') ----- withChildrenDo: aBlock "Evaluate the block first with the receiver as argument, then, recursively and depth first, with each of the receiver's children as argument" aBlock value: self. self children do: [:p | + p withChildrenDo: aBlock ]! - p withChildrenDo: - [:c | aBlock value: c]]! Item was changed: ----- Method: SystemChangeNotifier>>doSilently: (in category 'public') ----- doSilently: aBlock "Perform the block, and ensure that no system notification are broadcasted while doing so." | result | silenceLevel := silenceLevel + 1. + result := aBlock ensure: [silenceLevel > 0 ifTrue: [silenceLevel := silenceLevel - 1]]. - result := [aBlock value] ensure: [silenceLevel > 0 ifTrue: [silenceLevel := silenceLevel - 1]]. ^ result.! Item was changed: ----- Method: SystemNavigation>>allBehaviorsDo: (in category 'query') ----- allBehaviorsDo: aBlock "Evaluate the argument, aBlock, for each kind of Behavior in the system (that is, Object and its subclasses and Traits). ar 7/15/1999: The code below will not enumerate any obsolete or anonymous behaviors for which the following should be executed: Smalltalk allObjectsDo:[:obj| obj isBehavior ifTrue:[aBlock value: obj]]. but what follows is way faster than enumerating all objects." Class rootsOfTheWorld do: [:root| root withAllSubclassesDo: [:class| class isMeta ifFalse: "The metaclasses are rooted at Class; don't include them twice." [aBlock value: class; value: class class]]]. + ClassDescription allTraitsDo: aBlock! - ClassDescription allTraitsDo: - [:trait | aBlock value: trait]!

1 0

The Trunk: ToolBuilder-MVC-ul.29.mcz
by commits＠source.squeak.org 04 Aug '11

04 Aug '11

Levente Uzonyi uploaded a new version of ToolBuilder-MVC to project The Trunk: http://source.squeak.org/trunk/ToolBuilder-MVC-ul.29.mcz ==================== Summary ==================== Name: ToolBuilder-MVC-ul.29 Author: ul Time: 3 August 2011, 1:53:39.126 am UUID: d564a8fe-9edd-3e48-863d-978494abdf3e Ancestors: ToolBuilder-MVC-kb.28 Removed unnecessary blocks. =============== Diff against ToolBuilder-MVC-kb.28 =============== Item was changed: ----- Method: MVCUIManager>>informUser:during: (in category 'ui requests') ----- informUser: aString during: aBlock "Display a message above (or below if insufficient room) the cursor during execution of the given block. UIManager default informUser: 'Just a sec!!' during: [(Delay forSeconds: 1) wait]. " (SelectionMenu labels: '') displayAt: Sensor cursorPoint withCaption: aString + during: aBlock! - during: [aBlock value]!

1 0

The Trunk: Sound-ul.32.mcz
by commits＠source.squeak.org 04 Aug '11

04 Aug '11

Levente Uzonyi uploaded a new version of Sound to project The Trunk: http://source.squeak.org/trunk/Sound-ul.32.mcz ==================== Summary ==================== Name: Sound-ul.32 Author: ul Time: 3 August 2011, 1:51:54.523 am UUID: a2095fc2-ab98-f74d-b1cf-5f44a9f922a0 Ancestors: Sound-bf.31 Removed unnecessary blocks. =============== Diff against Sound-bf.31 =============== Item was changed: ----- Method: SequentialSound>>transformSounds: (in category 'copying') ----- transformSounds: tfmBlock "Private!! Support for copying. Copy my component sounds." + sounds := sounds collect: tfmBlock - sounds := sounds collect: [:s | tfmBlock value: s]. !

1 0

The Trunk: ReleaseBuilder-ul.66.mcz
by commits＠source.squeak.org 04 Aug '11

04 Aug '11

Levente Uzonyi uploaded a new version of ReleaseBuilder to project The Trunk: http://source.squeak.org/trunk/ReleaseBuilder-ul.66.mcz ==================== Summary ==================== Name: ReleaseBuilder-ul.66 Author: ul Time: 3 August 2011, 1:51:24.902 am UUID: 8a03ba63-f10c-c143-b15a-9b3d878a35fa Ancestors: ReleaseBuilder-ul.65 Removed unnecessary blocks. =============== Diff against ReleaseBuilder-ul.65 =============== Item was changed: ----- Method: ReleaseBuilderFor3dot11>>cleanupPhaseFinal (in category 'cleaning') ----- cleanupPhaseFinal " ReleaseBuilderFor3dot11 new cleanupPhaseFinal " | tasks | tasks := OrderedCollection new add: [Smalltalk removeEmptyMessageCategories]; add: [Workspace allSubInstancesDo: [:each | each initializeBindings]]; add: [Undeclared removeUnreferencedKeys]; add: [Categorizer sortAllCategories]; add: [Symbol compactSymbolTable]; add: [#(#TheWorldMenu #FileServices #AppRegistry #Preferences #FileList ) do: [:cl | (Smalltalk at: cl) removeObsolete]]; add:[Flaps freshFlapsStart]; add:[MCFileBasedRepository flushAllCaches]; add: [HandMorph releaseCachedState; initForEvents.self fixObsoleteReferences]; add: [ DataStream initialize. Behavior flushObsoleteSubclasses. "The pointer to currentMethod is not realy needed (anybody care to fix this) and often holds on to obsolete bindings" MethodChangeRecord allInstancesDo: [:each | each noteNewMethod: nil].Smalltalk garbageCollectMost]; yourself. Utilities informUserDuring: [:bar | tasks do: [:block | bar value: block printString. + block - [block value] on: Error do: [:error | Transcript show: error; cr]]]. SystemNavigation default obsoleteClasses isEmpty ifTrue: [SmalltalkImage current saveSession] ifFalse: [SystemNavigation default obsoleteClasses do: [:each | .self halt.[PointerFinder on: each] on: Error do: [:error | Transcript show: error; cr]]] !

1 0

The Trunk: Protocols-ul.38.mcz
by commits＠source.squeak.org 04 Aug '11

04 Aug '11

Levente Uzonyi uploaded a new version of Protocols to project The Trunk: http://source.squeak.org/trunk/Protocols-ul.38.mcz ==================== Summary ==================== Name: Protocols-ul.38 Author: ul Time: 3 August 2011, 1:51:01.014 am UUID: e04559d5-f962-f641-8d94-6b34c15c3485 Ancestors: Protocols-cmm.37 Removed unnecessary blocks. =============== Diff against Protocols-cmm.37 =============== Item was changed: ----- Method: Lexicon>>selectImplementedMessageAndEvaluate: (in category 'selection') ----- selectImplementedMessageAndEvaluate: aBlock "Allow the user to choose one selector, chosen from the currently selected message's selector, as well as those of all messages sent by it, and evaluate aBlock on behalf of chosen selector. If there is only one possible choice, simply make it; if there are multiple choices, put up a menu, and evaluate aBlock on behalf of the the chosen selector, doing nothing if the user declines to choose any. In this variant, only selectors " | selector method messages | (selector := self selectedMessageName) ifNil: [^ self]. method := (self selectedClassOrMetaClass ifNil: [^ self]) compiledMethodAt: selector ifAbsent: []. (method isNil or: [(messages := method messages) size = 0]) ifTrue: [^ aBlock value: selector]. (messages size = 1 and: [messages includes: selector]) ifTrue: [^ aBlock value: selector]. "If only one item, there is no choice" messages := messages select: [:aSelector | currentVocabulary includesSelector: aSelector forInstance: self targetObject ofClass: targetClass limitClass: limitClass]. self systemNavigation showMenuOf: messages withFirstItem: selector + ifChosenDo: aBlock! - ifChosenDo: [:sel | aBlock value: sel]! Item was changed: ----- Method: ScreenedVocabulary>>categoryListForInstance:ofClass:limitClass: (in category 'enumeration') ----- categoryListForInstance: anObject ofClass: aClass limitClass: mostGenericClass "Answer the category list for the given object/class, considering only code implemented in mostGenericClass and lower" + ^(super categoryListForInstance: anObject ofClass: aClass limitClass: mostGenericClass) + select: categoryScreeningBlock! - ^ (super categoryListForInstance: anObject ofClass: aClass limitClass: mostGenericClass) select: - [:aCategory | categoryScreeningBlock value: aCategory]! Item was changed: ----- Method: Vocabulary>>methodInterfaceAt:ifAbsent: (in category 'queries') ----- methodInterfaceAt: aSelector ifAbsent: aBlock "Answer the vocabulary's method interface for the given selector; if absent, return the result of evaluating aBlock" + ^methodInterfaces at: aSelector ifAbsent: aBlock! - ^ methodInterfaces at: aSelector ifAbsent: [aBlock value]!

1 0

The Trunk: Network-ul.117.mcz
by commits＠source.squeak.org 04 Aug '11

04 Aug '11

Levente Uzonyi uploaded a new version of Network to project The Trunk: http://source.squeak.org/trunk/Network-ul.117.mcz ==================== Summary ==================== Name: Network-ul.117 Author: ul Time: 3 August 2011, 1:50:30.059 am UUID: ab499e21-d9a7-3c4a-9d4b-ecc079123dc0 Ancestors: Network-cmm.116 Removed unnecessary blocks. =============== Diff against Network-cmm.116 =============== Item was changed: ----- Method: ServerDirectory class>>removeServerNamed:ifAbsent: (in category 'available servers') ----- removeServerNamed: nameString ifAbsent: aBlock + + self servers removeKey: nameString ifAbsent: aBlock! - self servers removeKey: nameString ifAbsent: [aBlock value]! Item was changed: ----- Method: ServerDirectory class>>serverNamed:ifAbsent: (in category 'available servers') ----- serverNamed: nameString ifAbsent: aBlock + + ^self servers at: nameString asString ifAbsent: aBlock! - ^self servers at: nameString asString ifAbsent: [aBlock value]!

1 0

The Trunk: MorphicExtras-ul.102.mcz
by commits＠source.squeak.org 04 Aug '11

04 Aug '11

Levente Uzonyi uploaded a new version of MorphicExtras to project The Trunk: http://source.squeak.org/trunk/MorphicExtras-ul.102.mcz ==================== Summary ==================== Name: MorphicExtras-ul.102 Author: ul Time: 3 August 2011, 1:50:12.221 am UUID: edaf8f97-595d-dd4b-b262-913b828c645c Ancestors: MorphicExtras-cmm.101 Removed unnecessary blocks. =============== Diff against MorphicExtras-cmm.101 =============== Item was changed: ----- Method: Command>>parameterAt:ifAbsent: (in category 'parameters') ----- parameterAt: aSymbol ifAbsent: aBlock "Answer the parameter stored at the aSymbol, but if none, return the result of evaluating aBlock" + ^ self assuredParameterDictionary at: aSymbol ifAbsent: aBlock! - ^ self assuredParameterDictionary at: aSymbol ifAbsent: [aBlock value]! Item was changed: ----- Method: Flaps class>>addMorph:asElementNumber:inGlobalFlapSatisfying: (in category 'construction support') ----- addMorph: aMorph asElementNumber: aNumber inGlobalFlapSatisfying: flapBlock "If any global flap satisfies flapBlock, add aMorph to it at the given position. Applies to flaps that are parts bins and that like thumbnailing" | aFlapTab flapPasteUp | + aFlapTab := self globalFlapTabsIfAny detect: flapBlock ifNone: [^ self]. - aFlapTab := self globalFlapTabsIfAny detect: [:aTab | flapBlock value: aTab] ifNone: [^ self]. flapPasteUp := aFlapTab referent. flapPasteUp addMorph: aMorph asElementNumber: aNumber. flapPasteUp replaceTallSubmorphsByThumbnails; setPartsBinStatusTo: true! Item was changed: ----- Method: Flaps class>>deleteMorphsSatisfying:fromGlobalFlapSatisfying: (in category 'construction support') ----- deleteMorphsSatisfying: deleteBlock fromGlobalFlapSatisfying: flapBlock "If any global flap satisfies flapBlock, then delete objects satisfying from deleteBlock from it. Occasionally called from do-its in updates or other fileouts." | aFlapTab flapPasteUp | + aFlapTab := self globalFlapTabsIfAny detect: flapBlock ifNone: [^ self]. - aFlapTab := self globalFlapTabsIfAny detect: [:aTab | flapBlock value: aTab] ifNone: [^ self]. flapPasteUp := aFlapTab referent. flapPasteUp submorphs do: [:aMorph | (deleteBlock value: aMorph) ifTrue: [aMorph delete]]! Item was changed: ----- Method: Flaps class>>replacePartSatisfying:inGlobalFlapSatisfying:with: (in category 'replacement') ----- replacePartSatisfying: elementBlock inGlobalFlapSatisfying: flapBlock with: replacement "If any global flap satisfies flapBlock, look in it for a part satisfying elementBlock; if such a part is found, replace it with the replacement morph, make sure the flap's layout is made right, etc." | aFlapTab flapPasteUp anElement | + aFlapTab := self globalFlapTabsIfAny detect: flapBlock ifNone: [^ self]. - aFlapTab := self globalFlapTabsIfAny detect: [:aTab | flapBlock value: aTab] ifNone: [^ self]. flapPasteUp := aFlapTab referent. + anElement := flapPasteUp submorphs detect: elementBlock ifNone: [^ self]. - anElement := flapPasteUp submorphs detect: [:aMorph | elementBlock value: aMorph] ifNone: [^ self]. flapPasteUp replaceSubmorph: anElement by: replacement. flapPasteUp replaceTallSubmorphsByThumbnails; setPartsBinStatusTo: true. "Flaps replacePartSatisfying: [:el | (el isKindOf: MorphThumbnail) and: [(el morphRepresented isKindOf: SystemWindow) and: [el morphRepresented label = 'scripting area']]] inGlobalFlapSatisfying: [:fl | (fl submorphs size > 0) and: [(fl submorphs first isKindOf: TextMorph) and: [(fl submorphs first contents string copyWithout: Character cr) = 'Tools']]] with: ScriptingSystem newScriptingSpace"!

1 0

The Trunk: Morphic-ul.565.mcz
by commits＠source.squeak.org 04 Aug '11

04 Aug '11

Levente Uzonyi uploaded a new version of Morphic to project The Trunk: http://source.squeak.org/trunk/Morphic-ul.565.mcz ==================== Summary ==================== Name: Morphic-ul.565 Author: ul Time: 4 August 2011, 3:11:12.403 am UUID: 722fd55a-3d47-c54d-817a-19b826b9f721 Ancestors: Morphic-nice.564 Removed unnecessary blocks. Morph >> #submorphsThat:ifNone: only accepts blocks which evaluate to a boolean as it's first argument. =============== Diff against Morphic-nice.564 =============== Item was changed: ----- Method: Canvas>>transform2By:clippingTo:during:smoothing: (in category 'Nebraska/embeddedWorlds') ----- transform2By: aDisplayTransform clippingTo: aClipRect during: aBlock smoothing: cellSize "an attempt to use #displayInterpolatedOn: instead of WarpBlt." | patchRect subCanvas pureRect biggerPatch biggerClip interForm | self flag: #bob. "added to Canvas in hopes it will work for Nebraska" (aDisplayTransform isPureTranslation) ifTrue: [ ^aBlock value: (self copyOffset: aDisplayTransform offset negated truncated clipRect: aClipRect) ]. "Prepare an appropriate warp from patch to aClipRect" pureRect := (aDisplayTransform globalBoundsToLocal: aClipRect). patchRect := pureRect rounded. patchRect area = 0 ifTrue: [^self]. "oh, well!!" biggerPatch := patchRect expandBy: 1. biggerClip := (aDisplayTransform localBoundsToGlobal: biggerPatch) rounded. "Render the submorphs visible in the clipping rectangle, as patchForm" subCanvas := FormCanvas extent: biggerPatch extent depth: self depth. self isShadowDrawing ifTrue: [ subCanvas shadowColor: self shadowColor ]. "this biggerPatch/biggerClip is an attempt to improve positioning of the final image in high magnification conditions. Since we cannot grab fractional pixels from the source, take one extra and then take just the part we need from the expanded form" subCanvas translateBy: biggerPatch topLeft negated rounded + during: aBlock. - during: [ :offsetCanvas | aBlock value: offsetCanvas]. interForm := Form extent: biggerClip extent depth: self depth. subCanvas form displayInterpolatedIn: interForm boundingBox on: interForm. self drawImage: interForm at: aClipRect origin sourceRect: (aClipRect origin - biggerClip origin extent: aClipRect extent) ! Item was changed: ----- Method: ColorPatchCanvas>>transformBy:clippingTo:during:smoothing: (in category 'drawing-support') ----- transformBy: aDisplayTransform clippingTo: aClipRect during: aBlock smoothing: cellSize "Note: This method has been originally copied from TransformationMorph." | innerRect patchRect sourceQuad warp start subCanvas | (aDisplayTransform isPureTranslation) ifTrue:[ subCanvas := self copyOffset: aDisplayTransform offset negated truncated clipRect: aClipRect. aBlock value: subCanvas. foundMorph := subCanvas foundMorph. ^self ]. "Prepare an appropriate warp from patch to innerRect" innerRect := aClipRect. patchRect := aDisplayTransform globalBoundsToLocal: (self clipRect intersect: innerRect). sourceQuad := (aDisplayTransform sourceQuadFor: innerRect) collect: [:p | p - patchRect topLeft]. warp := self warpFrom: sourceQuad toRect: innerRect. warp cellSize: cellSize. "Render the submorphs visible in the clipping rectangle, as patchForm" start := (self depth = 1 and: [self isShadowDrawing not]) "If this is true B&W, then we need a first pass for erasure." ifTrue: [1] ifFalse: [2]. start to: 2 do: [:i | "If i=1 we first make a shadow and erase it for opaque whites in B&W" subCanvas := ColorPatchCanvas extent: patchRect extent depth: self depth. subCanvas stopMorph: stopMorph. subCanvas foundMorph: foundMorph. subCanvas doStop: doStop. i=1 ifTrue: [subCanvas shadowColor: Color black. warp combinationRule: Form erase] ifFalse: [self isShadowDrawing ifTrue: [subCanvas shadowColor: self shadowColor]. warp combinationRule: Form paint]. + subCanvas + translateBy: patchRect topLeft negated + during: aBlock. - subCanvas translateBy: patchRect topLeft negated - during:[:offsetCanvas| aBlock value: offsetCanvas]. i = 2 ifTrue:[foundMorph := subCanvas foundMorph]. warp sourceForm: subCanvas form; warpBits. warp sourceForm: nil. subCanvas := nil "release space for next loop"] ! Item was changed: ----- Method: DoCommandOnceMorph>>step (in category 'stepping and presenter') ----- step | goForIt | actionBlock ifNil: [^self stopStepping]. goForIt := actionBlock. actionBlock := nil. + goForIt - [ - goForIt value. - ] on: ProgressTargetRequestNotification do: [ :ex | ex resume: innerArea]. "in case a save/load progress display needs a home" ! Item was changed: ----- Method: FormCanvas>>transformBy:clippingTo:during:smoothing: (in category 'drawing-support') ----- transformBy: aDisplayTransform clippingTo: aClipRect during: aBlock smoothing: cellSize "Note: This method has been originally copied from TransformationMorph." | innerRect patchRect sourceQuad warp start subCanvas | (aDisplayTransform isPureTranslation) ifTrue:[ ^aBlock value: (self copyOffset: aDisplayTransform offset negated truncated clipRect: aClipRect) ]. "Prepare an appropriate warp from patch to innerRect" innerRect := aClipRect. patchRect := (aDisplayTransform globalBoundsToLocal: innerRect) truncated. sourceQuad := (aDisplayTransform sourceQuadFor: innerRect) collect: [:p | p - patchRect topLeft]. warp := self warpFrom: sourceQuad toRect: innerRect. "Render the submorphs visible in the clipping rectangle, as patchForm" start := (self depth = 1 and: [self isShadowDrawing not]) "If this is true B&W, then we need a first pass for erasure." ifTrue: [1] ifFalse: [2]. start to: 2 do: [:i | "If i=1 we first make a shadow and erase it for opaque whites in B&W" subCanvas := self class extent: patchRect extent depth: self depth. i=1 ifTrue: [subCanvas shadowColor: Color black. warp combinationRule: Form erase] ifFalse: [self isShadowDrawing ifTrue: [subCanvas shadowColor: self shadowColor]. warp combinationRule: Form paint]. + subCanvas + translateBy: patchRect topLeft negated + during: aBlock. - subCanvas translateBy: patchRect topLeft negated - during:[:offsetCanvas| aBlock value: offsetCanvas]. warp sourceForm: subCanvas form; cellSize: cellSize; warpBits. warp sourceForm: nil. subCanvas := nil "release space for next loop"] ! Item was changed: ----- Method: Morph>>submorphThat:ifNone: (in category 'submorphs-accessing') ----- submorphThat: block1 ifNone: block2 + + ^submorphs detect: block1 ifNone: block2 - ^ submorphs detect: [:m | (block1 value: m) == true] ifNone: [block2 value] ! Item was changed: ----- Method: PasteUpMorph>>becomeActiveDuring: (in category 'initialization') ----- becomeActiveDuring: aBlock "Make the receiver the ActiveWorld during the evaluation of aBlock. Note that this method does deliberately *not* use #ensure: to prevent re-installation of the world on project switches." | priorWorld priorHand priorEvent | priorWorld := ActiveWorld. priorHand := ActiveHand. priorEvent := ActiveEvent. ActiveWorld := self. ActiveHand := self hands first. "default" ActiveEvent := nil. "not in event cycle" + aBlock - [aBlock value] on: Error do: [:ex | ActiveWorld := priorWorld. ActiveEvent := priorEvent. ActiveHand := priorHand. ex pass]! Item was changed: ----- Method: SystemWindow>>paneMorphSatisfying: (in category 'panes') ----- paneMorphSatisfying: aBlock + + ^paneMorphs detect: aBlock ifNone: [ nil ]! - ^ paneMorphs detect: [:aPane | aBlock value: aPane] ifNone: [nil]!

1 0

The Trunk: Monticello-ul.477.mcz
by commits＠source.squeak.org 04 Aug '11

04 Aug '11

Levente Uzonyi uploaded a new version of Monticello to project The Trunk: http://source.squeak.org/trunk/Monticello-ul.477.mcz ==================== Summary ==================== Name: Monticello-ul.477 Author: ul Time: 3 August 2011, 1:46:49.384 am UUID: 251321fb-167b-9e48-882e-385f1474b157 Ancestors: Monticello-bf.476 Removed unnecessary blocks. =============== Diff against Monticello-bf.476 =============== Item was changed: ----- Method: MCHttpRepository>>displayProgress:during: (in category 'required') ----- displayProgress: label during: workBlock | nextUpdateTime | nextUpdateTime := 0. ^label displayProgressFrom: 0.0 to: 1.0 during:[:bar| + workBlock on: HTTPProgress do:[:ex| - [workBlock value] on: HTTPProgress do:[:ex| (ex total == nil or:[ex amount == nil]) ifFalse:[ (nextUpdateTime < Time millisecondClockValue or:[ex total = ex amount]) ifTrue:[ bar value: ex amount asFloat / ex total asFloat. nextUpdateTime := Time millisecondClockValue + 100. ]. ]. ex resume. ] ]. ! Item was changed: ----- Method: MCPackageLoader>>useChangeSetNamed:during: (in category 'private') ----- useChangeSetNamed: baseName during: aBlock "Use the named change set, or create one with the given name." | changeHolder oldChanges newChanges | changeHolder := (ChangeSet respondsTo: #newChanges:) ifTrue: [ChangeSet] ifFalse: [Smalltalk]. oldChanges := (ChangeSet respondsTo: #current) ifTrue: [ChangeSet current] ifFalse: [Smalltalk changes]. newChanges := (ChangesOrganizer changeSetNamed: baseName) ifNil: [ ChangeSet new name: baseName ]. changeHolder newChanges: newChanges. + aBlock ensure: [changeHolder newChanges: oldChanges]. - [aBlock value] ensure: [changeHolder newChanges: oldChanges]. ! Item was changed: ----- Method: MCVersionReader class>>file:streamDo: (in category 'reading') ----- file: fileName streamDo: aBlock + ^FileStream readOnlyFileNamed: fileName do: aBlock! - ^FileStream readOnlyFileNamed: fileName do: [ :file | - aBlock value: file ]!

1 0

The Trunk: Kernel-ul.611.mcz
by commits＠source.squeak.org 04 Aug '11

04 Aug '11

Levente Uzonyi uploaded a new version of Kernel to project The Trunk: http://source.squeak.org/trunk/Kernel-ul.611.mcz ==================== Summary ==================== Name: Kernel-ul.611 Author: ul Time: 3 August 2011, 1:45:38.639 am UUID: f6f9f434-559e-4442-a77a-58e4c0e29442 Ancestors: Kernel-nice.610 Removed unnecessary blocks. =============== Diff against Kernel-nice.610 =============== Item was changed: ----- Method: Behavior>>compiledMethodAt:ifAbsent: (in category 'accessing method dictionary') ----- compiledMethodAt: selector ifAbsent: aBlock "Answer the compiled method associated with the argument, selector (a Symbol), a message selector in the receiver's method dictionary. If the selector is not in the dictionary, return the value of aBlock" + ^ self methodDict at: selector ifAbsent: aBlock! - ^ self methodDict at: selector ifAbsent: [aBlock value]! Item was changed: ----- Method: BlockClosure>>on:do:on:do: (in category 'exceptions') ----- on: exc1 do: block1 on: exc2 do: block2 ^[ + self - [ self value ] on: exc1 do: block1 ] - on: exc2 do: block2! Item was changed: ----- Method: BlockClosure>>on:do:on:do:on:do: (in category 'exceptions') ----- on: exc1 do: block1 on: exc2 do: block2 on: exc3 do: block3 ^[ + self - [ self value ] on: exc1 do: block1 ] - on: exc2 do: block2 - on: exc3 do: block3! Item was changed: ----- Method: BlockClosure>>valueSupplyingAnswers: (in category 'evaluating') ----- valueSupplyingAnswers: aListOfPairs "evaluate the block using a list of questions / answers that might be called upon to automatically respond to Object>>confirm: or FillInTheBlank requests" + ^self - ^ [self value] on: ProvideAnswerNotification + do: [ :notification | + | caption | + caption := notification messageText withSeparatorsCompacted. "to remove new lines" + aListOfPairs + detect: [ :each | + caption = each first + or: [ (caption includesSubstring: each first caseSensitive: false) + or: [ each first match: caption ] ] ] + ifFound: [ :answer | notification resume: answer second ] + ifNone: [ + (ProvideAnswerNotification signal: notification messageText) + ifNil: [ notification resume ] + ifNotNil: [ :outerAnswer | notification resume: outerAnswer ] ] ]! - do: - [:notify | | answer caption | - - caption := notify messageText withSeparatorsCompacted. "to remove new lines" - answer := aListOfPairs - detect: - [:each | caption = each first - or: [(caption includesSubstring: each first caseSensitive: false) - or: [each first match: caption]]] - ifNone: [nil]. - answer - ifNotNil: [notify resume: answer second] - ifNil: - [ | outerAnswer | - outerAnswer := ProvideAnswerNotification signal: notify messageText. - outerAnswer - ifNil: [notify resume] - ifNotNil: [notify resume: outerAnswer]]]! Item was changed: ----- Method: BlockContext>>on:do:on:do: (in category 'exceptions') ----- on: exc1 do: block1 on: exc2 do: block2 ^[ + self - [ self value ] on: exc1 do: block1 ] - on: exc2 do: block2! Item was changed: ----- Method: BlockContext>>on:do:on:do:on:do: (in category 'exceptions') ----- on: exc1 do: block1 on: exc2 do: block2 on: exc3 do: block3 ^[ + self - [ self value ] on: exc1 do: block1 ] - on: exc2 do: block2 - on: exc3 do: block3! Item was changed: ----- Method: BlockContext>>valueSupplyingAnswers: (in category 'evaluating') ----- valueSupplyingAnswers: aListOfPairs "evaluate the block using a list of questions / answers that might be called upon to automatically respond to Object>>confirm: or FillInTheBlank requests" + ^self - ^ [self value] on: ProvideAnswerNotification do: [:notify | | answer caption | caption := notify messageText withSeparatorsCompacted. "to remove new lines" answer := aListOfPairs detect: [:each | caption = each first or: [(caption includesSubstring: each first caseSensitive: false) or: [each first match: caption]]] ifNone: [nil]. answer ifNotNil: [notify resume: answer second] ifNil: [ | outerAnswer | outerAnswer := ProvideAnswerNotification signal: notify messageText. outerAnswer ifNil: [notify resume] ifNotNil: [notify resume: outerAnswer]]]! Item was changed: ----- Method: Object>>removeActionsSatisfying:forEvent: (in category 'events-removing') ----- removeActionsSatisfying: aOneArgBlock forEvent: anEventSelector self setActionSequence: ((self actionSequenceForEvent: anEventSelector) + reject: aOneArgBlock) - reject: [:anAction | aOneArgBlock value: anAction]) forEvent: anEventSelector! Item was changed: ----- Method: WeakMessageSend>>valueOtherwise: (in category 'evaluating') ----- valueOtherwise: aBlock + ^ arguments ifNil: [ + self withEnsuredReceiverDo: [ :r | r perform: selector ] otherwise: aBlock ] - self withEnsuredReceiverDo: [ :r | r perform: selector ] otherwise: [ aBlock value ]] ifNotNil: [ self withEnsuredReceiverAndArgumentsDo: [ :r :a | r perform: selector withArguments: a ] + otherwise: aBlock ]! - otherwise: [ aBlock value ]]! Item was changed: ----- Method: WeakMessageSend>>valueWithArguments:otherwise: (in category 'evaluating') ----- valueWithArguments: anArray otherwise: aBlock | argsToUse | "Safe to use, because they are built before ensureing receiver and args..." argsToUse := self collectArguments: anArray. ^ self withEnsuredReceiverAndArgumentsDo: [ :r :a | r perform: selector withArguments: argsToUse ] + otherwise: aBlock! - otherwise: [ aBlock value ]!

1 0

← Newer
1
...
11
12
13
14
15
16
17
18
Older →

Jump to page: