Squeak-dev July 2011

squeak-dev@lists.squeakfoundation.org

61 participants
145 discussions

The Trunk: Multilingual-ul.154.mcz
by commits＠source.squeak.org 18 Jul '11

18 Jul '11

Levente Uzonyi uploaded a new version of Multilingual to project The Trunk: http://source.squeak.org/trunk/Multilingual-ul.154.mcz ==================== Summary ==================== Name: Multilingual-ul.154 Author: ul Time: 18 July 2011, 2:01:58.376 am UUID: fb785182-e083-924c-b3cf-39e47859cede Ancestors: Multilingual-ul.153 SystemNavigation >> #allSelect: was moved to the System package. =============== Diff against Multilingual-ul.153 =============== Item was removed: - ----- Method: SystemNavigation>>allSelect: (in category '*Multilingual-Editor') ----- - allSelect: aBlock - "Answer a SortedCollection of each method that, when used as - the block - argument to aBlock, gives a true result." - | aCollection | - aCollection := SortedCollection new. - Cursor execute - showWhile: [self - allBehaviorsDo: [:class | class - selectorsAndMethodsDo: [:sel :m | (aBlock value: m) - ifTrue: [aCollection add: class name , ' ' , sel]]]]. - ^ aCollection!

1 0

The Trunk: Multilingual-ul.153.mcz
by commits＠source.squeak.org 18 Jul '11

18 Jul '11

Levente Uzonyi uploaded a new version of Multilingual to project The Trunk: http://source.squeak.org/trunk/Multilingual-ul.153.mcz ==================== Summary ==================== Name: Multilingual-ul.153 Author: ul Time: 17 July 2011, 7:42:44.653 pm UUID: e3f7831d-792b-6241-8fe2-1f4b375edc10 Ancestors: Multilingual-ul.152 Use #allSelectorsAndMethodsDo: instead of #allSelect:. Avoid duplication of #numberOfTimesStringIsUsed:. Don't flush the Transcript so eagerly. =============== Diff against Multilingual-ul.152 =============== Item was changed: ----- Method: LanguageEditor>>identifyUnusedStrings (in category 'stef') ----- identifyUnusedStrings + "(self on: 'en') identifyUnusedStrings" + + translationsList getList do: [ :each | + Transcript + nextPutAll: each; + show: (self numberOfTimesStringIsUsed: each); + cr ]! - "self new identifyUnusedStrings" - translationsList getList - do: [:each | - Transcript show: each. - Transcript show: (Smalltalk - allSelect: [:method | method - hasLiteralSuchThat: [:lit | lit isString - and: [lit includesSubstring: each caseSensitive: true]]]) size printString; cr]! Item was changed: ----- Method: LanguageEditor>>numberOfTimesStringIsUsed: (in category 'stef') ----- numberOfTimesStringIsUsed: aString + | count | + count := 0. + self systemNavigation allSelectorsAndMethodsDo: [ :behavior :selector :method | + (method hasLiteralSuchThat: [:lit | + lit isString and: [lit includesSubstring: aString caseSensitive: true] ]) ifTrue: [ + count := count + 1 ] ]. + ^count! - ^ (self systemNavigation allSelect: [:method | method - hasLiteralSuchThat: [:lit | lit isString - and: [lit includesSubstring: aString caseSensitive: true]]]) size! Item was changed: ----- Method: LanguageEditor>>removeTranslatedButUnusedStrings (in category 'stef') ----- removeTranslatedButUnusedStrings + (self confirm: 'Are you sure that you want to remove unused strings?' translated) ifFalse: [^ self]. translationsList getList do: [:each | | timesUsed | timesUsed := self numberOfTimesStringIsUsed: each. + Transcript + nextPutAll: each; + show: timesUsed; + cr. - Transcript show: each. - Transcript show: timesUsed printString; - cr. timesUsed isZero ifTrue: [self translator removeTranslationFor: each]]! Item was changed: ----- Method: LanguageEditor>>removeUntranslatedButUnusedStrings (in category 'stef') ----- removeUntranslatedButUnusedStrings + (self confirm: 'Are you sure that you want to remove unused strings?' translated) ifFalse: [^ self]. untranslatedList getList do: [:each | | timesUsed | timesUsed := self numberOfTimesStringIsUsed: each. + Transcript + nextPutAll: each; + show: timesUsed; - Transcript show: each. - Transcript show: timesUsed printString; cr. timesUsed isZero ifTrue: [self translator removeUntranslated: each]]. self update: #untranslated. !

1 0

The Trunk: Kernel-ul.607.mcz
by commits＠source.squeak.org 18 Jul '11

18 Jul '11

Levente Uzonyi uploaded a new version of Kernel to project The Trunk: http://source.squeak.org/trunk/Kernel-ul.607.mcz ==================== Summary ==================== Name: Kernel-ul.607 Author: ul Time: 18 July 2011, 5:30:16.971 pm UUID: 364aaf4f-24eb-4648-9612-2ba439cc26cd Ancestors: Kernel-ul.606 - Behavior >> #allLocalCallsOn: was moved to the System package. - use LowBitPerByteTable from #lowBit implementations - enhanced Integer >> #lowBit =============== Diff against Kernel-ul.606 =============== Item was removed: - ----- Method: Behavior>>allLocalCallsOn: (in category 'user interface') ----- - allLocalCallsOn: aSymbol - "Answer a SortedCollection of all the methods that call on aSymbol, anywhere in my class hierarchy." - - | aSet special byte cls | - aSet := Set new. - cls := self theNonMetaClass. - special := Smalltalk hasSpecialSelector: aSymbol - ifTrueSetByte: [:b | byte := b ]. - cls withAllSuperAndSubclassesDoGently: [ :class | - (class whichSelectorsReferTo: aSymbol special: special byte: byte) - do: [:sel | - sel isDoIt ifFalse: [aSet add: class name , ' ', sel]]]. - cls class withAllSuperAndSubclassesDoGently: [ :class | - (class whichSelectorsReferTo: aSymbol special: special byte: byte) - do: [:sel | - sel isDoIt ifFalse: [aSet add: class name , ' ', sel]]]. - ^aSet! Item was changed: ----- Method: Integer>>lowBit (in category 'bit manipulation') ----- lowBit "Answer the index of the low order bit of this number." + + | index digit | + index := 0. + [ (digit := self digitAt: (index := index + 1)) = 0 ] whileTrue. + ^(LowBitPerByteTable at: digit) + (index - 1 * 8)! - | index | - self = 0 ifTrue: [ ^ 0 ]. - index := 1. - [ (self digitAt: index) = 0 ] - whileTrue: - [ index := index + 1 ]. - ^ (self digitAt: index) lowBit + (8 * (index - 1))! Item was changed: ----- Method: SmallInteger>>lowBit (in category 'bit manipulation') ----- lowBit " Answer the index of the low order one bit. 2r00101000 lowBit (Answers: 4) 2r-00101000 lowBit (Answers: 4) First we skip bits in groups of 8, then do a lookup in a table. While not optimal, this is a good tradeoff; long integer #lowBit always invokes us with bytes." + | n result lastByte | n := self. n = 0 ifTrue: [ ^ 0 ]. result := 0. [(lastByte := n bitAnd: 16rFF) = 0] whileTrue: [ result := result + 8. n := n bitShift: -8 ]. + ^result + (LowBitPerByteTable at: lastByte)! - - "The low bits table can be obtained with: - ((1 to: 8) inject: #[1] into: [:lowBits :rank | (lowBits copy at: 1 put: lowBits first + 1; yourself) , lowBits]) allButFirst." - ^result + ( #[1 2 1 3 1 2 1 4 1 2 1 3 1 2 1 5 1 2 1 3 1 2 1 4 1 2 1 3 1 2 1 6 1 2 1 3 1 2 1 4 1 2 1 3 1 2 1 5 1 2 1 3 1 2 1 4 1 2 1 3 1 2 1 7 1 2 1 3 1 2 1 4 1 2 1 3 1 2 1 5 1 2 1 3 1 2 1 4 1 2 1 3 1 2 1 6 1 2 1 3 1 2 1 4 1 2 1 3 1 2 1 5 1 2 1 3 1 2 1 4 1 2 1 3 1 2 1 8 1 2 1 3 1 2 1 4 1 2 1 3 1 2 1 5 1 2 1 3 1 2 1 4 1 2 1 3 1 2 1 6 1 2 1 3 1 2 1 4 1 2 1 3 1 2 1 5 1 2 1 3 1 2 1 4 1 2 1 3 1 2 1 7 1 2 1 3 1 2 1 4 1 2 1 3 1 2 1 5 1 2 1 3 1 2 1 4 1 2 1 3 1 2 1 6 1 2 1 3 1 2 1 4 1 2 1 3 1 2 1 5 1 2 1 3 1 2 1 4 1 2 1 3 1 2 1] at: lastByte)!

1 0

The Trunk: Collections-ul.445.mcz
by commits＠source.squeak.org 18 Jul '11

18 Jul '11

Levente Uzonyi uploaded a new version of Collections to project The Trunk: http://source.squeak.org/trunk/Collections-ul.445.mcz ==================== Summary ==================== Name: Collections-ul.445 Author: ul Time: 17 July 2011, 7:43:32.336 pm UUID: 5bd8b975-3f30-9943-a793-48eeb8593e0e Ancestors: Collections-ul.444 Use #allSelectorsAndMethodsDo: instead of #allSelect:. =============== Diff against Collections-ul.444 =============== Item was changed: ----- Method: Dictionary>>unreferencedKeys (in category 'removing') ----- unreferencedKeys "| uk | (Time millisecondsToRun: [uk := TextConstants unreferencedKeys]) -> uk" ^'Scanning for references . . .' displayProgressFrom: 0 to: Smalltalk classNames size * 2 + during: [ :bar | + | currentClass n associations referencedAssociations | - during: - [:bar | | currentClass n associations referencedAssociations | currentClass := nil. n := 0. associations := self associations asIdentitySet. referencedAssociations := IdentitySet new: associations size. + self systemNavigation allSelectorsAndMethodsDo: [ :behavior :selector :method | + behavior == currentClass ifFalse: [ + currentClass := behavior. + bar value: (n := n + 1) ]. + method literalsDo: [ :literal | + (literal isVariableBinding and: [ associations includes: literal ]) ifTrue: [ + referencedAssociations add: literal ] ] ]. + (associations reject: [ :assoc | referencedAssociations includes: assoc ]) collect: [ :assoc| assoc key ] ]! - self systemNavigation allSelect: - [:m| - m methodClass ~~ currentClass ifTrue: - [currentClass := m methodClass. - bar value: (n := n + 1)]. - m literalsDo: - [:l| - (l isVariableBinding and: [associations includes: l]) ifTrue: - [referencedAssociations add: l]]. - false]. - ((associations reject: [:assoc | referencedAssociations includes: assoc]) collect: [:assoc| assoc key]) asSet]!

1 0

The Trunk: Kernel-ul.606.mcz
by commits＠source.squeak.org 18 Jul '11

18 Jul '11

Levente Uzonyi uploaded a new version of Kernel to project The Trunk: http://source.squeak.org/trunk/Kernel-ul.606.mcz ==================== Summary ==================== Name: Kernel-ul.606 Author: ul Time: 18 July 2011, 5:26:44.832 pm UUID: 765d93ce-2226-a942-abee-bd2f45d192f6 Ancestors: Kernel-nice.605 Copy the lowBit per byte table from SmallInteger >> #lowBit to a class variable in Integer, so it can also be used from other methods without duplication. =============== Diff against Kernel-nice.605 =============== Item was changed: Number subclass: #Integer instanceVariableNames: '' + classVariableNames: 'LowBitPerByteTable' - classVariableNames: '' poolDictionaries: '' category: 'Kernel-Numbers'! !Integer commentStamp: '<historical>' prior: 0! I am a common abstract superclass for all Integer implementations. My implementation subclasses are SmallInteger, LargePositiveInteger, and LargeNegativeInteger. Integer division consists of: / exact division, answers a fraction if result is not a whole integer // answers an Integer, rounded towards negative infinity \\ is modulo rounded towards negative infinity quo: truncated division, rounded towards zero! Item was changed: ----- Method: Integer class>>initialize (in category 'class initialization') ----- initialize "Integer initialize" "Ensure we have the right compact class index" "LPI has been a compact class forever - just ensure basic correctness" (LargePositiveInteger indexIfCompact = 5) ifFalse:[ (Smalltalk compactClassesArray at: 5) ifNil:[LargePositiveInteger becomeCompactSimplyAt: 5] ifNotNil:[self error: 'Unexpected compact class setup']]. "Cog requires LNI to be compact at 4 (replacing PseudoContext)" (LargeNegativeInteger indexIfCompact = 4) ifFalse:[ "PseudoContext will likely get removed at some point so write this test without introducing a hard dependency" (Smalltalk compactClassesArray at: 4) name == #PseudoContext ifTrue:[Smalltalk compactClassesArray at: 4 put: nil]. (Smalltalk compactClassesArray at: 4) ifNil:[LargeNegativeInteger becomeCompactSimplyAt: 4] ifNotNil:[self error: 'Unexpected compact class setup']]. + + self initializeLowBitPerByteTable ! Item was added: + ----- Method: Integer class>>initializeLowBitPerByteTable (in category 'class initialization') ----- + initializeLowBitPerByteTable + "Initialize LowBitPerByteTable which is a ByteArray that contains the index of the lowest set bit of the integers between 1 and 255. It's defined as a class variable because it's used from the instance side and subclasses." + "The low bits table can be obtained with: + ((1 to: 8) inject: #[1] into: [:lowBits :rank | (lowBits copy at: 1 put: lowBits first + 1; yourself) , lowBits]) allButFirst + or with it's symmetric pair: + ((1 to: 8) inject: #[1] into: [:lowBits :rank | lowBits, (lowBits copy atLast: 1 put: lowBits last + 1; yourself)]) allButLast." + + LowBitPerByteTable := #[1 2 1 3 1 2 1 4 1 2 1 3 1 2 1 5 1 2 1 3 1 2 1 4 1 2 1 3 1 2 1 6 1 2 1 3 1 2 1 4 1 2 1 3 1 2 1 5 1 2 1 3 1 2 1 4 1 2 1 3 1 2 1 7 1 2 1 3 1 2 1 4 1 2 1 3 1 2 1 5 1 2 1 3 1 2 1 4 1 2 1 3 1 2 1 6 1 2 1 3 1 2 1 4 1 2 1 3 1 2 1 5 1 2 1 3 1 2 1 4 1 2 1 3 1 2 1 8 1 2 1 3 1 2 1 4 1 2 1 3 1 2 1 5 1 2 1 3 1 2 1 4 1 2 1 3 1 2 1 6 1 2 1 3 1 2 1 4 1 2 1 3 1 2 1 5 1 2 1 3 1 2 1 4 1 2 1 3 1 2 1 7 1 2 1 3 1 2 1 4 1 2 1 3 1 2 1 5 1 2 1 3 1 2 1 4 1 2 1 3 1 2 1 6 1 2 1 3 1 2 1 4 1 2 1 3 1 2 1 5 1 2 1 3 1 2 1 4 1 2 1 3 1 2 1]!

1 0

The Trunk: System-ul.449.mcz
by commits＠source.squeak.org 18 Jul '11

18 Jul '11

Levente Uzonyi uploaded a new version of System to project The Trunk: http://source.squeak.org/trunk/System-ul.449.mcz ==================== Summary ==================== Name: System-ul.449 Author: ul Time: 18 July 2011, 2:01:28.809 am UUID: baaab250-ffd3-814b-9e6f-7ef5ab04f991 Ancestors: System-ul.448 SystemNavigation refactoring part 2. =============== Diff against System-ul.448 =============== Item was changed: + ----- Method: Behavior>>allCallsOn (in category '*System-Support') ----- - ----- Method: Behavior>>allCallsOn (in category '*system-support') ----- allCallsOn "Answer a SortedCollection of all the methods that refer to me by name or as part of an association in a global dict." + ^self systemNavigation allCallsOn: self theNonMetaClass name! - ^self systemNavigation allCallsOn: self theNonMetaClass name! Item was changed: + ----- Method: Behavior>>allCallsOn: (in category '*System-Support') ----- - ----- Method: Behavior>>allCallsOn: (in category '*system-support') ----- allCallsOn: aSymbol + "Answer a sorted collection of all the methods that call on aSymbol." - "Answer a SortedCollection of all the methods that call on aSymbol." + ^self systemNavigation allCallsOn: aSymbol from: self. - - ^ self systemNavigation allCallsOn: aSymbol from: self . ! Item was added: + ----- Method: Behavior>>allLocalCallsOn: (in category '*System-Support') ----- + allLocalCallsOn: aSymbol + "Answer a sorted collection of all the methods that call on aSymbol, anywhere in my class hierarchy." + + ^self systemNavigation allCallsOn: aSymbol from: self theNonMetaClass! Item was changed: + ----- Method: Behavior>>allUnsentMessages (in category '*System-Support') ----- - ----- Method: Behavior>>allUnsentMessages (in category '*system-support') ----- allUnsentMessages "Answer an array of all the messages defined by the receiver that are not sent anywhere in the system." + ^self systemNavigation allUnSentMessagesIn: self selectors! - ^ SystemNavigation default allUnSentMessagesIn: self selectors! Item was changed: ----- Method: SystemNavigation>>allImplementedMessages (in category 'query') ----- allImplementedMessages + "Answer a set of all the messages that are implemented in the system." + + ^self allImplementedMessagesWithout: #(() ())! - "Answer a Set of all the messages that are implemented in the system." - ^ self allImplementedMessagesWithout: {{}. {}}! Item was changed: ----- Method: SystemNavigation>>allImplementedMessagesWithout: (in category 'query') ----- + allImplementedMessagesWithout: behaviorsAndSelectorsPair + "Answer a set of all the selectors that are implemented in the system, computed in the absence of the supplied behaviors and selectors." + + | selectors behaviorsToReject | + selectors := IdentitySet new. + behaviorsToReject := behaviorsAndSelectorsPair first asIdentitySet. + Smalltalk allClassesAndTraitsDo: [ :behavior | + (behaviorsToReject includes: behavior name) ifFalse: [ + selectors + addAll: behavior selectors; + addAll: behavior classSide selectors ] ]. + behaviorsAndSelectorsPair second do: [ :each | + selectors remove: each ]. + ^selectors! - allImplementedMessagesWithout: classesAndMessagesPair - "Answer a Set of all the messages that are implemented in the system, - computed in the absence of the supplied classes and messages. Note this - reports messages that are in the absent selectors set." - | messages absentClasses | - messages := IdentitySet new: CompiledMethod instanceCount. - absentClasses := classesAndMessagesPair first. - self flag: #shouldBeRewrittenUsingSmalltalkAllClassesDo:. "sd 29/04/03" - Cursor execute showWhile: [ - Smalltalk classNames , Smalltalk traitNames - do: [:name | ((absentClasses includes: name) - ifTrue: [{}] - ifFalse: [{Smalltalk at: name. (Smalltalk at: name) classSide}]) - do: [:each | messages addAll: each selectors]]]. - ^ messages! Item was changed: ----- Method: SystemNavigation>>allImplementorsOf: (in category 'query') ----- allImplementorsOf: aSelector + "Answer a sorted collection of all the methods which are named aSelector." + + | result | + result := OrderedCollection new. + self allBehaviorsDo: [ :class | + (class includesSelector: aSelector) ifTrue: [ + result add: (MethodReference class: class selector: aSelector) ] ]. + ^result sort! - "Answer a SortedCollection of all the methods that implement the message - aSelector." - | aCollection | - aCollection := SortedCollection new. - Cursor wait - showWhile: [self - allBehaviorsDo: [:class | (class includesSelector: aSelector) - ifTrue: [aCollection - add: (MethodReference new setStandardClass: class methodSymbol: aSelector)]]]. - ^ aCollection! Item was changed: ----- Method: SystemNavigation>>allImplementorsOf:localTo: (in category 'query') ----- allImplementorsOf: aSelector localTo: aClass + "Answer a sorted collection of all the methods that are named aSelector in, above, or below the given class." + + | result | + result := OrderedCollection new. + { aClass theNonMetaClass. aClass theMetaClass } do: [ :baseClass | + baseClass withAllSuperAndSubclassesDoGently: [ :class | + (class includesSelector: aSelector) ifTrue: [ + result add: (MethodReference class: class selector: aSelector) ] ] ]. + ^result sort! - "Answer a SortedCollection of all the methods that implement the message - aSelector in, above, or below the given class." - | cls aCollection | - aCollection := SortedCollection new. - cls := aClass theNonMetaClass. - Cursor wait - showWhile: [cls - withAllSuperAndSubclassesDoGently: [:class | (class includesSelector: aSelector) - ifTrue: [aCollection - add: (MethodReference new setStandardClass: class methodSymbol: aSelector)]]. - cls class - withAllSuperAndSubclassesDoGently: [:class | (class includesSelector: aSelector) - ifTrue: [aCollection - add: (MethodReference new setStandardClass: class methodSymbol: aSelector)]]]. - ^ aCollection! Item was changed: ----- Method: SystemNavigation>>allImplementorsOf:localToPackage: (in category 'query') ----- allImplementorsOf: aSelector localToPackage: packageNameOrInfo + "Answer a sorted collection of all the methods named aSelector in the given package." - "Answer a SortedCollection of all the methods that implement the message - aSelector in the given package." + | result | + result := OrderedCollection new. + (self packageInfoFor: packageNameOrInfo) actualMethodsDo: [ :method | + method selector = aSelector ifTrue: [ + result add: method methodReference ] ]. + ^result sort! - | aSet | - aSet := Set new. - Cursor wait showWhile: - [(self packageInfoFor: packageNameOrInfo) actualMethodsDo: - [:m | - (m selector = aSelector) ifTrue: - [aSet add: m methodReference]]]. - ^aSet! Item was changed: ----- Method: SystemNavigation>>allMethodsNoDoitsSelect: (in category 'query') ----- allMethodsNoDoitsSelect: aBlock "Like allSelect:, but strip out Doits" + + self deprecated: 'Doits are not present in MethodDictionaries anymore. Use #allMethodsSelect:'. + ^self allMethodsSelect: aBlock! - | aCollection | - aCollection := SortedCollection new. - Cursor execute - showWhile: [self - allBehaviorsDo: [:class | class - selectorsAndMethodsDo: [:sel :m | (sel isDoIt not - and: [aBlock value: m]) - ifTrue: [aCollection - add: (MethodReference new setStandardClass: class methodSymbol: sel)]]]]. - ^ aCollection! Item was changed: ----- Method: SystemNavigation>>allMethodsSelect: (in category 'query') ----- allMethodsSelect: aBlock + "Answer a sorted collection of each method that, when used as the block - "Answer a SortedCollection of each method that, when used as the block argument to aBlock, gives a true result." + + | result | + result := OrderedCollection new. + self allSelectorsAndMethodsDo: [ :behavior :selector :method | + (aBlock value: method) ifTrue: [ + result add: (MethodReference class: behavior selector: selector) ] ]. + ^result sort! - | aCollection | - aCollection := OrderedCollection new. - Cursor execute - showWhile: [self - allBehaviorsDo: [:class | class - selectorsAndMethodsDo: [:sel :m | (aBlock value: m) - ifTrue: [aCollection - add: (MethodReference new setStandardClass: class methodSymbol: sel)]]]]. - ^ aCollection sort! Item was changed: ----- Method: SystemNavigation>>allMethodsSelect:localToPackage: (in category 'query') ----- allMethodsSelect: aBlock localToPackage: packageNameOrInfo + "Answer a sorted collection of each method in the given package for which the evaluation of aBlock with the method answers true." - "Answer a SortedCollection of each method in the given package - for which the evaluation of aBlock with the metnod answers true." + | result | + result := OrderedCollection new. + (self packageInfoFor: packageNameOrInfo) actualMethodsDo: [ :aMethod | + (aBlock value: aMethod) ifTrue: [ + result add: aMethod methodReference ] ]. + ^result sort! - | aSet | - aSet := Set new. - Cursor wait showWhile: - [(self packageInfoFor: packageNameOrInfo) actualMethodsDo: - [:aMethod | - (aBlock value: aMethod) ifTrue: - [aSet add: aMethod methodReference]]]. - ^aSet! Item was changed: ----- Method: SystemNavigation>>allMethodsWithSourceString:matchCase: (in category 'query') ----- allMethodsWithSourceString: aString matchCase: caseSensitive + "Answer a sorted collection of all the methods that contain, in source code, aString as a substring. Search the class comments also" - "Answer a SortedCollection of all the methods that contain, in source code, aString as a substring. Search the class comments also" + | result | + result := OrderedCollection new. + CurrentReadOnlySourceFiles cacheDuring: [ + 'Searching all source code...' + displayProgressFrom: 0 to: Smalltalk classNames size + during: [ :bar | + | count previousBehavior | + count := 0. + previousBehavior := nil. + self allSelectorsAndMethodsDo: [ :behavior :selector :method | + behavior == previousBehavior ifFalse: [ + bar value: (count := count + 1). + previousBehavior := behavior. + (behavior organization classComment asString + includesSubstring: aString + caseSensitive: caseSensitive) ifTrue: [ + result add: (MethodReference class: behavior selector: #Comment) ] ]. + (method getSource asString + includesSubstring: aString + caseSensitive: caseSensitive) ifTrue: [ + result add: (MethodReference class: behavior selector: selector) ] ] ] ]. + ^result sort! - | list adder | - list := Set new. - adder := [ :mrClass :mrSel | list add: ( MethodReference new - setStandardClass: mrClass - methodSymbol: mrSel)]. - 'Searching all source code...' - displayProgressFrom: 0 to: Smalltalk classNames size - during: [:bar | | count | - count := 0. - SystemNavigation default allBehaviorsDo: [:each | - bar value: (count := count + 1). - each selectorsDo: [:sel | - ((each sourceCodeAt: sel) findString: aString - startingAt: 1 caseSensitive: caseSensitive) > 0 ifTrue: [ - sel isDoIt ifFalse: [adder value: each value: sel]]]. - (each organization classComment asString findString: aString - startingAt: 1 caseSensitive: caseSensitive) > 0 ifTrue: [ - adder value: each value: #Comment] ]]. - ^ list asSortedCollection! Item was changed: ----- Method: SystemNavigation>>allPrimitiveMethods (in category 'query') ----- allPrimitiveMethods + "Answer a collection of all the methods that are implemented by primitives." + + | result | + result := OrderedCollection new. + self allSelectorsAndMethodsDo: [ :behavior :selector :method | + method primitive ~= 0 ifTrue: [ + result add: (String streamContents: [ :stream | + stream + nextPutAll: behavior name; + space; + nextPutAll: selector; + space; + print: method primitive ]) ] ]. + ^result! - "Answer an OrderedCollection of all the methods that are implemented by primitives." - | aColl | - aColl := OrderedCollection new: 200. - Cursor execute - showWhile: [self allBehaviorsDo: [:class | class - selectorsAndMethodsDo: [:sel :method | - method primitive ~= 0 - ifTrue: [aColl addLast: class name , ' ' , sel , ' ' , method primitive printString]]]]. - ^ aColl! Item was changed: ----- Method: SystemNavigation>>allPrimitiveMethodsInCategories: (in category 'query') ----- allPrimitiveMethodsInCategories: aList "Answer an OrderedCollection of all the methods that are implemented by primitives in the given categories. 1/26/96 sw" "SystemNavigation new allPrimitiveMethodsInCategories: #('Collections-Streams' 'Files-Streams' 'Files-Abstract' 'Files-Macintosh')" + | result categories | + result := OrderedCollection new. + categories := aList collect: [ :each | each asSymbol ]. + categories size > 10 ifTrue: [ categories := categories asIdentitySet ]. + self allBehaviorsDo: [ :behavior | + (aList includes: behavior category) ifTrue: [ + behavior selectorsAndMethodsDo: [ :selector :method | + method primitive ~= 0 ifTrue: [ + result add: (String streamContents: [ :stream | + stream + nextPutAll: behavior name; + space; + nextPutAll: selector; + space; + print: method primitive ]) ] ] ] ]. + ^result! - | aColl | - aColl := OrderedCollection new: 200. - Cursor execute - showWhile: [self - allBehaviorsDo: [:aClass | (aList includes: (SystemOrganization categoryOfElement: aClass theNonMetaClass name asString) asString) - ifTrue: [aClass - selectorsAndMethodsDo: [:sel :method | - method primitive ~= 0 - ifTrue: [aColl addLast: aClass name , ' ' , sel , ' ' , method primitive printString]]]]]. - ^ aColl! Item was added: + ----- Method: SystemNavigation>>allSelect: (in category 'query') ----- + allSelect: aBlock + "Answer a sorted collection of each method that, when used as the block argument to aBlock, gives a true result." + + | result | + result := OrderedCollection new. + self allSelectorsAndMethodsDo: [ :behavior :selector :method | + (aBlock value: method) ifTrue: [ + result add: behavior name , ' ' , selector ] ]. + ^result sort! Item was added: + ----- Method: SystemNavigation>>allSelectorsAndMethodsDo: (in category 'query') ----- + allSelectorsAndMethodsDo: aBlock + "Evaluate aBlock for all selectors and methods of all behaviors in this image." + + self allBehaviorsDo: [ :behavior | + behavior selectorsAndMethodsDo: [ :selector :method | + aBlock value: behavior value: selector value: method ] ]! Item was added: + ----- Method: SystemNavigation>>allUncommentedMethodsWithInitials: (in category 'query') ----- + allUncommentedMethodsWithInitials: targetInitials + "Return a sorted collection with all uncommented methods whose initials (in the + time-stamp, as logged to disk) match the given initials, in chronological order." + + ^CurrentReadOnlySourceFiles cacheDuring: [ + | result | + result := OrderedCollection new. + self allSelectorsAndMethodsDo: [ :behavior :selector :method | + method timeStamp ifNotEmptyDo: [ :timeStamp | + | initials | + initials := timeStamp substrings first. + initials first isDigit ifFalse: [ + (initials = targetInitials and: [ + (behavior firstPrecodeCommentFor: selector) isNil ]) ifTrue: [ + result add: (MethodReference + class: behavior + selector: selector ) ] ] ] ]. + result ]! Item was changed: ----- Method: SystemNavigation>>allUnimplementedCalls (in category 'query') ----- allUnimplementedCalls + "Answer a collection of each message that is sent by an expression in a method but is not implemented by any object in the system." + + | result implementedMessages | + implementedMessages := self allImplementedMessages. + result := OrderedCollection new. + self allSelectorsAndMethodsDo: [ :behavior :selector :method | + method messagesDo: [ :each | + (implementedMessages includes: each) ifFalse: [ + result add: (String streamContents: [ :stream | + stream + nextPutAll: behavior name; + space; + nextPutAll: selector; + space; + nextPutAll: 'calls: '; + nextPutAll: each ]) ] ] ]. + ^result! - "Answer an Array of each message that is sent by an expression in a - method but is not implemented by any object in the system." - | aStream all | - all := self allImplementedMessages. - aStream := WriteStream - on: (Array new: 50). - Cursor execute - showWhile: [self - allBehaviorsDo: [:cl | cl - selectorsAndMethodsDo: [:sel :method | - | secondStream | - secondStream := WriteStream - on: (String new: 5). - method messages - do: [:m | (all includes: m) - ifFalse: [secondStream nextPutAll: m; - space]]. - secondStream position = 0 - ifFalse: [aStream nextPut: cl name , ' ' , sel , ' calls: ' , secondStream contents]]]]. - ^ aStream contents! Item was changed: ----- Method: SystemNavigation>>allUnimplementedNonPrimitiveCalls (in category 'query') ----- allUnimplementedNonPrimitiveCalls + "Answer an collection of each message that is sent by an expression in a method but is not implemented by any object in the system. This list won't include primitive methods." + + | result implementedMessages | + implementedMessages := self allImplementedMessages. + result := OrderedCollection new. + self allSelectorsAndMethodsDo: [ :behavior :selector :method | + method primitive = 0 ifTrue: [ + method messagesDo: [ :each | + (implementedMessages includes: each) ifFalse: [ + result add: (String streamContents: [ :stream | + stream + nextPutAll: behavior name; + space; + nextPutAll: selector; + space; + nextPutAll: 'calls: '; + nextPutAll: each ]) ] ] ] ]. + ^result! - "Answer an Array of each message that is sent by an expression in a - method but is not implemented by any object in the system." - | aStream all | - all := self systemNavigation allImplementedMessages. - aStream := WriteStream - on: (Array new: 50). - Cursor execute - showWhile: [self systemNavigation - allBehaviorsDo: [:cl | cl - selectorsAndMethodsDo: [:sel :meth | - | secondStream | - secondStream := WriteStream - on: (String new: 5). - meth primitive = 0 ifTrue: [ - meth messages - do: [:m | (all includes: m) - ifFalse: [secondStream nextPutAll: m; - space]]. - secondStream position = 0 - ifFalse: [aStream nextPut: cl name , ' ' , sel , ' calls: ' , secondStream contents]]]]]. - ^ aStream contents! Item was changed: ----- Method: SystemNavigation>>browseAllImplementorsOfList:title: (in category 'browse') ----- browseAllImplementorsOfList: selectorList title: aTitle + "Create and schedule a message browser on each method that implements the message whose selector is in the argument selectorList." + "For example, self new browseAllImplementorsOf: #(at:put: size). " + + | implementorLists | + implementorLists := selectorList gather: [:each | + self allImplementorsOf: each ]. + implementorLists sort. + ^self browseMessageList: implementorLists name: aTitle! - "Create and schedule a message browser on each method that implements - the message whose selector is in the argument selectorList. For - example, - self new browseAllImplementorsOf: #(at:put: size). - 1/16/96 sw: this variant adds the title argument. - 1/24/96 sw: use a SortedCollection - 2/1/96 sw: show normal cursor" - | implementorLists flattenedList | - implementorLists := selectorList - collect: [:each | self allImplementorsOf: each]. - flattenedList := SortedCollection new. - implementorLists - do: [:each | flattenedList addAll: each]. - Cursor normal show. - ^ self browseMessageList: flattenedList name: aTitle! Item was changed: ----- Method: SystemNavigation>>browseAllSelect:name:autoSelect: (in category 'browse') ----- browseAllSelect: aBlock name: aName autoSelect: autoSelectString "Create and schedule a message browser on each method that, when used as the block argument to aBlock gives a true result. Do not return an #DoIt traces." "self new browseAllSelect: [:method | method numLiterals > 10] name: 'Methods with more than 10 literals' autoSelect: 'isDigit'" ^ self + browseMessageList: [ self allMethodsSelect: aBlock ] - browseMessageList: (self allMethodsNoDoitsSelect: aBlock) name: aName autoSelect: autoSelectString! Item was changed: ----- Method: SystemNavigation>>browseMethodsWhoseNamesContain: (in category 'browse') ----- browseMethodsWhoseNamesContain: aString "Launch a tool which shows all methods whose names contain the given string; case-insensitive. · 1/16/1996 sw, at the dawn of Squeak: this was the classic implementation that provided the underpinning for the 'method names containing it' (cmd-shift-W) feature that has always been in Squeak -- the feature that later inspired the MethodFinder (aka SelectorBrowser). · sw 7/27/2001: Switched to showing a MessageNames tool rather than a message-list browser, if in Morphic." | aList | Smalltalk isMorphic ifFalse: [aList := Symbol selectorsContaining: aString. aList size > 0 ifTrue: + [self browseAllImplementorsOfList: aList title: 'Methods whose names contain ''', aString, '''']] - [self browseAllImplementorsOfList: aList asSortedCollection title: 'Methods whose names contain ''', aString, '''']] ifTrue: [ToolSet browseMessageNames: aString] ! Item was changed: ----- Method: SystemNavigation>>browseUncommentedMethodsWithInitials: (in category 'browse') ----- browseUncommentedMethodsWithInitials: targetInitials + "Browse uncommented methods whose initials (in the time-stamp, as logged to disk) match the given initials. Present them in chronological order. CAUTION: It will take several seconds for this to complete." - "Browse uncommented methods whose initials (in the time-stamp, as logged to disk) match the given initials. Present them in chronological order. CAUTION: It will take several minutes for this to complete." "Time millisecondsToRun: [SystemNavigation default browseUncommentedMethodsWithInitials: 'jm']" + self + browseMessageList: [ self allUncommentedMethodsWithInitials: targetInitials ] - | methodReferences | - methodReferences := OrderedCollection new. - self allBehaviorsDo: - [:aClass | aClass selectorsAndMethodsDo: [:sel :cm | - | timeStamp initials | - timeStamp := Utilities timeStampForMethod: cm. - timeStamp isEmpty ifFalse: - [initials := timeStamp substrings first. - initials first isDigit ifFalse: - [((initials = targetInitials) and: [(aClass firstPrecodeCommentFor: sel) isNil]) - ifTrue: - [methodReferences add: (MethodReference new - setStandardClass: aClass - methodSymbol: sel)]]]]]. - - ToolSet - browseMessageSet: methodReferences name: 'Uncommented methods with initials ', targetInitials autoSelect: nil! Item was changed: ----- Method: SystemNavigation>>selectAllMethods: (in category 'query') ----- selectAllMethods: aBlock "Answer a SortedCollection of each method that, when used as the block argument to aBlock, gives a true result." + + self deprecated: 'Use #allMethodsSelect:'. + ^self allMethodsSelect: aBlock! - | aCollection | - aCollection := SortedCollection new. - Cursor execute - showWhile: [self - allBehaviorsDo: [:class | class - selectorsAndMethodsDo: [:sel :m | (aBlock value: m) - ifTrue: [aCollection - add: (MethodReference new setStandardClass: class methodSymbol: sel)]]]]. - ^ aCollection! Item was changed: ----- Method: SystemNavigation>>selectAllMethodsNoDoits: (in category 'query') ----- selectAllMethodsNoDoits: aBlock "Like allSelect:, but strip out Doits" + + self deprecated: 'Doits are not present in MethodDictionaries anymore. Use #allMethodsSelect:'. + ^self allMethodsSelect: aBlock! - | aCollection | - aCollection := SortedCollection new. - Cursor execute - showWhile: [self - allBehaviorsDo: [:class | class - selectorsAndMethodsDo: [:sel :m | (sel isDoIt not - and: [aBlock value: m]) - ifTrue: [aCollection - add: (MethodReference new setStandardClass: class methodSymbol: sel)]]]]. - ^ aCollection! Item was changed: ----- Method: SystemNavigation>>unimplemented (in category 'query') ----- unimplemented + "Answer an collection of each message that is sent by an expression in a method but is not implemented by any object in the system." - "Answer an Array of each message that is sent by an expression in a method but is not implemented by any object in the system." + | implemented unimplemented | + implemented := self allImplementedMessages. - | all unimplemented | - all := IdentitySet new: Symbol instanceCount * 2. - Cursor wait showWhile: - [self allBehaviorsDo: [:cl | cl selectorsDo: [:aSelector | all add: aSelector]]]. - unimplemented := IdentityDictionary new. + self allSelectorsAndMethodsDo: [ :behavior :selector :method | + method messagesDo: [ :each | + | entry | + (implemented includes: each) ifFalse: [ + entry := unimplemented + at: each + ifPresent: [ :oldEntry | + oldEntry copyWith: behavior name, '>', selector ] + ifAbsent: [ + { behavior name, '>', selector } ]. + unimplemented at: each put: entry ] ] ]. + ^unimplemented! - Cursor execute showWhile: [ - self allBehaviorsDo: [:cl | - cl selectorsAndMethodsDo: [:sel :meth | - meth messages do: [:m | | entry | - (all includes: m) ifFalse: [ - entry := unimplemented at: m ifAbsent: [Array new]. - entry := entry copyWith: (cl name, '>', sel). - unimplemented at: m put: entry]]]]]. - ^ unimplemented - ! Item was changed: ----- Method: SystemNavigation>>unusedBlocks (in category 'query') ----- unusedBlocks "Answer all methods that contain a block that is not used (not sent a message, returned, passed as an argument, or assigned)." "SystemNavigation new unusedBlocks" "SystemNavigation new browseMessageList: SystemNavigation new unusedBlocks name: 'unused blocks'" + + ^self allMethodsSelect: - ^self allSelect: [:m| | is | is := InstructionStream on: m. is scanFor: [:b| b = 143 and: [(m at: is thirdByte * 256 + is fourthByte + is pc + 4) = 135]]]!

1 0

Dirty packages in trunk image
by Bert Freudenberg 18 Jul '11

18 Jul '11

Hi all, I ran the snippet below in a freshly downloaded trunk image. It found a couple of differences: - Monticello is dirty because of the Mock category - FlexibleVocabularies is dirty because its empty -Info category was removed - Collections is dirty because there is an unpackaged method, WeakRegistry class>>migrateOldRegistries These discrepancies should be corrected before the release, but does anybody have an idea why this happened? MCWorkingCopy allManagers do: [:wc | wc ancestors size = 1 ifTrue: [ | parent changes | parent := wc repositoryGroup versionWithInfo: wc ancestors first. changes := wc package snapshot patchRelativeToBase: parent snapshot. wc modified: changes isEmpty not]] displayingProgress: 'Checking packages'. - Bert -

5 7

ESUG 2011 Innovation Technology Awards reminder
by Jordi Delgado 18 Jul '11

18 Jul '11

Hi, Just a reminder: ESUG 2011 Innovation Technology Awards (http://esug.org/Conferences/2011/InnovationTechnologyAwards) We are proud to announce the 8th Innovation Technology Awards. Have you written innovative Smalltalk? The developers of any Smalltalk-based software can enter by submitting a 3-5min video of their software. Entrants demo their systems in a session at the end of Monday August 22nd 2011, after which the conference attendees vote. (A vote consists in providing a sorted list of 3 preferred pieces of software.) The top 3 teams with the most innovative software will receive, respectively, 500 Euros, 300 Euros and 200 Euros. The results are announced in the Awards ceremony that is held during the social event. Applicants should provide the following information on the conference registration server. Once you have registered your personal info, an "Awards" menu allows submitting your software. You can provide this information when you first register, or login again later and update your details. Info to provide: Name of the software Licence information (free, or shareware, or a commercial) Name of the Smalltalk dialect used Names, Affiliation and Country of developers URL for a video (3-5 min) showing a screencast / demo of the software URL for downloading the software or at least a runnable demo Deadline: 30th of july Any Smalltalker can apply (students, companies, ...). The presented piece of code/software should be written in Smalltalk or directly support Smalltalk (e.g. Smalltalk VM). All Smalltalk dialects are accepted. The applicant should own the copyright/copyleft of presented code or at least be the official representative of the copyright/copyleft owner. The software should be available on-line for evaluation (time-limited evaluation version, demo version, free for non-commercial use ...). Bests, Jordi

1 1

Daily Commit Log
by commits＠source.squeak.org 17 Jul '11

17 Jul '11

Changes to Trunk (http://source.squeak.org/trunk.html) in the last 24 hours: http://lists.squeakfoundation.org/pipermail/packages/2011-July/004856.html Name: ToolsTests-ul.50 Ancestors: ToolsTests-btc.49 #shouldnt:raise:'s first argument should be a block in OrderedCollectionInspectorTest >> #testUninitialized ============================================= http://lists.squeakfoundation.org/pipermail/packages/2011-July/004857.html Name: ToolsTests-btc.49 Ancestors: ToolsTests-fbs.48 Single stepping through a debugger can observe an inconsistent state after object creation but before initiialisation. Thus 'object size' may throw an axception for trying to do arithmetic on nil. Modified OrderedCollectionInspector>>fieldList to call 'self objectSize' to handle this exception. This tests that fix. ============================================= http://lists.squeakfoundation.org/pipermail/packages/2011-July/004858.html Name: Tools-btc.368 Ancestors: Tools-btc.367 Single stepping through a debugger might observe the state of an OrderedCollection instance after creation by basicNew but before initiialisation. Thus 'object size' throws a DNU error for arithmetic on a nil value that needs to be handled. ============================================= http://lists.squeakfoundation.org/pipermail/packages/2011-July/004859.html Name: Tools-btc.367 Ancestors: Tools-bf.366 Single stepping through debugger can observe an anOrderedCollection object in an inconsistent state after creation but before initialisation. This threw an error when the inspector asked for the size of the object - now handled. ============================================= http://lists.squeakfoundation.org/pipermail/packages/2011-July/004860.html Name: System-ul.448 Ancestors: System-bf.447 Added accessors for #maxExternalSemaphores. ============================================= http://lists.squeakfoundation.org/pipermail/packages/2011-July/004861.html Name: Files-ul.111 Ancestors: Files-ul.110 - FileStream class >> #detectFile:do: can accept a FileStream as it's first argument - pass FileStreams instead of blocks to #detectFile:do: =============================================

1 0

The Trunk: Files-ul.111.mcz
by commits＠source.squeak.org 16 Jul '11

16 Jul '11

Levente Uzonyi uploaded a new version of Files to project The Trunk: http://source.squeak.org/trunk/Files-ul.111.mcz ==================== Summary ==================== Name: Files-ul.111 Author: ul Time: 16 July 2011, 11:27:11.356 am UUID: 42445191-7bd0-324c-bcca-079ee8b5da96 Ancestors: Files-ul.110 - FileStream class >> #detectFile:do: can accept a FileStream as it's first argument - pass FileStreams instead of blocks to #detectFile:do: =============== Diff against Files-ul.110 =============== Item was changed: ----- Method: DirectoryEntryFile>>contentsFrom:to: (in category 'stream access') ----- contentsFrom: startPosition to: endPosition "Answer my contents from startPosition to endPosition." ^ FileStream + detectFile: self readStream - detectFile: [ self readStream ] do: [ : stream | stream position: startPosition ; next: endPosition - startPosition + 1 ]! Item was changed: ----- Method: FileStream class>>detectFile:do: (in category 'instance creation') ----- + detectFile: aBlockOrFileStream do: anotherBlock + + ^aBlockOrFileStream value "Assume that FileStreams return self for #value." + ifNotNil: [ :file | [ anotherBlock value: file ] ensure: [ file close ] ]! - detectFile: aBlock do: anotherBlock - ^aBlock value - ifNil: [nil] - ifNotNil: [:file| [anotherBlock value: file] ensure: [file close]]! Item was changed: ----- Method: FileStream class>>fileNamed:do: (in category 'instance creation') ----- fileNamed: fileName do: aBlock "Avi Bryant says, ''This idiom is quite common in other languages that make heavy use of closures (i.e. Lisp (with-file 'foo' (f) ...) and Ruby (File.open('foo'){|f|...})). It's time Squeak had it, too.'' Returns the result of aBlock." + ^self detectFile: (self fileNamed: fileName) do: aBlock! - ^ self detectFile: [ self fileNamed: fileName ] do: aBlock! Item was changed: ----- Method: FileStream class>>forceNewFileNamed:do: (in category 'instance creation') ----- forceNewFileNamed: fileName do: aBlock "Avi Bryant says, ''This idiom is quite common in other languages that make heavy use of closures (i.e. Lisp (with-file 'foo' (f) ...) and Ruby (File.open('foo'){|f|...})). It's time Squeak had it, too.'' Returns the result of aBlock." + ^self detectFile: (self forceNewFileNamed: fileName) do: aBlock! - ^ self detectFile: [ self forceNewFileNamed: fileName ] do: aBlock! Item was changed: ----- Method: FileStream class>>newFileNamed:do: (in category 'instance creation') ----- newFileNamed: fileName do: aBlock "Avi Bryant says, ''This idiom is quite common in other languages that make heavy use of closures (i.e. Lisp (with-file 'foo' (f) ...) and Ruby (File.open('foo'){|f|...})). It's time Squeak had it, too.'' Returns the result of aBlock." + ^self detectFile: (self newFileNamed: fileName) do: aBlock! - ^ self detectFile: [ self newFileNamed: fileName ] do: aBlock! Item was changed: ----- Method: FileStream class>>oldFileNamed:do: (in category 'instance creation') ----- oldFileNamed: fileName do: aBlock "Avi Bryant says, ''This idiom is quite common in other languages that make heavy use of closures (i.e. Lisp (with-file 'foo' (f) ...) and Ruby (File.open('foo'){|f|...})). It's time Squeak had it, too.'' Returns the result of aBlock." + ^self detectFile: (self oldFileNamed: fileName) do: aBlock! - ^ self detectFile: [ self oldFileNamed: fileName ] do: aBlock! Item was changed: ----- Method: FileStream class>>readOnlyFileNamed:do: (in category 'instance creation') ----- readOnlyFileNamed: fileName do: aBlock "Avi Bryant says, ''This idiom is quite common in other languages that make heavy use of closures (i.e. Lisp (with-file 'foo' (f) ...) and Ruby (File.open('foo'){|f|...})). It's time Squeak had it, too.'' Returns the result of aBlock." + ^self detectFile: (self readOnlyFileNamed: fileName) do: aBlock! - ^ self detectFile: [ self readOnlyFileNamed: fileName ] do: aBlock!

1 0

← Newer
1
...
4
5
6
7
8
9
10
...
15
Older →

Jump to page: