Squeak-dev November 2011

squeak-dev@lists.squeakfoundation.org

52 participants
168 discussions

The Trunk: System-eem.460.mcz
by commits＠source.squeak.org 04 Nov '11

04 Nov '11

Eliot Miranda uploaded a new version of System to project The Trunk: http://source.squeak.org/trunk/System-eem.460.mcz ==================== Summary ==================== Name: System-eem.460 Author: eem Time: 4 November 2011, 9:24:41.847 am UUID: 8a0828f0-10ab-47fa-b913-702447f13375 Ancestors: System-laza.459 Refactor SystemNavigation>>browseAllStoresInto:from: to provide SystemNavigation>>allStoresInto:from:. =============== Diff against System-laza.459 =============== Item was changed: ----- Method: SystemNavigation>>allAccessesTo:from: (in category 'query') ----- allAccessesTo: instVarName from: aClass + "Return a sequence of MethodReferences of all methods of aClass or it's sub/superclass that refer to the instance variable instVarName." - "Return a collection of all methods of aClass or it's sub/superclass that refer to the instance variable instVarName." | result | result := OrderedCollection new. + aClass withAllSubAndSuperclassesDo: + [ :class | + (class whichSelectorsAccess: instVarName) do: + [ :selector | - aClass withAllSubAndSuperclassesDo: [ :class | - (class whichSelectorsAccess: instVarName) do: [ :selector | result add: (MethodReference class: class selector: selector) ] ]. ^result! Item was added: + ----- Method: SystemNavigation>>allStoresInto:from: (in category 'query') ----- + allStoresInto: varName from: aClass + "Answer a sequence of MewthodReferences for all the receiver's methods + or any methods of a subclass/superclass that assign to the instance variable name." + "self new allStoresInto: 'contents' from: Collection." + | result | + result := OrderedCollection new. + aClass withAllSubAndSuperclassesDo: + [ : class | + (class whichMethodsStoreInto: varName) do: + [ : eachMethod | + result add: eachMethod methodReference ] ]. + ^result! Item was changed: ----- Method: SystemNavigation>>browseAllStoresInto:from: (in category 'browse') ----- + browseAllStoresInto: varName from: aClass - browseAllStoresInto: varName from: aClass "Create and schedule a Message Set browser for all the receiver's methods or any methods of a subclass/superclass that refer to the instance variable name." "self new browseAllStoresInto: 'contents' from: Collection." - | coll | - coll := OrderedCollection new. - Cursor wait showWhile: - [ aClass withAllSubAndSuperclassesDo: - [ : class | (class whichMethodsStoreInto: varName) do: - [ : eachMethod | eachMethod selector isDoIt ifFalse: [ coll add: eachMethod methodReference ] ] ] ]. ^ self + browseMessageList: (self allStoresInto: varName from: aClass) - browseMessageList: coll name: 'Stores into ' , varName autoSelect: varName!

1 0

The Trunk: Kernel-laza.649.mcz
by commits＠source.squeak.org 04 Nov '11

04 Nov '11

Alexander Lazarević uploaded a new version of Kernel to project The Trunk: http://source.squeak.org/trunk/Kernel-laza.649.mcz ==================== Summary ==================== Name: Kernel-laza.649 Author: laza Time: 3 November 2011, 1:09:36.555 am UUID: 9ee9cceb-4b76-3d41-8a57-bd0b6eb79dc0 Ancestors: Kernel-eem.648 Make protocol changes be recorded by the changes file. =============== Diff against Kernel-eem.648 =============== Item was changed: ----- Method: ClassOrganizer>>addCategory:before: (in category 'accessing') ----- addCategory: catString before: nextCategory - | oldCategories | - oldCategories := self categories copy. SystemChangeNotifier uniqueInstance doSilently: [ super addCategory: catString before: nextCategory]. + self notifyOfChangedCategoryFrom: nil to: catString.! - self notifyOfChangedCategoriesFrom: oldCategories to: self categories.! Item was changed: ----- Method: ClassOrganizer>>notifyOfChangedCategoryFrom:to: (in category 'private') ----- notifyOfChangedCategoryFrom: oldNameOrNil to: newNameOrNil (self hasSubject and: [oldNameOrNil ~= newNameOrNil]) + ifTrue: [ + oldNameOrNil + ifNil: [ + newNameOrNil ifNotNil: [ + SystemChangeNotifier uniqueInstance + protocolAdded: newNameOrNil inClass: self subject. + ] + ] + ifNotNil: [ + newNameOrNil ifNil: [ + SystemChangeNotifier uniqueInstance + protocolRemoved: oldNameOrNil inClass: self subject. + ] + ifNotNil: [ + SystemChangeNotifier uniqueInstance + protocolRenamedFrom: oldNameOrNil to: newNameOrNil inClass: self subject. + ] + ]. + ].! - ifTrue: [SystemChangeNotifier uniqueInstance classReorganized: self subject].! Item was changed: ----- Method: ClassOrganizer>>removeCategory: (in category 'accessing') ----- removeCategory: cat - | oldCategories | - oldCategories := self categories copy. SystemChangeNotifier uniqueInstance doSilently: [ super removeCategory: cat]. + self notifyOfChangedCategoryFrom: cat to: nil.! - self notifyOfChangedCategoriesFrom: oldCategories to: self categories.! Item was changed: ----- Method: ClassOrganizer>>renameCategory:toBe: (in category 'accessing') ----- renameCategory: oldCatString toBe: newCatString + | oldCat newCat | - | oldCat newCat oldElementsBefore oldElementsAfter | oldCat := oldCatString asSymbol. newCat := newCatString asSymbol. - oldElementsBefore := self listAtCategoryNamed: oldCat. SystemChangeNotifier uniqueInstance doSilently: [ super renameCategory: oldCatString toBe: newCatString]. - oldElementsAfter := (self listAtCategoryNamed: oldCat) asSet. - oldElementsBefore do: [:each | - (oldElementsAfter includes: each) - ifFalse: [self notifyOfChangedSelector: each from: oldCat to: newCat]. - ]. self notifyOfChangedCategoryFrom: oldCat to: newCat.!

1 0

The Trunk: System-laza.459.mcz
by commits＠source.squeak.org 04 Nov '11

04 Nov '11

Alexander Lazarević uploaded a new version of System to project The Trunk: http://source.squeak.org/trunk/System-laza.459.mcz ==================== Summary ==================== Name: System-laza.459 Author: laza Time: 3 November 2011, 8:13:48.899 am UUID: 7bf95c73-93c1-d044-b91e-75e6e1456825 Ancestors: System-laza.458 Make SystemOrganizer trigger a notification on adding a category =============== Diff against System-laza.457 =============== Item was added: + ----- Method: AbstractEvent class>>protocol:class: (in category 'instance creation') ----- + protocol: aProtocol class: aClass + + | instance | + instance := self item: aProtocol kind: self protocolKind. + instance itemClass: aClass. + ^instance! Item was changed: ----- Method: SmalltalkImage>>event: (in category 'sources, changes log') ----- event: anEvent "Hook for SystemChangeNotifier" + anEvent isDoIt ifTrue: [^self logChange: anEvent item]. + (anEvent itemKind = SystemChangeNotifier categoryKind) ifTrue: [ + anEvent isAdded + ifTrue: [^self logChange: 'SystemOrganization addCategory: ', anEvent item storeString]. + anEvent isRemoved + ifTrue: [^self logChange: 'SystemOrganization removeSystemCategory: ', anEvent item storeString]. + anEvent isRenamed + ifTrue: [^self logChange: 'SystemOrganization renameCategory: ', anEvent oldName storeString, ' toBe: ', anEvent newName storeString]. - (anEvent isRemoved and: [anEvent itemKind = SystemChangeNotifier classKind]) ifTrue: [ - anEvent item acceptsLoggingOfCompilation - ifTrue: [self logChange: 'Smalltalk removeClassNamed: #' , anEvent item name]. ]. + + (anEvent itemKind = SystemChangeNotifier classKind) ifTrue: [ + anEvent item acceptsLoggingOfCompilation ifFalse: [^self]. + "anEvent isAdded ifTrue: [ + self logChange: anEvent item definition. + ]." + anEvent isModified + ifTrue: [^self logChange: anEvent item definition]. + anEvent isRemoved + ifTrue: [^self logChange: 'Smalltalk removeClassNamed: ' , anEvent item name storeString]. + anEvent isRenamed + ifTrue: [^self logChange: 'Smalltalk renameClassNamed: ', anEvent oldName storeString, ' as: ', anEvent newName storeString]. + ]. + + (anEvent itemKind = SystemChangeNotifier protocolKind) ifTrue: [ + anEvent isAdded + ifTrue: [^self logChange: anEvent itemClass name , ' organization addCategory: ' , anEvent itemProtocol storeString]. + anEvent isRemoved + ifTrue: [^self logChange: anEvent itemClass name , ' organization removeCategory: ' , anEvent itemProtocol storeString]. + anEvent isRenamed + ifTrue: [^self logChange: anEvent itemClass name , ' organization renameCategory: ' , anEvent oldName storeString, ' toBe: ', anEvent newName storeString]. + ]. + + (anEvent itemKind = SystemChangeNotifier methodKind) ifTrue: [ + anEvent itemClass acceptsLoggingOfCompilation ifFalse: [^self]. + anEvent isRemoved + ifTrue: [^self logChange: anEvent itemClass name , ' removeSelector: ' , anEvent itemSelector storeString]. + anEvent isRecategorized + ifTrue: [ + | newProtocol | + newProtocol := anEvent itemClass organization categoryOfElement: anEvent item selector. + ^self logChange: anEvent itemClass name , ' organization classify: ', anEvent item selector storeString, ' under: ', newProtocol storeString. + ]. + ].! - anEvent isDoIt - ifTrue: [self logChange: anEvent item]. - (anEvent isRemoved and: [anEvent itemKind = SystemChangeNotifier methodKind]) ifTrue: [ - anEvent itemClass acceptsLoggingOfCompilation - ifTrue: [self logChange: anEvent itemClass name , ' removeSelector: #' , anEvent itemSelector]].! Item was added: + ----- Method: SystemChangeNotifier>>protocolAdded:inClass: (in category 'system triggers') ----- + protocolAdded: aProtocol inClass: aClass + self trigger: ( + AddedEvent protocol: aProtocol class: aClass + )! Item was added: + ----- Method: SystemChangeNotifier>>protocolRemoved:inClass: (in category 'system triggers') ----- + protocolRemoved: aProtocol inClass: aClass + self trigger: ( + RemovedEvent protocol: aProtocol class: aClass + )! Item was added: + ----- Method: SystemChangeNotifier>>protocolRenamedFrom:to:inClass: (in category 'system triggers') ----- + protocolRenamedFrom: anOldProtocol to: aNewProtocol inClass: aClass + self trigger: ( + (RenamedEvent protocol: anOldProtocol class: aClass) + oldName: anOldProtocol; + newName: aNewProtocol + )! Item was removed: - ----- Method: SystemOrganizer>>addCategory: (in category 'accessing') ----- - addCategory: newCategory - | r | - r := super addCategory: newCategory. - SystemChangeNotifier uniqueInstance classCategoryAdded: newCategory. - ^ r! Item was added: + ----- Method: SystemOrganizer>>addCategory:before: (in category 'accessing') ----- + addCategory: catString before: nextCategory + SystemChangeNotifier uniqueInstance doSilently: [ + super addCategory: catString before: nextCategory]. + SystemChangeNotifier uniqueInstance classCategoryAdded: catString. + !

1 0

The Trunk: SystemChangeNotification-Tests-laza.16.mcz
by commits＠source.squeak.org 04 Nov '11

04 Nov '11

Alexander Lazarević uploaded a new version of SystemChangeNotification-Tests to project The Trunk: http://source.squeak.org/trunk/SystemChangeNotification-Tests-laza.16.mcz ==================== Summary ==================== Name: SystemChangeNotification-Tests-laza.16 Author: laza Time: 3 November 2011, 8:09:52.984 am UUID: 8edbb2d9-dbf3-6d44-8e0d-941702d8f7cc Ancestors: SystemChangeNotification-Tests-laza.15 SystemOrganizer>>addCategory:before: does not trigger any notifications =============== Diff against SystemChangeNotification-Tests-bp.11 =============== Item was added: + TestCase subclass: #SystemChangeFileTest + instanceVariableNames: 'tempChangesFile' + classVariableNames: '' + poolDictionaries: '' + category: 'SystemChangeNotification-Tests'! Item was added: + ----- Method: SystemChangeFileTest>>change:verify: (in category 'testing') ----- + change: changeBlock verify: verifyBlock + self prepare: [] change: changeBlock verify: verifyBlock! Item was added: + ----- Method: SystemChangeFileTest>>createClass: (in category 'private') ----- + createClass: name + ^Object + subclass: name + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: self genericClassCategory! Item was added: + ----- Method: SystemChangeFileTest>>directory (in category 'accessing') ----- + directory + "Where we want to place the temporary changes file" + ^FileDirectory default! Item was added: + ----- Method: SystemChangeFileTest>>genericClassCategory (in category 'private') ----- + genericClassCategory + ^(self prefixClassCategory, self randomString capitalized) asSymbol! Item was added: + ----- Method: SystemChangeFileTest>>genericClassName (in category 'private') ----- + genericClassName + ^(self prefixClassName, self randomString capitalized) asSymbol! Item was added: + ----- Method: SystemChangeFileTest>>genericInstVarName (in category 'private') ----- + genericInstVarName + ^(self prefixInstVarName, self randomString capitalized) asSymbol! Item was added: + ----- Method: SystemChangeFileTest>>genericProtocol (in category 'private') ----- + genericProtocol + ^(self prefixProtocol, self randomString) asSymbol! Item was added: + ----- Method: SystemChangeFileTest>>genericSelector (in category 'private') ----- + genericSelector + ^(self prefixSelector, self randomString capitalized) asSymbol! Item was added: + ----- Method: SystemChangeFileTest>>prefixClassCategory (in category 'private') ----- + prefixClassCategory + ^self prefixGeneral, 'Category-'! Item was added: + ----- Method: SystemChangeFileTest>>prefixClassName (in category 'private') ----- + prefixClassName + ^self prefixGeneral, 'Class'! Item was added: + ----- Method: SystemChangeFileTest>>prefixGeneral (in category 'private') ----- + prefixGeneral + ^self class name select: [:each | each isUppercase]! Item was added: + ----- Method: SystemChangeFileTest>>prefixInstVarName (in category 'private') ----- + prefixInstVarName + ^self prefixGeneral asLowercase, 'InstVar'! Item was added: + ----- Method: SystemChangeFileTest>>prefixProtocol (in category 'private') ----- + prefixProtocol + ^self prefixGeneral asLowercase, ' protocol '! Item was added: + ----- Method: SystemChangeFileTest>>prefixSelector (in category 'private') ----- + prefixSelector + ^self prefixGeneral asLowercase, 'Selector'! Item was added: + ----- Method: SystemChangeFileTest>>prepare:change:verify: (in category 'testing') ----- + prepare: prepareBlock change: changeBlock verify: verifyBlock + "All tests follow this pattern. Beware that prepareBlock (and verifyBlock) will be evalutated twice." + + "Setup the testcourt" + prepareBlock value. + + "Embrace the changeBlock so that any changes to our testcourt + gets recorded in our temporary changes file" + self useTemporaryChangesFile. + changeBlock value. + "Check if the changes we made worked as expected. We need to do + this before we switch back to the standard changes file" + "We raise an Error if this fails, because then the testcase is broken" + [verifyBlock value] + on: TestFailure + do: [self error: 'The verifyBlock needs to validate the changes made in the changeBlock']. + self useStandardChangesFile. + + "Remove the testcourt completely" + self removeTestcourt. + + "Setup the testcourt once again" + prepareBlock value. + + "Replay the changes from the temporary changes file" + self replayChanges. + + "See if we got the same changes as we did before using the changeBlock" + verifyBlock value. + ! Item was added: + ----- Method: SystemChangeFileTest>>randomString (in category 'private') ----- + randomString + ^Character alphabet shuffled! Item was added: + ----- Method: SystemChangeFileTest>>removeTestcourt (in category 'private') ----- + removeTestcourt + SystemOrganization categories do: [:each | + (each beginsWith: self prefixClassCategory) ifTrue: [ + SystemOrganization removeSystemCategory: each. + ]. + ]. + + ! Item was added: + ----- Method: SystemChangeFileTest>>replayChanges (in category 'private') ----- + replayChanges + | file | + file := FileStream fileNamed: (self directory fullNameFor: self tempChangesName). + Transcript show: file contents; cr. + file fileIn. + ! Item was added: + ----- Method: SystemChangeFileTest>>tearDown (in category 'running') ----- + tearDown + self useStandardChangesFile. + tempChangesFile := tempChangesFile ifNotNil: [tempChangesFile close]. + (self directory fileExists: self tempChangesName) + ifTrue: [self directory deleteFileNamed: self tempChangesName]. + self removeTestcourt. + ! Item was added: + ----- Method: SystemChangeFileTest>>tempChangesName (in category 'accessing') ----- + tempChangesName + ^'temp.changes'! Item was added: + ----- Method: SystemChangeFileTest>>testCategoryAdded (in category 'testing') ----- + testCategoryAdded + | aClassCategory | + aClassCategory := self genericClassCategory. + self + change: [ + SystemOrganization addCategory: aClassCategory. + ] + verify: [ + self assert: (SystemOrganization categories includes: aClassCategory). + ] + ! Item was added: + ----- Method: SystemChangeFileTest>>testCategoryAddedBefore (in category 'testing') ----- + testCategoryAddedBefore + | aClassCategory | + aClassCategory := self genericClassCategory. + self + change: [ + SystemOrganization addCategory: aClassCategory before: nil. + ] + verify: [ + self assert: (SystemOrganization categories includes: aClassCategory). + ] + ! Item was added: + ----- Method: SystemChangeFileTest>>testCategoryModified (in category 'as yet unclassified') ----- + testCategoryModified! Item was added: + ----- Method: SystemChangeFileTest>>testCategoryRemoved (in category 'testing') ----- + testCategoryRemoved + | aClassCategory | + aClassCategory := self genericClassCategory. + self + prepare: [ + SystemOrganization addCategory: aClassCategory. + ] + change: [ + SystemOrganization removeCategory: aClassCategory. + ] + verify: [ + self deny: (SystemOrganization categories includes: aClassCategory). + ] + ! Item was added: + ----- Method: SystemChangeFileTest>>testCategoryRenamed (in category 'testing') ----- + testCategoryRenamed + | aNewClassCategory anOldClassCategory | + anOldClassCategory := self genericClassCategory. + aNewClassCategory := self genericClassCategory. + self + prepare: [ + SystemOrganization addCategory: anOldClassCategory. + ] + change: [ + SystemOrganization renameCategory: anOldClassCategory toBe: aNewClassCategory + ] + verify: [ + self assert: (SystemOrganization categories includes: aNewClassCategory). + self deny: (SystemOrganization categories includes: anOldClassCategory). + ] + ! Item was added: + ----- Method: SystemChangeFileTest>>testClassAdded (in category 'testing') ----- + testClassAdded + | aClassName | + aClassName := self genericClassName. + self + change: [ + self createClass: aClassName. + ] + verify: [ + self assert: (Smalltalk keys includes: aClassName). + ] + + ! Item was added: + ----- Method: SystemChangeFileTest>>testClassCommented (in category 'testing') ----- + testClassCommented + | aClass aClassName aComment | + aClassName := self genericClassName. + self + prepare: [ + aClass := self createClass: aClassName. + ] + change: [ + aComment := self randomString. + aClass classComment: aComment. + ] + verify: [ + self assert: aClass organization classComment string = aComment. + ].! Item was added: + ----- Method: SystemChangeFileTest>>testClassModified (in category 'testing') ----- + testClassModified + | aClass aClassName aInstVarName | + aClassName := self genericClassName. + self + prepare: [ + aClass := self createClass: aClassName. + ] + change: [ + aInstVarName := self genericInstVarName. + aClass addInstVarName: aInstVarName. + ] + verify: [ + self assert: (aClass instVarNames includes: aInstVarName). + ].! Item was added: + ----- Method: SystemChangeFileTest>>testClassRecategorized (in category 'as yet unclassified') ----- + testClassRecategorized! Item was added: + ----- Method: SystemChangeFileTest>>testClassRemoved (in category 'testing') ----- + testClassRemoved + | aClass aClassName | + aClassName := self genericClassName. + self + prepare: [ + aClass := self createClass: aClassName. + ] + change: [ + aClass removeFromSystem. + ] + verify: [ + self deny: (Smalltalk keys includes: aClassName). + ]. + ! Item was added: + ----- Method: SystemChangeFileTest>>testClassRenamed (in category 'testing') ----- + testClassRenamed + | aClass aNewClassName anOldClassName | + anOldClassName := self genericClassName. + aNewClassName := self genericClassName. + self + prepare: [ + aClass := self createClass: anOldClassName. + ] + change: [ + aClass rename: aNewClassName. + ] + verify: [ + self assert: (Smalltalk keys includes: aNewClassName). + self deny: (Smalltalk keys includes: anOldClassName). + ].! Item was added: + ----- Method: SystemChangeFileTest>>testClassReorganized (in category 'as yet unclassified') ----- + testClassReorganized! Item was added: + ----- Method: SystemChangeFileTest>>testExpressionDoIt (in category 'testing') ----- + testExpressionDoIt + | aClassName | + aClassName := self genericClassName.. + self + prepare: [ + self createClass: aClassName. + ] + change: [ + Compiler evaluate: '(Smalltalk at: ', aClassName storeString, ') removeFromSystem'. + ] + verify: [ + self deny: (Smalltalk keys includes: aClassName). + ].! Item was added: + ----- Method: SystemChangeFileTest>>testMethodAdded (in category 'testing') ----- + testMethodAdded + | aClassName aClass aSelector | + aClassName := self genericClassName. + self + prepare: [ + aClass := self createClass: aClassName. + ] + change: [ + aSelector := self genericSelector. + aClass compile: aSelector. + ] + verify: [ + self assert: (aClass methodDict keys includes: aSelector). + ] + + ! Item was added: + ----- Method: SystemChangeFileTest>>testMethodModified (in category 'testing') ----- + testMethodModified + | aClassName aClass aSelector aMethodSource | + aClassName := self genericClassName. + aSelector := self genericSelector. + self + prepare: [ + aClass := self createClass: aClassName. + aClass compile: aSelector, ' ', self randomString storeString. + ] + change: [ + aMethodSource := aSelector, ' ', self randomString storeString. + aClass compile: aMethodSource. + ] + verify: [ + self assert: (aClass sourceCodeAt: aSelector) string = aMethodSource. + ] + + ! Item was added: + ----- Method: SystemChangeFileTest>>testMethodRecategorized (in category 'testing') ----- + testMethodRecategorized + | aClassName aClass aNewProtocol aSelector anOldProtocol | + aClassName := self genericClassName. + aSelector := self genericSelector. + anOldProtocol := self genericProtocol. + self + prepare: [ + aClass := self createClass: aClassName. + aClass compile: aSelector classified: anOldProtocol. + ] + change: [ + aNewProtocol := self genericProtocol. + aClass organization classify: aSelector under: aNewProtocol. + ] + verify: [ + self assert: (aClass organization categoryOfElement: aSelector) = aNewProtocol + ] + + ! Item was added: + ----- Method: SystemChangeFileTest>>testMethodRemoved (in category 'testing') ----- + testMethodRemoved + | aClassName aClass aSelector | + aClassName := self genericClassName. + aSelector := self genericSelector. + self + prepare: [ + aClass := self createClass: aClassName. + aClass compile: aSelector. + ] + change: [ + aClass removeSelector: aSelector. + ] + verify: [ + self deny: (aClass methodDict keys includes: aSelector). + ] + + ! Item was added: + ----- Method: SystemChangeFileTest>>testProtocolAdded (in category 'testing') ----- + testProtocolAdded + | aClassName aClass aProtocol | + aClassName := self genericClassName. + aProtocol := self genericProtocol. + self + prepare: [ + aClass := self createClass: aClassName. + ] + change: [ + aClass organization addCategory: aProtocol. + ] + verify: [ + self assert: (aClass organization categories includes: aProtocol) + ] + + ! Item was added: + ----- Method: SystemChangeFileTest>>testProtocolDefault (in category 'testing') ----- + testProtocolDefault + | aClassName aClass aSelector | + aClassName := self genericClassName. + self + prepare: [ + aClass := self createClass: aClassName. + ] + change: [ + aSelector := self genericSelector. + aClass compile: aSelector. + ] + verify: [ + self assert: (aClass organization categoryOfElement: aSelector) = aClass organization class default. + ] + + ! Item was added: + ----- Method: SystemChangeFileTest>>testProtocolModified (in category 'as yet unclassified') ----- + testProtocolModified! Item was added: + ----- Method: SystemChangeFileTest>>testProtocolRemoved (in category 'testing') ----- + testProtocolRemoved + | aClassName aClass aProtocol | + aClassName := self genericClassName. + aProtocol := self genericProtocol. + self + prepare: [ + aClass := self createClass: aClassName. + aClass organization addCategory: aProtocol. + ] + change: [ + aClass organization removeCategory: aProtocol. + ] + verify: [ + self deny: (aClass organization categories includes: aProtocol) + ] + + ! Item was added: + ----- Method: SystemChangeFileTest>>testProtocolRenamed (in category 'testing') ----- + testProtocolRenamed + | aClassName aClass anOldProtocol aNewProtocol | + aClassName := self genericClassName. + anOldProtocol := self genericProtocol. + self + prepare: [ + aClass := self createClass: aClassName. + aClass organization addCategory: anOldProtocol. + ] + change: [ + aNewProtocol := self genericProtocol. + aClass organization renameCategory: anOldProtocol toBe: aNewProtocol. + ] + verify: [ + self deny: (aClass organization categories includes: anOldProtocol). + self assert: (aClass organization categories includes: aNewProtocol). + ] + + ! Item was added: + ----- Method: SystemChangeFileTest>>useStandardChangesFile (in category 'private') ----- + useStandardChangesFile + Smalltalk + closeSourceFiles; + openSourceFiles! Item was added: + ----- Method: SystemChangeFileTest>>useTemporaryChangesFile (in category 'private') ----- + useTemporaryChangesFile + Smalltalk closeSourceFiles. + tempChangesFile := self directory forceNewFileNamed: self tempChangesName. + SourceFiles at: 2 put: tempChangesFile!

1 0

Connecting some loose ends for the changes file
by Alexander Lazarević 04 Nov '11

04 Nov '11

There are some very old loose ends in SystemChangeNotifier so that the changes file does not record everything you do. This shows up if you do some class renames or move methods around categories and then try to recover from the changes file. None of these changes get recorded in the changes file. After bitching for years about this I tried to see what I could do. So I connected some loose ends in SystemChangeNotifier, so that the changes get pulled through to the changes file. This won't make SystemChangeNotifier any nicer though. To play with this get from the Inbox: SystemChangeNotification-Tests-laza.15 System-laza.458 Kernel-laza.649 Alex

3 3

The Inbox: Kernel-nice.651.mcz
by commits＠source.squeak.org 03 Nov '11

03 Nov '11

Nicolas Cellier uploaded a new version of Kernel to project The Inbox: http://source.squeak.org/inbox/Kernel-nice.651.mcz ==================== Summary ==================== Name: Kernel-nice.651 Author: nice Time: 3 November 2011, 11:12:46.086 pm UUID: c8b1e674-7598-479c-b705-83dca79959f2 Ancestors: Kernel-eem.648 Print Float with the minimal number of decimal digits that describe it unambiguously. This way, every two different Float will have a different printed representation. More over, every Float can be reconstructed from its printed representation. I've made this change in Pharo. Now I'd really like to get this in Squeak too. These are obscuring our data: 0.1 successor printString = 0.1 printString. 1.0e-100 printString = '9.99999999999999e-101'. If we want some representation with limited number of digits, then let's ask for it. But a default behaviour returning so many digits without bijection is just useless. Maybe some won't like Float nan printString = 'Float nan'. But that's a detail we can eventually change back. The essential is to use absPrintExactlyOn:base: Side note: this is really a bad name, because it prints the shortest base-representation, not the exact one. Anyway, it can only print the exact one in even bases. For example, the exact representation of 0.1 in base 10 is 0.1 asFraction asScaledDecimal 0.1000000000000000055511151231257827021181583404541015625s55 =============== Diff against Kernel-eem.648 =============== Item was changed: ----- Method: Float>>printOn:base: (in category 'printing') ----- printOn: aStream base: base + "Print the receiver with the minimal number of digits that describe it unambiguously. + This way, every two different Float will have a different printed representation. + More over, every Float can be reconstructed from its printed representation." - "Handle sign, zero, and NaNs; all other values passed to absPrintOn:base:" + self storeOn: aStream base: base! - self isNaN ifTrue: [aStream nextPutAll: 'NaN'. ^ self]. "check for NaN before sign" - self > 0.0 - ifTrue: [self absPrintOn: aStream base: base] - ifFalse: - [self sign = -1 - ifTrue: [aStream nextPutAll: '-']. - self = 0.0 - ifTrue: [aStream nextPutAll: '0.0'. ^ self] - ifFalse: [self negated absPrintOn: aStream base: base]]!

1 0

The Inbox: Kernel-nice.650.mcz
by commits＠source.squeak.org 03 Nov '11

03 Nov '11

A new version of Kernel was added to project The Inbox: http://source.squeak.org/inbox/Kernel-nice.650.mcz ==================== Summary ==================== Name: Kernel-nice.650 Author: nice Time: 3 November 2011, 9:17:16.187 pm UUID: e8775ee0-9502-469d-81b5-e7c39f9947a0 Ancestors: Kernel-eem.648 Provide a Float>>asMinimalDecimalFraction which answers the shortest decimal Fraction that will equal the receiver when converted back asFloat. A decimal Fraction has only powers of 2 and 5 as denominator, so it can be printed in decimal with a finite number of digits. For example, 0.1 asMinimalDecimalFraction = (1/10). Note that this does not reflect what is exactly stored in memory. For this we should use asTrueFraction. (0.1 asTrueFraction storeStringBase: 2) = '(2r1100110011001100110011001100110011001100110011001101/2r10000000000000000000000000000000000000000000000000000000)'. Note that asApproximateFraction might give shorter Fractions, but - asApproximateFraction does not exclusively has power of 2 and 5 in denominator - asApproximateFraction does not necessarily convert back exactly to the receiver An example is: 0.11111111111 asApproximateFraction = (1/9). 0.11111111111 asMinimalDecimalFraction = (11111111111/100000000000). But: (1/9) asFloat storeString -> '0.1111111111111111' "has five more digits..." A good application for such message would be: 0.111111111 asMinimalDecimalFraction asScaledDecimal = 0.111111111s9. versus: 0.111111111 asTrueFraction asScaledDecimal = 0.11111111099999999851650755999799002893269062042236328125s56. The later reflects the exact representation of the Float though. =============== Diff against Kernel-eem.648 =============== Item was added: + ----- Method: Float>>asMinimalDecimalFraction (in category 'printing') ----- + asMinimalDecimalFraction + "Answer the shortest decimal Fraction that will equal self when converted back asFloat. + A decimal Fraction has only powers of 2 and 5 as denominator. + For example, 0.1 asMinimalDecimalFraction = (1/10)." + + | significand exp baseExpEstimate r s mPlus mMinus scale roundingIncludesLimits d tc1 tc2 fixedFormat decPointCount slowbit shead denominator numerator | + self isFinite ifFalse: [self error: 'Only finite Float can be converted to a Fraction']. + self = 0.0 ifTrue: [^0]. + self < 0.0 ifTrue: [^self negated asMinimalDecimalFraction negated]. + numerator := 0. + denominator := 0. + significand := self significandAsInteger. + roundingIncludesLimits := significand even. + exp := (self exponent - 52) max: MinValLogBase2. + baseExpEstimate := (self exponent * 10 asFloat reciprocalLogBase2 - 1.0e-10) ceiling. + exp >= 0 + ifTrue: + [significand ~= 16r10000000000000 + ifTrue: + [r := significand bitShift: 1 + exp. + s := 2. + mPlus := mMinus := 1 bitShift: exp] + ifFalse: + [r := significand bitShift: 2 + exp. + s := 4. + mPlus := 2 * (mMinus := 1 bitShift: exp)]] + ifFalse: + [(exp = MinValLogBase2 or: [significand ~= 16r10000000000000]) + ifTrue: + [r := significand bitShift: 1. + s := 1 bitShift: 1 - exp. + mPlus := mMinus := 1] + ifFalse: + [r := significand bitShift: 2. + s := 1 bitShift: 2 - exp. + mPlus := 2. + mMinus := 1]]. + baseExpEstimate >= 0 + ifTrue: [s := s * (10 raisedToInteger: baseExpEstimate)] + ifFalse: + [scale := 10 raisedToInteger: baseExpEstimate negated. + r := r * scale. + mPlus := mPlus * scale. + mMinus := mMinus * scale]. + ((r + mPlus < s) not and: [roundingIncludesLimits or: [r + mPlus > s]]) + ifTrue: [baseExpEstimate := baseExpEstimate + 1] + ifFalse: + [r := r * 10. + mPlus := mPlus * 10. + mMinus := mMinus * 10]. + (fixedFormat := baseExpEstimate between: -3 and: 6) + ifTrue: + [decPointCount := baseExpEstimate. + baseExpEstimate <= 0 + ifTrue: [denominator := 10 raisedTo: baseExpEstimate negated]] + ifFalse: + [decPointCount := 1]. + slowbit := 1 - s lowBit . + shead := s bitShift: slowbit. + [d := (r bitShift: slowbit) // shead. + r := r - (d * s). + (tc1 := (r > mMinus) not and: [roundingIncludesLimits or: [r < mMinus]]) | + (tc2 := (r + mPlus < s) not and: [roundingIncludesLimits or: [r + mPlus > s]])] whileFalse: + [numerator := 10 * numerator + d. + denominator := 10 * denominator. + r := r * 10. + mPlus := mPlus * 10. + mMinus := mMinus * 10. + decPointCount := decPointCount - 1. + decPointCount = 0 ifTrue: [denominator := 1]]. + tc2 ifTrue: + [(tc1 not or: [r * 2 >= s]) ifTrue: [d := d + 1]]. + numerator := 10 * numerator + d. + denominator := 10 * denominator. + decPointCount > 0 + ifTrue: + [numerator := (10 raisedTo: decPointCount - 1) * numerator]. + fixedFormat ifFalse: + [(baseExpEstimate - 1) > 0 + ifTrue: [numerator := (10 raisedTo: baseExpEstimate - 1) * numerator] + ifFalse: [denominator := (10 raisedTo: 1 - baseExpEstimate) * (denominator max: 1)]]. + denominator < 2 ifTrue: [^numerator]. + ^numerator / denominator!

1 0

The Inbox: Morphic-rh.588.mcz
by commits＠source.squeak.org 03 Nov '11

03 Nov '11

radoslav hodnicak uploaded a new version of Morphic to project The Inbox: http://source.squeak.org/inbox/Morphic-rh.588.mcz ==================== Summary ==================== Name: Morphic-rh.588 Author: rh Time: 3 November 2011, 7:01:45.493 pm UUID: 3e2f3cae-c241-4206-aa83-98bb145399c3 Ancestors: Morphic-ul.587 Disable menu dragging unless the mouse is over the menu's title bar. I can't count the number of times I've unintentionally dragged a menu around after opening it instead of clicking a menu item. =============== Diff against Morphic-ul.587 =============== Item was changed: ----- Method: MenuMorph>>mouseDown: (in category 'events') ----- mouseDown: evt + + | titleMorph | "Handle a mouse down event." (stayUp or:[self fullContainsPoint: evt position]) ifFalse:[^self deleteIfPopUp: evt]. "click outside" self isSticky ifTrue: [^self]. + "Grab the menu and drag it to some other place only if the mouse is grabbing the title bar" + self valueOfProperty: #hasTitlebarWidgets ifAbsent: [^self]. + titleMorph := submorphs + detect: [:ea | ea hasProperty: #titleString] + ifNone: [^self]. + (titleMorph fullContainsPoint: evt position) ifTrue: [evt hand grabMorph: self]! - "Grab the menu and drag it to some other place" - evt hand grabMorph: self.!

1 0

[ANN] Squeak Beginner Screencasts
by Chris Cunnington 03 Nov '11

03 Nov '11

I've added a link to squeak.org: http://squeak.org/Documentation/ Chris

1 0

The Inbox: System-laza.459.mcz
by commits＠source.squeak.org 03 Nov '11

03 Nov '11

Alexander Lazarević uploaded a new version of System to project The Inbox: http://source.squeak.org/inbox/System-laza.459.mcz ==================== Summary ==================== Name: System-laza.459 Author: laza Time: 3 November 2011, 8:13:48.899 am UUID: 7bf95c73-93c1-d044-b91e-75e6e1456825 Ancestors: System-laza.458 Make SystemOrganizer trigger a notification on adding a category =============== Diff against System-laza.458 =============== Item was removed: - ----- Method: SystemOrganizer>>addCategory: (in category 'accessing') ----- - addCategory: newCategory - | r | - r := super addCategory: newCategory. - SystemChangeNotifier uniqueInstance classCategoryAdded: newCategory. - ^ r! Item was added: + ----- Method: SystemOrganizer>>addCategory:before: (in category 'accessing') ----- + addCategory: catString before: nextCategory + SystemChangeNotifier uniqueInstance doSilently: [ + super addCategory: catString before: nextCategory]. + SystemChangeNotifier uniqueInstance classCategoryAdded: catString. + !

1 0

Jump to page: