Packages July 2011

packages@lists.squeakfoundation.org

1 participants
141 discussions

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: Collections-ul.445.mcz
by commits＠source.squeak.org 18 Jul '11

18 Jul '11

1 0

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

18 Jul '11

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: Kernel-ul.606.mcz
by commits＠source.squeak.org 18 Jul '11

18 Jul '11

1 0

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

18 Jul '11

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

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

18 Jul '11

1 0

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

18 Jul '11

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:

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

Packages July 2011