Squeak-dev November 2017

squeak-dev@lists.squeakfoundation.org

38 participants
198 discussions

The Trunk: CollectionsTests-nice.284.mcz
by commits＠source.squeak.org 26 Nov '17

26 Nov '17

Nicolas Cellier uploaded a new version of CollectionsTests to project The Trunk: http://source.squeak.org/trunk/CollectionsTests-nice.284.mcz ==================== Summary ==================== Name: CollectionsTests-nice.284 Author: nice Time: 8 November 2017, 12:33:12.625652 am UUID: dc0e00e8-72ad-4698-a05c-fe0fba0bf7dc Ancestors: CollectionsTests-nice.283 Update tests for SortFunction refactorings =============== Diff against CollectionsTests-nice.283 =============== Item was changed: SystemOrganization addCategory: #'CollectionsTests-Abstract'! SystemOrganization addCategory: #'CollectionsTests-Arrayed'! SystemOrganization addCategory: #'CollectionsTests-Sequenceable'! + SystemOrganization addCategory: #'CollectionsTests-SortFunctions'! SystemOrganization addCategory: #'CollectionsTests-Stack'! SystemOrganization addCategory: #'CollectionsTests-Streams'! SystemOrganization addCategory: #'CollectionsTests-Support'! SystemOrganization addCategory: #'CollectionsTests-Text'! SystemOrganization addCategory: #'CollectionsTests-Unordered'! SystemOrganization addCategory: #'CollectionsTests-Weak'! Item was changed: TestCase subclass: #ChainedSortFunctionTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' + category: 'CollectionsTests-SortFunctions'! - category: 'CollectionsTests-Support'! Item was added: + ----- Method: ChainedSortFunctionTest>>testComparisonOfFunctions (in category 'tests') ----- + testComparisonOfFunctions + + self assert: #name ascending, #surname equals: #name ascending, #surname. + self assert: (#name ascending, #surname) hash equals: (#name ascending, #surname) hash. + + self deny: #name ascending, #surname = (#name ascending, #surname2). + self deny: #name ascending, #surname = (#name descending, #surname). + self deny: #name ascending, #surname ascending = (#name ascending, #surname descending).! Item was changed: TestCase subclass: #SortFunctionTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' + category: 'CollectionsTests-SortFunctions'! - category: 'CollectionsTests-Support'! Item was added: + ----- Method: SortFunctionTest>>testAsSortFunction (in category 'tests') ----- + testAsSortFunction + | function | + function := #name ascending. + self assert: function equals: function asSortFunction. + function := #name asSortFunction. + self assert: function equals: function asSortFunction. + function := [ :each | each name ] ascending. + self assert: function equals: function asSortFunction. + function := [ :x :y | x <=> y ] asSortFunction. + self assert: function equals: function asSortFunction.! Item was added: + ----- Method: SortFunctionTest>>testComparisonOfFunctionsDefinedByBlock (in category 'tests') ----- + testComparisonOfFunctionsDefinedByBlock + | collatorBlock | + collatorBlock := [ :a :b | 1 ]. + + self assert: collatorBlock ascending equals: collatorBlock ascending. + self assert: collatorBlock ascending hash equals: collatorBlock ascending hash. + + self deny: collatorBlock ascending = collatorBlock descending. + self deny: collatorBlock ascending = [ :a :b | -1 ] ascending! Item was added: + ----- Method: SortFunctionTest>>testComparisonOfFunctionsDefinedBySymbol (in category 'tests') ----- + testComparisonOfFunctionsDefinedBySymbol + + self assert: #name ascending equals: #name ascending. + self assert: #name ascending hash equals: #name ascending hash. + + self deny: #name ascending = #name descending. + self deny: #name ascending = #name2 ascending. + self deny: #name ascending undefinedFirst = #name ascending undefinedLast! Item was changed: ----- Method: SortFunctionTest>>testDirectionToggling (in category 'tests') ----- testDirectionToggling | function | function := #x ascending. self assert: (function value: 0 @ 2 value: 1 @ 1). self assert: (function value: 1 @ 2 value: 1 @ 1). self deny: (function value: 2 @ 2 value: 1 @ 1). + function := function reversed. - function := function toggleDirection. self deny: (function value: 1 @ 2 value: 2 @ 1). self assert: (function value: 1 @ 2 value: 1 @ 1). self assert: (function value: 2 @ 2 value: 1 @ 1). + function := function reversed. - function := function toggleDirection. self assert: (function value: 0 @ 2 value: 1 @ 1). self assert: (function value: 1 @ 2 value: 1 @ 1). self deny: (function value: 2 @ 2 value: 1 @ 1)! Item was changed: ----- Method: SortFunctionTest>>testPropertyWithOddCollator (in category 'tests') ----- testPropertyWithOddCollator | function | + function := #y collatedBy: [:a :b | "sort the odd first" (b bitAnd: 1) - (a bitAnd: 1)]. - function := #y sortedWith: [:a :b | "sort the odd first" (b bitAnd: 1) - (a bitAnd: 1)]. self assert: (function value: 0@1 value: 0@0). self assert: (function value: 0@1 value: 0@2). self deny: (function value: 0@2 value: 0@1). self deny: (function value: 0@2 value: 0@3).! Item was added: + ----- Method: SortFunctionTest>>testUndefinedFirstUnary (in category 'tests') ----- + testUndefinedFirstUnary + + | function | + function := #y ascending undefinedFirst. + self assert: (function value: 0 @ nil value: 1 @ 1). + self assert: (function value: 1 @ 2 value: 1 @ 2). + self deny: (function value: 2 @ 2 value: 1 @ 1). + function := #y descending undefinedFirst. + self assert: (function value: 1 @ nil value: 2 @ 1). + self deny: (function value: 1 @ 2 value: 1 @ 3). + self deny: (function value: 2 @ 2 value: 1 @ 3)! Item was added: + ----- Method: SortFunctionTest>>testUndefinedLastUnary (in category 'tests') ----- + testUndefinedLastUnary + + | function | + function := #y ascending undefinedLast. + self assert: (function value: 0 @ 2 value: 1 @ nil). + self assert: (function value: 1 @ 2 value: 1 @ 2). + self deny: (function value: 2 @ 2 value: 1 @ 1). + function := #y descending undefinedLast. + self assert: (function value: 1 @ 2 value: 2 @ nil). + self deny: (function value: 1 @ 2 value: 1 @ 3). + self deny: (function value: 2 @ 2 value: 1 @ 3)! Item was changed: TestCase subclass: #TestSpaceshipOperator instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' + category: 'CollectionsTests-SortFunctions'! - category: 'CollectionsTests-Support'! Item was added: + ----- Method: TestSpaceshipOperator>>testIntegers (in category 'tests') ----- + testIntegers + self assert: (42 <=> 42) equals: 0. + self assert: (1 <=> 42) equals: -1. + self assert: (100 <=> 42) equals: 1!

1 0

The Trunk: CollectionsTests-nice.283.mcz
by commits＠source.squeak.org 26 Nov '17

26 Nov '17

Nicolas Cellier uploaded a new version of CollectionsTests to project The Trunk: http://source.squeak.org/trunk/CollectionsTests-nice.283.mcz ==================== Summary ==================== Name: CollectionsTests-nice.283 Author: nice Time: 5 November 2017, 11:44:39.51802 pm UUID: cd2d2262-39d2-4a4d-aa16-7dfd759c1740 Ancestors: CollectionsTests-topa.282 Test the undefinedFirst as proposed by Denis Kudriashov in Pharo. Also test ability of sorting properties with odd collator rather than default <=> =============== Diff against CollectionsTests-topa.282 =============== Item was changed: ----- Method: SortFunctionTest>>testDirectionToggling (in category 'tests') ----- testDirectionToggling | function | function := #x ascending. self assert: (function value: 0 @ 2 value: 1 @ 1). self assert: (function value: 1 @ 2 value: 1 @ 1). self deny: (function value: 2 @ 2 value: 1 @ 1). + function := function toggleDirection. - function toggleDirection. self deny: (function value: 1 @ 2 value: 2 @ 1). self assert: (function value: 1 @ 2 value: 1 @ 1). self assert: (function value: 2 @ 2 value: 1 @ 1). + function := function toggleDirection. - function toggleDirection. self assert: (function value: 0 @ 2 value: 1 @ 1). self assert: (function value: 1 @ 2 value: 1 @ 1). self deny: (function value: 2 @ 2 value: 1 @ 1)! Item was added: + ----- Method: SortFunctionTest>>testPropertyWithOddCollator (in category 'tests') ----- + testPropertyWithOddCollator + + | function | + function := #y sortedWith: [:a :b | "sort the odd first" (b bitAnd: 1) - (a bitAnd: 1)]. + self assert: (function value: 0@1 value: 0@0). + self assert: (function value: 0@1 value: 0@2). + self deny: (function value: 0@2 value: 0@1). + self deny: (function value: 0@2 value: 0@3).! Item was added: + ----- Method: SortFunctionTest>>testUndefinedFirst (in category 'tests') ----- + testUndefinedFirst + + | function | + function := #value ascending undefinedFirst . + self assert: (function value: 1->nil value: 2->'foo'). + self assert: (function collate: 1->nil with: 2->nil) = 0. + self assert: (function value: 2->'bar' value: 1->'foo'). + self deny: (function value: 2->'foo' value: 1->'bar'). + self deny: (function value: 1->'foo' value: 2->nil).! Item was added: + ----- Method: SortFunctionTest>>testUndefinedLast (in category 'tests') ----- + testUndefinedLast + + | function | + function := #value ascending undefinedLast . + self deny: (function value: 1->nil value: 2->'foo'). + self assert: (function collate: 1->nil with: 2->nil) = 0. + self assert: (function value: 2->'bar' value: 1->'foo'). + self deny: (function value: 2->'foo' value: 1->'bar'). + self assert: (function value: 1->'foo' value: 2->nil).!

1 0

The Trunk: Collections-nice.768.mcz
by commits＠source.squeak.org 26 Nov '17

26 Nov '17

Nicolas Cellier uploaded a new version of Collections to project The Trunk: http://source.squeak.org/trunk/Collections-nice.768.mcz ==================== Summary ==================== Name: Collections-nice.768 Author: nice Time: 26 November 2017, 10:39:18.783084 pm UUID: 3431c5cc-a7a1-4317-b07d-24a59bd26bb0 Ancestors: Collections-eem.767, Collections-nice.767 Merge (revised SortFunction + Transcript characterLimit) =============== Diff against Collections-eem.767 =============== Item was changed: SystemOrganization addCategory: #'Collections-Abstract'! SystemOrganization addCategory: #'Collections-Arrayed'! SystemOrganization addCategory: #'Collections-Cache'! SystemOrganization addCategory: #'Collections-Exceptions'! SystemOrganization addCategory: #'Collections-Heap'! SystemOrganization addCategory: #'Collections-Sequenceable'! + SystemOrganization addCategory: #'Collections-SortFunctions'! SystemOrganization addCategory: #'Collections-Stack'! SystemOrganization addCategory: #'Collections-Streams'! SystemOrganization addCategory: #'Collections-Strings'! SystemOrganization addCategory: #'Collections-Support'! SystemOrganization addCategory: #'Collections-Text'! SystemOrganization addCategory: #'Collections-Unordered'! SystemOrganization addCategory: #'Collections-Weak'! Item was changed: + ----- Method: BlockClosure>>asSortFunction (in category '*Collections-SortFunctions-converting') ----- - ----- Method: BlockClosure>>asSortFunction (in category '*Collections-Support-sorting') ----- asSortFunction + "Return a SortFunction around the receiver. If the receiver is a 2 arg block, it is assumed it will do the collation directly itself, returning -1, 0, or 1. If the receiver is a one arg block, it will be evaluated for each a and b and of the sort input, and the result of sending <=> to those will be used" + + self numArgs = 1 ifTrue: [^PropertySortFunction property: self]. + self numArgs = 2 ifTrue: [^CollatorBlockFunction usingBlock: self]. + self error: 'Cant be converted to sort function. It should has one or two args' ! - ^self ascending! Item was changed: + ----- Method: BlockClosure>>ascending (in category '*Collections-SortFunctions-converting') ----- - ----- Method: BlockClosure>>ascending (in category '*Collections-Support-sorting') ----- ascending "Return a SortFunction around the receiver. If the receiver is a 2 arg block, it is assumed it will do the collation directly itself, returning -1, 0, or 1. If the receiver is a one arg block, it will be evaluated for each a and b and of the sort input, and the result of sending <=> to those will be used." + ^self asSortFunction! - | function | - function := SortFunction ascend. - self numArgs = 1 ifTrue: [function monadicBlock: self]. - self numArgs = 2 ifTrue: [function collator: self]. - ^function! Item was added: + ----- Method: BlockClosure>>collatedBy: (in category '*Collections-SortFunctions-converting') ----- + collatedBy: aSortFunction + "Return a SortFunction around the receiver. If the receiver is a 2 arg block, it is assumed it will do the collation directly itself, returning -1, 0, or 1. If the receiver is a one arg block, it will be evaluated for each a and b and of the sort input, and the result of using aSortFunction on those will be used" + + self numArgs = 1 ifTrue: [^PropertySortFunction property: self collatedWith: aSortFunction asSortFunction]. + self error: 'Cant be converted to sort function. It should hava one arg' ! Item was changed: + ----- Method: BlockClosure>>descending (in category '*Collections-SortFunctions-converting') ----- - ----- Method: BlockClosure>>descending (in category '*Collections-Support-sorting') ----- descending "Opposite direction as ascending." + ^self asSortFunction reversed! - ^self ascending toggleDirection! Item was changed: + ComposedSortFunction subclass: #ChainedSortFunction + instanceVariableNames: 'nextFunction' - SortFunction subclass: #ChainedSortFunction - instanceVariableNames: 'next' classVariableNames: '' poolDictionaries: '' + category: 'Collections-SortFunctions'! - category: 'Collections-Support'! + !ChainedSortFunction commentStamp: 'nice 11/7/2017 22:14' prior: 0! + I add to my parent the idea of a "next" function to use when two objects are equal by my primary sort function. - !ChainedSortFunction commentStamp: 'nice 3/13/2014 22:25' prior: 0! - I add to my parent the idea of a "next" function to use when two objects are equal by my particular collator. Usage SortFunctions can be chained together in primary, secondary, tertiary, etc order using the comma method. Consider a sequence of customer objects, where each customer object responds to the messages firstName, lastName, and age. If we want to sort them lastName first, then firstName, and finally oldest first, we would use an expression like: customers sort: #lastName ascending, #firstName ascending, #age descending As noted in my super's comment, unary symbols or single arg blocks can be used. One can omit the the ascending methods on arguments (not the receiver), it will default blocks or symbols to be ascending if none is specified. In other words, the above expression could be simplified slightly as customers sort: #lastName ascending, #firstName, #age descending (note the missing ascending on the #firstName argument) Instance Variables + baseSortFunction <SortFunction> the primary SortFunction to collate given objects + next Function <SortFunction> the next SortFunction to evaluate in the event primary collation results are equal values! - next <SortFunction> the next SortFunction to evaluate in the event my evaluator results in equal values. - - ! Item was added: + ----- Method: ChainedSortFunction class>>startWith:then: (in category 'instance creation') ----- + startWith: aSortFunction then: nextSortFunction + ^self new + baseSortFunction: aSortFunction; + nextFunction: nextSortFunction! Item was changed: ----- Method: ChainedSortFunction>>, (in category 'converting') ----- , aSortFunction + ^self class startWith: baseSortFunction then: nextFunction , aSortFunction! - self next: next , aSortFunction! Item was added: + ----- Method: ChainedSortFunction>>= (in category 'comparing') ----- + = anObject + "Answer whether the receiver and anObject represent the same object." + + self == anObject + ifTrue: [ ^ true ]. + self class = anObject class + ifFalse: [ ^ false ]. + ^ baseSortFunction = anObject baseSortFunction + and: [ nextFunction = anObject nextFunction ]! Item was added: + ----- Method: ChainedSortFunction>>collate:with: (in category 'evaluating') ----- + collate: anObject1 with: anObject2 + "If the result of current function is 0, then pass on to the next function to work it out" + + | result | + result := baseSortFunction collate: anObject1 with: anObject2. + ^result isZero + ifTrue: [nextFunction collate: anObject1 with: anObject2.] + ifFalse: [result]! Item was added: + ----- Method: ChainedSortFunction>>hash (in category 'comparing') ----- + hash + "Answer an integer value that is related to the identity of the receiver." + + ^ super hash + nextFunction hash! Item was removed: - ----- Method: ChainedSortFunction>>next: (in category 'initialize-release') ----- - next: anObject - - next := anObject! Item was added: + ----- Method: ChainedSortFunction>>nextFunction (in category 'accessing') ----- + nextFunction + ^nextFunction! Item was added: + ----- Method: ChainedSortFunction>>nextFunction: (in category 'accessing') ----- + nextFunction: aSortFunction + nextFunction := aSortFunction! Item was removed: - ----- Method: ChainedSortFunction>>value:value: (in category 'evaluating') ----- - value: anObject value: bObject - "Refinement of the parent behavior. If the result of my collator is 0, then pass on to the next variable to work it out." - - | result | - result := (collator value: anObject value: bObject) * direction. - ^result isZero - ifTrue: [next value: anObject value: bObject] - ifFalse: [result < 0]! Item was added: + SortFunction subclass: #CollatorBlockFunction + instanceVariableNames: 'collatorBlock' + classVariableNames: '' + poolDictionaries: '' + category: 'Collections-SortFunctions'! + + !CollatorBlockFunction commentStamp: 'nice 11/5/2017 22:57' prior: 0! + A CollatorBlockFunction is a special SortFunction using a dyadic block to collate objects. + + Instance Variables + + collator <Block> a dyadic block that must return a -1, 0, or 1.! Item was added: + ----- Method: CollatorBlockFunction class>>usingBlock: (in category 'instance creation') ----- + usingBlock: twoArgsBlock + ^self new + collatorBlock: twoArgsBlock! Item was added: + ----- Method: CollatorBlockFunction>>= (in category 'comparing') ----- + = anObject + "Answer whether the receiver and anObject represent the same object." + + self == anObject + ifTrue: [ ^ true ]. + self class = anObject class + ifFalse: [ ^ false ]. + ^collatorBlock = anObject collatorBlock! Item was added: + ----- Method: CollatorBlockFunction>>collate:with: (in category 'evaluating') ----- + collate: anObject1 with: anObject2 + + ^collatorBlock value: anObject1 value: anObject2 ! Item was added: + ----- Method: CollatorBlockFunction>>collatorBlock (in category 'accessing') ----- + collatorBlock + ^collatorBlock! Item was added: + ----- Method: CollatorBlockFunction>>collatorBlock: (in category 'accessing') ----- + collatorBlock: aBlock + collatorBlock := aBlock! Item was added: + ----- Method: CollatorBlockFunction>>hash (in category 'comparing') ----- + hash + "Answer an integer value that is related to the identity of the receiver." + + ^ collatorBlock hash! Item was removed: - ----- Method: Collection>>median (in category 'math functions') ----- - median - ^ self asSortedCollection median! Item was added: + SortFunction subclass: #ComposedSortFunction + instanceVariableNames: 'baseSortFunction' + classVariableNames: '' + poolDictionaries: '' + category: 'Collections-SortFunctions'! + + !ComposedSortFunction commentStamp: 'nice 11/7/2017 22:13' prior: 0! + A ComposedSortFunction is an abstract class wrapping over another SortFunction for the sake of composition. + + Subclasses have to define the composition behavior via collate:with: message. + + Instances variables: + baseSortFunction <SortFunction> the wrapped sort function! Item was added: + ----- Method: ComposedSortFunction class>>on: (in category 'instance creation') ----- + on: aSortFunction + ^self new baseSortFunction: aSortFunction! Item was added: + ----- Method: ComposedSortFunction>>= (in category 'comparing') ----- + = aSortFunction + self == aSortFunction ifTrue: [ ^true ]. + ^self class = aSortFunction class and: [ baseSortFunction = aSortFunction baseSortFunction ]! Item was added: + ----- Method: ComposedSortFunction>>baseSortFunction (in category 'accessing') ----- + baseSortFunction + ^baseSortFunction! Item was added: + ----- Method: ComposedSortFunction>>baseSortFunction: (in category 'accessing') ----- + baseSortFunction: aSortFunction + baseSortFunction := aSortFunction! Item was added: + ----- Method: ComposedSortFunction>>hash (in category 'comparing') ----- + hash + ^baseSortFunction hash hashMultiply! Item was added: + ----- Method: ComposedSortFunction>>initialize (in category 'initailize-release') ----- + initialize + super initialize. + baseSortFunction := self class default! Item was added: + SortFunction subclass: #DefaultSortFunction + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Collections-SortFunctions'! + + !DefaultSortFunction commentStamp: 'nice 11/7/2017 23:43' prior: 0! + A DefaultSortFunction is a collator using the default <=> operator. + It is known to work on String and Magnitude. + + It is generally not usefull to create a new instance, and the recommended pattern is to use the single instance available by sending the message SortFunction default . + + For other objects that don't understand threeWayCompareTo: it is necessary to use a custom SortFunction rather than the default one. + ! Item was added: + ----- Method: DefaultSortFunction class>>initialize (in category 'class initialization') ----- + initialize + Default := self new! Item was added: + ----- Method: DefaultSortFunction class>>new (in category 'instance creation') ----- + new + ^UniqueInstance ifNil: [self basicNew initialize]! Item was added: + ----- Method: DefaultSortFunction>>collate:with: (in category 'evaluating') ----- + collate: anObject with: anotherObject + ^anObject <=> anotherObject! Item was added: + ComposedSortFunction subclass: #PropertySortFunction + instanceVariableNames: 'property' + classVariableNames: '' + poolDictionaries: '' + category: 'Collections-SortFunctions'! + + !PropertySortFunction commentStamp: 'nice 11/5/2017 22:36' prior: 0! + A PropertySortFunction is a SortFunction for sorting by a specific property. + + Instance Variables + collator <SortFunction> the SortFunction to be used for sorting the properties + property <Symbol | Block> a valuable returning the value of property for objects to be sorted! Item was added: + ----- Method: PropertySortFunction class>>property: (in category 'instance creation') ----- + property: selectorOrOneArgBlock + ^self new + property: selectorOrOneArgBlock! Item was added: + ----- Method: PropertySortFunction class>>property:collatedWith: (in category 'instance creation') ----- + property: selectorOrOneArgBlock collatedWith: aSortFunction + ^self new + property: selectorOrOneArgBlock; + baseSortFunction: aSortFunction! Item was added: + ----- Method: PropertySortFunction>>= (in category 'comparing') ----- + = anObject + "Answer whether the receiver and anObject represent the same object." + + self == anObject + ifTrue: [ ^ true ]. + self class = anObject class + ifFalse: [ ^ false ]. + ^ baseSortFunction = anObject baseSortFunction + and: [ property = anObject property ]! Item was added: + ----- Method: PropertySortFunction>>collate:with: (in category 'evaluating') ----- + collate: anObject with: another + "Answer the collation order of anObject and another based on the property." + ^ baseSortFunction collate: (property value: anObject) with: (property value: another)! Item was added: + ----- Method: PropertySortFunction>>hash (in category 'comparing') ----- + hash + "Answer an integer value that is related to the identity of the receiver." + + ^ super hash bitXor: property hash! Item was added: + ----- Method: PropertySortFunction>>property (in category 'accessing') ----- + property + ^ property! Item was added: + ----- Method: PropertySortFunction>>property: (in category 'accessing') ----- + property: aValuable + property := aValuable! Item was added: + ----- Method: PropertySortFunction>>undefinedFirst (in category 'converting') ----- + undefinedFirst + "apply on the property" + ^self class + property: property + collatedWith: baseSortFunction undefinedFirst! Item was added: + ----- Method: PropertySortFunction>>undefinedLast (in category 'converting') ----- + undefinedLast + "apply on the property" + ^self class + property: property + collatedWith: baseSortFunction undefinedLast! Item was added: + ComposedSortFunction subclass: #ReverseSortFunction + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Collections-SortFunctions'! + + !ReverseSortFunction commentStamp: 'nice 11/6/2017 21:54' prior: 0! + A ReverseSortFunction wraps over another SortFunction so as to sort in reverse order.! Item was added: + ----- Method: ReverseSortFunction>>collate:with: (in category 'evaluating') ----- + collate: anObject with: another + ^(baseSortFunction collate: anObject with: another) negated! Item was added: + ----- Method: ReverseSortFunction>>reversed (in category 'converting') ----- + reversed + ^baseSortFunction! Item was added: + ----- Method: ReverseSortFunction>>toggleDirection (in category 'converting') ----- + toggleDirection + ^collator! Item was added: + ----- Method: ReverseSortFunction>>undefinedFirst (in category 'converting') ----- + undefinedFirst + "apply on the original" + ^baseSortFunction undefinedLast reversed! Item was added: + ----- Method: ReverseSortFunction>>undefinedLast (in category 'converting') ----- + undefinedLast + "apply on the original" + ^baseSortFunction undefinedFirst reversed! Item was changed: Object subclass: #SortFunction + instanceVariableNames: '' + classVariableNames: 'Default' - instanceVariableNames: 'direction collator' - classVariableNames: '' poolDictionaries: '' + category: 'Collections-SortFunctions'! - category: 'Collections-Support'! + !SortFunction commentStamp: 'nice 11/5/2017 22:52' prior: 0! - !SortFunction commentStamp: 'nice 3/13/2014 22:24' prior: 0! I am intended to be used in place of two arg sort blocks. Usage In the following example, an ascending SortFunction is created based on the result of the #first message send to each object. #(#(1 2) #(2 3) #(0 0)) sorted: #first ascending. To sort by the #last element, but descending, the following would be used: #(#(1 2) #(2 3) #(0 0)) sorted: #last descending. One can use blocks as well. The following sorts in descending order, the sub elements based on the sum of their values. | sumBlock | sumBlock := [:sequence | sequence inject: 0 into: [:sum :each | sum + each]]. #(#(1 2) #(2 3) #(0 0)) sorted: sumBlock descending. One can even use 2 arg blocks, for those cases where the function isn't expressible with objects that respond to < and =. The only catch, is that such a function has to return not true and false, but instead a collation order, values of -1 (for before), 0 (the same) or 1 (to follow). For example: | oddBlock | oddBlock := [:a :b | a odd = b odd ifTrue: [0] ifFalse: [a odd ifTrue: [-1] ifFalse: [1]]]. #(1 5 1 3 2 7 9 4 6) asSortedCollection: oddBlock descending Instance Variables + collator <SortFunction> This is the object responsible for collating objetcs, generally a SortFunction. - collator <BlockClosure> This is the collation function that must return a -1, 0, or 1. It is usually composed by an initialization method such as sendMessage: or monadicBlock:, but may be set directly. - direction <SmallInteger> 1 for ascending, -1 for descending ! Item was removed: - ----- Method: SortFunction class>>ascend (in category 'instance creation') ----- - ascend - - ^self new ascend! Item was added: + ----- Method: SortFunction class>>default (in category 'accessing') ----- + default + ^Default! Item was removed: - ----- Method: SortFunction class>>descend (in category 'instance creation') ----- - descend - - ^self new descend! Item was changed: ----- Method: SortFunction>>, (in category 'converting') ----- , aSortFunction "Return a new SortFunction which is the concatenation of aSortFunction to me, I will be the primary sort, but if I compare equal, I will defer to the argument." + ^ChainedSortFunction startWith: self then: aSortFunction asSortFunction! - ^(ChainedSortFunction new) - collator: collator; - direction: direction; - next: aSortFunction asSortFunction! Item was removed: - ----- Method: SortFunction>>ascend (in category 'initailize-release') ----- - ascend - - direction := 1! Item was added: + ----- Method: SortFunction>>collate:with: (in category 'evaluating') ----- + collate: value1 with: value2 + "answer the collation order for the two values -1,0 or 1" + + ^self subclassResponsibility! Item was removed: - ----- Method: SortFunction>>collator: (in category 'initailize-release') ----- - collator: a2ArgBlock - "a2ArgBlock MUST return the collation order, -1, 0, or 1" - - collator := a2ArgBlock! Item was removed: - ----- Method: SortFunction>>descend (in category 'initailize-release') ----- - descend - - direction := -1! Item was removed: - ----- Method: SortFunction>>direction: (in category 'initailize-release') ----- - direction: anInteger - - direction := anInteger! Item was removed: - ----- Method: SortFunction>>isAscending (in category 'testing') ----- - isAscending - - ^direction = 1! Item was removed: - ----- Method: SortFunction>>isDescending (in category 'testing') ----- - isDescending - - ^direction = -1! Item was removed: - ----- Method: SortFunction>>monadicBlock: (in category 'initailize-release') ----- - monadicBlock: aSingleArgBlock - "Initialze the receiver's collation block to compare the results of evaluating aSingleArgBlock with each argument, and then collate the return values with the <=> method." - - collator := [:a :b | (aSingleArgBlock value: a) <=> (aSingleArgBlock value: b)]! Item was added: + ----- Method: SortFunction>>reversed (in category 'converting') ----- + reversed + "Return new sort function with reverse sort order." + + ^ReverseSortFunction on: self! Item was removed: - ----- Method: SortFunction>>sendMessage: (in category 'initailize-release') ----- - sendMessage: aUnarySymbol - "Initialze the receiver's collation block to compare the results of sending aUnarySymbol to each argument, and then collate them with the <=> method." - - collator := [:a :b | (a perform: aUnarySymbol) <=> (b perform: aUnarySymbol)]! Item was removed: - ----- Method: SortFunction>>toggleDirection (in category 'converting') ----- - toggleDirection - "Invert my current direction, if I'm currently ascending, this will cause me to be descending now, and vice-versa." - - direction := direction * -1! Item was added: + ----- Method: SortFunction>>undefinedFirst (in category 'converting') ----- + undefinedFirst + "Return a new SortFunction that sort all the nil first, an non nil with myself." + ^(UndefinedSortFunction on: self) undefinedFirst! Item was added: + ----- Method: SortFunction>>undefinedLast (in category 'converting') ----- + undefinedLast + "Return a new SortFunction that sort all the nil last, an non nil with myself." + ^(UndefinedSortFunction on: self) undefinedLast! Item was changed: ----- Method: SortFunction>>value:value: (in category 'evaluating') ----- value: anObject value: bObject "Masquerade as a two argument block, used by many of the sorting APIs, by returning whether anObject should be placed before bObject or not." | result | + result := (self collate: anObject with: bObject). - result := (collator value: anObject value: bObject) * direction. ^result <= 0! Item was changed: + ----- Method: Symbol>>asSortFunction (in category '*Collections-SortFunctions-converting') ----- - ----- Method: Symbol>>asSortFunction (in category 'sorting') ----- asSortFunction + "Return a SortFunction around the receiver, where the receiver will be used as a unary message to send to both a and b during sorting, and then the result of said send will be collated in ascending order using the <=> method." + "#('abc' 'de' 'fghi') sorted: #size ascending >>> #('de' 'abc' 'fghi')" + ^PropertySortFunction property: self! - ^self ascending! Item was changed: + ----- Method: Symbol>>ascending (in category '*Collections-SortFunctions-converting') ----- - ----- Method: Symbol>>ascending (in category 'sorting') ----- ascending "Return a SortFunction around the receiver, where the receiver will be used as a unary message to send to both a and b during sorting, and then the result of said send will be collated in ascending order using the <=> method." + "#('abc' 'de' 'fghi') sorted: #size ascending >>> #('de' 'abc' 'fghi')" - "Example: #('abc' 'de' 'fghi') sorted: #size asscending" + ^self asSortFunction ! - ^SortFunction ascend sendMessage: self! Item was added: + ----- Method: Symbol>>collatedBy: (in category '*Collections-SortFunctions-converting') ----- + collatedBy: aSortFunction + "Return a SortFunction around the receiver, where the receiver will be used as a unary message to send to both a and b during sorting, and then the result of said send will be collated iusing aSortFunction." + "#('abc' 'de' 'fghi') sorted: (#size collatedWith: [:e|e bitAnd: 1]) , #size >>> #( 'de' 'fghi' 'abc')" + + ^PropertySortFunction property: self collatedWith: aSortFunction asSortFunction! Item was changed: + ----- Method: Symbol>>descending (in category '*Collections-SortFunctions-converting') ----- - ----- Method: Symbol>>descending (in category 'sorting') ----- descending "Return a SortFunction around the receiver, where the receiver will be used as a unary message to send to both a and b during sorting, and then the result of said send will be collated in descending order using the <=> method." + "#('abc' 'de' 'fghi') sorted: #size ascending >>> #('fghi' 'abc' 'de')" - "Example: #('abc' 'de' 'fghi') sorted: #size descending" + ^self asSortFunction reversed! - ^SortFunction descend sendMessage: self! Item was added: + ComposedSortFunction subclass: #UndefinedSortFunction + instanceVariableNames: 'direction' + classVariableNames: '' + poolDictionaries: '' + category: 'Collections-SortFunctions'! + + !UndefinedSortFunction commentStamp: 'nice 11/7/2017 22:16' prior: 0! + An UndefinedSortFunction is a specialization usefull for sorting undefined objects (nil), either first or last according to direction. + The non nil objects are sorted according to the baseSortFunction defined in superclass. + + instance variables: + direction <Integer> -1 for sorting nil first, 1 for sorting nil last! Item was added: + ----- Method: UndefinedSortFunction>>= (in category 'comparing') ----- + = anObject + "Answer whether the receiver and anObject represent the same object." + + self == anObject + ifTrue: [ ^ true ]. + self class = anObject class + ifFalse: [ ^ false ]. + ^ baseSortFunction = anObject baseSortFunction + and: [ direction = anObject direction ]! Item was added: + ----- Method: UndefinedSortFunction>>collate:with: (in category 'evaluating') ----- + collate: anObject with: another + "Answer the collation order of anObject and another, with nil first or last according to direction" + anObject ifNil: [^another ifNil: [0] ifNotNil: [direction]]. + another ifNil: [^direction negated]. + ^baseSortFunction collate: anObject with: another! Item was added: + ----- Method: UndefinedSortFunction>>direction (in category 'accessing') ----- + direction + ^direction! Item was added: + ----- Method: UndefinedSortFunction>>hash (in category 'comparing') ----- + hash + "Answer an integer value that is related to the identity of the receiver." + + ^ super hash bitXor: direction hash! Item was added: + ----- Method: UndefinedSortFunction>>initialize (in category 'initailize-release') ----- + initialize + super initialize. + direction := -1! Item was added: + ----- Method: UndefinedSortFunction>>undefinedFirst (in category 'initailize-release') ----- + undefinedFirst + direction := -1! Item was added: + ----- Method: UndefinedSortFunction>>undefinedLast (in category 'initailize-release') ----- + undefinedLast + direction := 1!

1 0

The Trunk: Collections-nice.767.mcz
by commits＠source.squeak.org 26 Nov '17

26 Nov '17

Nicolas Cellier uploaded a new version of Collections to project The Trunk: http://source.squeak.org/trunk/Collections-nice.767.mcz ==================== Summary ==================== Name: Collections-nice.767 Author: nice Time: 8 November 2017, 12:46:38.73749 am UUID: a3d23745-3d89-423e-9f25-a4d2dbf9864c Ancestors: Collections-nice.766 Continue SortFunction refactoring =============== Diff against Collections-nice.766 =============== Item was changed: SystemOrganization addCategory: #'Collections-Abstract'! SystemOrganization addCategory: #'Collections-Arrayed'! SystemOrganization addCategory: #'Collections-Cache'! SystemOrganization addCategory: #'Collections-Exceptions'! SystemOrganization addCategory: #'Collections-Heap'! SystemOrganization addCategory: #'Collections-Sequenceable'! + SystemOrganization addCategory: #'Collections-SortFunctions'! SystemOrganization addCategory: #'Collections-Stack'! SystemOrganization addCategory: #'Collections-Streams'! SystemOrganization addCategory: #'Collections-Strings'! SystemOrganization addCategory: #'Collections-Support'! SystemOrganization addCategory: #'Collections-Text'! SystemOrganization addCategory: #'Collections-Unordered'! SystemOrganization addCategory: #'Collections-Weak'! Item was changed: + ----- Method: BlockClosure>>asSortFunction (in category '*Collections-SortFunctions-converting') ----- - ----- Method: BlockClosure>>asSortFunction (in category '*Collections-Support-sorting') ----- asSortFunction + "Return a SortFunction around the receiver. If the receiver is a 2 arg block, it is assumed it will do the collation directly itself, returning -1, 0, or 1. If the receiver is a one arg block, it will be evaluated for each a and b and of the sort input, and the result of sending <=> to those will be used" + + self numArgs = 1 ifTrue: [^PropertySortFunction property: self]. + self numArgs = 2 ifTrue: [^CollatorBlockFunction usingBlock: self]. + self error: 'Cant be converted to sort function. It should has one or two args' ! - ^self ascending! Item was changed: + ----- Method: BlockClosure>>ascending (in category '*Collections-SortFunctions-converting') ----- - ----- Method: BlockClosure>>ascending (in category '*Collections-Support-sorting') ----- ascending "Return a SortFunction around the receiver. If the receiver is a 2 arg block, it is assumed it will do the collation directly itself, returning -1, 0, or 1. If the receiver is a one arg block, it will be evaluated for each a and b and of the sort input, and the result of sending <=> to those will be used." + ^self asSortFunction! - self numArgs = 1 ifTrue: [^PropertySortFunction property: self]. - self numArgs = 2 ifTrue: [^CollatorBlockFunction new collator: self]. - self error: 'a block for sorting should have 1 or 2 parameters'! Item was added: + ----- Method: BlockClosure>>collatedBy: (in category '*Collections-SortFunctions-converting') ----- + collatedBy: aSortFunction + "Return a SortFunction around the receiver. If the receiver is a 2 arg block, it is assumed it will do the collation directly itself, returning -1, 0, or 1. If the receiver is a one arg block, it will be evaluated for each a and b and of the sort input, and the result of using aSortFunction on those will be used" + + self numArgs = 1 ifTrue: [^PropertySortFunction property: self collatedWith: aSortFunction asSortFunction]. + self error: 'Cant be converted to sort function. It should hava one arg' ! Item was changed: + ----- Method: BlockClosure>>descending (in category '*Collections-SortFunctions-converting') ----- - ----- Method: BlockClosure>>descending (in category '*Collections-Support-sorting') ----- descending "Opposite direction as ascending." + ^self asSortFunction reversed! - ^self ascending toggleDirection! Item was removed: - ----- Method: BlockClosure>>sortedWith: (in category '*Collections-Support-sorting') ----- - sortedWith: aSortFunction - "Return a SortFunction around the receiver. - The receiver is a one arg block. - It will be evaluated for each a and b and of the sort input, and answer the result of collating those with aSortFunction." - - self numArgs = 1 ifTrue: [^PropertySortFunction property: self sortedWith: aSortFunction asSortFunction]. - self error: 'a block for sorting should have 1 or 2 parameters'! Item was changed: + ComposedSortFunction subclass: #ChainedSortFunction + instanceVariableNames: 'nextFunction' - SortFunction subclass: #ChainedSortFunction - instanceVariableNames: 'next' classVariableNames: '' poolDictionaries: '' + category: 'Collections-SortFunctions'! - category: 'Collections-Support'! + !ChainedSortFunction commentStamp: 'nice 11/7/2017 22:14' prior: 0! + I add to my parent the idea of a "next" function to use when two objects are equal by my primary sort function. - !ChainedSortFunction commentStamp: 'nice 11/5/2017 22:35' prior: 0! - I add to my parent the idea of a "next" function to use when two objects are equal by my particular collator. Usage SortFunctions can be chained together in primary, secondary, tertiary, etc order using the comma method. Consider a sequence of customer objects, where each customer object responds to the messages firstName, lastName, and age. If we want to sort them lastName first, then firstName, and finally oldest first, we would use an expression like: customers sort: #lastName ascending, #firstName ascending, #age descending As noted in my super's comment, unary symbols or single arg blocks can be used. One can omit the the ascending methods on arguments (not the receiver), it will default blocks or symbols to be ascending if none is specified. In other words, the above expression could be simplified slightly as customers sort: #lastName ascending, #firstName, #age descending (note the missing ascending on the #firstName argument) Instance Variables + baseSortFunction <SortFunction> the primary SortFunction to collate given objects + next Function <SortFunction> the next SortFunction to evaluate in the event primary collation results are equal values! - collator <SortFunction> the first SortFunction. - next <SortFunction> the next SortFunction to evaluate in the event the first results in equal values. - - ! Item was added: + ----- Method: ChainedSortFunction class>>startWith:then: (in category 'instance creation') ----- + startWith: aSortFunction then: nextSortFunction + ^self new + baseSortFunction: aSortFunction; + nextFunction: nextSortFunction! Item was changed: ----- Method: ChainedSortFunction>>, (in category 'converting') ----- , aSortFunction + ^self class startWith: baseSortFunction then: nextFunction , aSortFunction! - ^self copy next: next , aSortFunction! Item was added: + ----- Method: ChainedSortFunction>>= (in category 'comparing') ----- + = anObject + "Answer whether the receiver and anObject represent the same object." + + self == anObject + ifTrue: [ ^ true ]. + self class = anObject class + ifFalse: [ ^ false ]. + ^ baseSortFunction = anObject baseSortFunction + and: [ nextFunction = anObject nextFunction ]! Item was changed: ----- Method: ChainedSortFunction>>collate:with: (in category 'evaluating') ----- + collate: anObject1 with: anObject2 + "If the result of current function is 0, then pass on to the next function to work it out" - collate: anObject with: bObject - "Refinement of the parent behavior. If the result of my collator is 0, then pass on to the next variable to work it out." | result | + result := baseSortFunction collate: anObject1 with: anObject2. - result := (collator collate: anObject with: bObject). ^result isZero + ifTrue: [nextFunction collate: anObject1 with: anObject2.] - ifTrue: [next collate: anObject with: bObject] ifFalse: [result]! Item was added: + ----- Method: ChainedSortFunction>>hash (in category 'comparing') ----- + hash + "Answer an integer value that is related to the identity of the receiver." + + ^ super hash + nextFunction hash! Item was removed: - ----- Method: ChainedSortFunction>>next: (in category 'initialize-release') ----- - next: anObject - - next := anObject! Item was added: + ----- Method: ChainedSortFunction>>nextFunction (in category 'accessing') ----- + nextFunction + ^nextFunction! Item was added: + ----- Method: ChainedSortFunction>>nextFunction: (in category 'accessing') ----- + nextFunction: aSortFunction + nextFunction := aSortFunction! Item was changed: SortFunction subclass: #CollatorBlockFunction + instanceVariableNames: 'collatorBlock' - instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' + category: 'Collections-SortFunctions'! - category: 'Collections-Support'! !CollatorBlockFunction commentStamp: 'nice 11/5/2017 22:57' prior: 0! A CollatorBlockFunction is a special SortFunction using a dyadic block to collate objects. Instance Variables collator <Block> a dyadic block that must return a -1, 0, or 1.! Item was added: + ----- Method: CollatorBlockFunction class>>usingBlock: (in category 'instance creation') ----- + usingBlock: twoArgsBlock + ^self new + collatorBlock: twoArgsBlock! Item was added: + ----- Method: CollatorBlockFunction>>= (in category 'comparing') ----- + = anObject + "Answer whether the receiver and anObject represent the same object." + + self == anObject + ifTrue: [ ^ true ]. + self class = anObject class + ifFalse: [ ^ false ]. + ^collatorBlock = anObject collatorBlock! Item was changed: ----- Method: CollatorBlockFunction>>collate:with: (in category 'evaluating') ----- + collate: anObject1 with: anObject2 + + ^collatorBlock value: anObject1 value: anObject2 ! - collate: value1 with: value2 - ^collator value: value1 value: value2! Item was added: + ----- Method: CollatorBlockFunction>>collatorBlock (in category 'accessing') ----- + collatorBlock + ^collatorBlock! Item was added: + ----- Method: CollatorBlockFunction>>collatorBlock: (in category 'accessing') ----- + collatorBlock: aBlock + collatorBlock := aBlock! Item was added: + ----- Method: CollatorBlockFunction>>hash (in category 'comparing') ----- + hash + "Answer an integer value that is related to the identity of the receiver." + + ^ collatorBlock hash! Item was added: + SortFunction subclass: #ComposedSortFunction + instanceVariableNames: 'baseSortFunction' + classVariableNames: '' + poolDictionaries: '' + category: 'Collections-SortFunctions'! + + !ComposedSortFunction commentStamp: 'nice 11/7/2017 22:13' prior: 0! + A ComposedSortFunction is an abstract class wrapping over another SortFunction for the sake of composition. + + Subclasses have to define the composition behavior via collate:with: message. + + Instances variables: + baseSortFunction <SortFunction> the wrapped sort function! Item was added: + ----- Method: ComposedSortFunction class>>on: (in category 'instance creation') ----- + on: aSortFunction + ^self new baseSortFunction: aSortFunction! Item was added: + ----- Method: ComposedSortFunction>>= (in category 'comparing') ----- + = aSortFunction + self == aSortFunction ifTrue: [ ^true ]. + ^self class = aSortFunction class and: [ baseSortFunction = aSortFunction baseSortFunction ]! Item was added: + ----- Method: ComposedSortFunction>>baseSortFunction (in category 'accessing') ----- + baseSortFunction + ^baseSortFunction! Item was added: + ----- Method: ComposedSortFunction>>baseSortFunction: (in category 'accessing') ----- + baseSortFunction: aSortFunction + baseSortFunction := aSortFunction! Item was added: + ----- Method: ComposedSortFunction>>hash (in category 'comparing') ----- + hash + ^baseSortFunction hash hashMultiply! Item was added: + ----- Method: ComposedSortFunction>>initialize (in category 'initailize-release') ----- + initialize + super initialize. + baseSortFunction := self class default! Item was changed: SortFunction subclass: #DefaultSortFunction instanceVariableNames: '' + classVariableNames: '' - classVariableNames: 'UniqueInstance' poolDictionaries: '' + category: 'Collections-SortFunctions'! - category: 'Collections-Support'! + !DefaultSortFunction commentStamp: 'nice 11/7/2017 23:43' prior: 0! - !DefaultSortFunction commentStamp: 'nice 11/5/2017 21:45' prior: 0! A DefaultSortFunction is a collator using the default <=> operator. It is known to work on String and Magnitude. + It is generally not usefull to create a new instance, and the recommended pattern is to use the single instance available by sending the message SortFunction default . + + For other objects that don't understand threeWayCompareTo: it is necessary to use a custom SortFunction rather than the default one. ! Item was added: + ----- Method: DefaultSortFunction class>>initialize (in category 'class initialization') ----- + initialize + Default := self new! Item was changed: ----- Method: DefaultSortFunction>>collate:with: (in category 'evaluating') ----- + collate: anObject with: anotherObject + ^anObject <=> anotherObject! - collate: value1 with: value2 - ^value1 <=> value2! Item was removed: - ----- Method: DefaultSortFunction>>initialize (in category 'initailize-release') ----- - initialize - collator := #<=>! Item was changed: + ComposedSortFunction subclass: #PropertySortFunction - SortFunction subclass: #PropertySortFunction instanceVariableNames: 'property' classVariableNames: '' poolDictionaries: '' + category: 'Collections-SortFunctions'! - category: 'Collections-Support'! !PropertySortFunction commentStamp: 'nice 11/5/2017 22:36' prior: 0! A PropertySortFunction is a SortFunction for sorting by a specific property. Instance Variables collator <SortFunction> the SortFunction to be used for sorting the properties property <Symbol | Block> a valuable returning the value of property for objects to be sorted! Item was changed: ----- Method: PropertySortFunction class>>property: (in category 'instance creation') ----- + property: selectorOrOneArgBlock + ^self new + property: selectorOrOneArgBlock! - property: aValuable - ^self new property: aValuable! Item was added: + ----- Method: PropertySortFunction class>>property:collatedWith: (in category 'instance creation') ----- + property: selectorOrOneArgBlock collatedWith: aSortFunction + ^self new + property: selectorOrOneArgBlock; + baseSortFunction: aSortFunction! Item was removed: - ----- Method: PropertySortFunction class>>property:sortedWith: (in category 'instance creation') ----- - property: aValuable sortedWith: aSortFunction - ^self new property: aValuable; collator: aSortFunction! Item was added: + ----- Method: PropertySortFunction>>= (in category 'comparing') ----- + = anObject + "Answer whether the receiver and anObject represent the same object." + + self == anObject + ifTrue: [ ^ true ]. + self class = anObject class + ifFalse: [ ^ false ]. + ^ baseSortFunction = anObject baseSortFunction + and: [ property = anObject property ]! Item was changed: ----- Method: PropertySortFunction>>collate:with: (in category 'evaluating') ----- + collate: anObject with: another + "Answer the collation order of anObject and another based on the property." + ^ baseSortFunction collate: (property value: anObject) with: (property value: another)! - collate: value1 with: value2 - ^collator collate: (property value: value1) with: (property value: value2)! Item was added: + ----- Method: PropertySortFunction>>hash (in category 'comparing') ----- + hash + "Answer an integer value that is related to the identity of the receiver." + + ^ super hash bitXor: property hash! Item was added: + ----- Method: PropertySortFunction>>property (in category 'accessing') ----- + property + ^ property! Item was changed: + ----- Method: PropertySortFunction>>property: (in category 'accessing') ----- - ----- Method: PropertySortFunction>>property: (in category 'initailize-release') ----- property: aValuable property := aValuable! Item was changed: ----- Method: PropertySortFunction>>undefinedFirst (in category 'converting') ----- undefinedFirst "apply on the property" ^self class property: property + collatedWith: baseSortFunction undefinedFirst! - sortedWith: (UndefinedSortFunction new collator: collator) undefinedFirst! Item was changed: ----- Method: PropertySortFunction>>undefinedLast (in category 'converting') ----- undefinedLast "apply on the property" ^self class property: property + collatedWith: baseSortFunction undefinedLast! - sortedWith: (UndefinedSortFunction new collator: collator) undefinedLast! Item was changed: + ComposedSortFunction subclass: #ReverseSortFunction - SortFunction subclass: #ReverseSortFunction instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' + category: 'Collections-SortFunctions'! - category: 'Collections-Support'! + !ReverseSortFunction commentStamp: 'nice 11/6/2017 21:54' prior: 0! + A ReverseSortFunction wraps over another SortFunction so as to sort in reverse order.! - !ReverseSortFunction commentStamp: 'nice 11/5/2017 22:40' prior: 0! - A ReverseSortFunction is reversing the order of original sortFunction - - Instance Variables - collator <SortFunction> the original SortFunction. - ! Item was changed: ----- Method: ReverseSortFunction>>collate:with: (in category 'evaluating') ----- + collate: anObject with: another + ^(baseSortFunction collate: anObject with: another) negated! - collate: value1 with: value2 - ^(collator collate: value1 with: value2) negated! Item was added: + ----- Method: ReverseSortFunction>>reversed (in category 'converting') ----- + reversed + ^baseSortFunction! Item was changed: ----- Method: ReverseSortFunction>>undefinedFirst (in category 'converting') ----- undefinedFirst "apply on the original" + ^baseSortFunction undefinedLast reversed! - ^collator undefinedFirst toggleDirection! Item was changed: ----- Method: ReverseSortFunction>>undefinedLast (in category 'converting') ----- undefinedLast "apply on the original" + ^baseSortFunction undefinedFirst reversed! - ^collator undefinedLast toggleDirection! Item was changed: Object subclass: #SortFunction + instanceVariableNames: '' + classVariableNames: 'Default' - instanceVariableNames: 'collator' - classVariableNames: '' poolDictionaries: '' + category: 'Collections-SortFunctions'! - category: 'Collections-Support'! !SortFunction commentStamp: 'nice 11/5/2017 22:52' prior: 0! I am intended to be used in place of two arg sort blocks. Usage In the following example, an ascending SortFunction is created based on the result of the #first message send to each object. #(#(1 2) #(2 3) #(0 0)) sorted: #first ascending. To sort by the #last element, but descending, the following would be used: #(#(1 2) #(2 3) #(0 0)) sorted: #last descending. One can use blocks as well. The following sorts in descending order, the sub elements based on the sum of their values. | sumBlock | sumBlock := [:sequence | sequence inject: 0 into: [:sum :each | sum + each]]. #(#(1 2) #(2 3) #(0 0)) sorted: sumBlock descending. One can even use 2 arg blocks, for those cases where the function isn't expressible with objects that respond to < and =. The only catch, is that such a function has to return not true and false, but instead a collation order, values of -1 (for before), 0 (the same) or 1 (to follow). For example: | oddBlock | oddBlock := [:a :b | a odd = b odd ifTrue: [0] ifFalse: [a odd ifTrue: [-1] ifFalse: [1]]]. #(1 5 1 3 2 7 9 4 6) asSortedCollection: oddBlock descending Instance Variables collator <SortFunction> This is the object responsible for collating objetcs, generally a SortFunction. ! Item was added: + ----- Method: SortFunction class>>default (in category 'accessing') ----- + default + ^Default! Item was changed: ----- Method: SortFunction>>, (in category 'converting') ----- , aSortFunction "Return a new SortFunction which is the concatenation of aSortFunction to me, I will be the primary sort, but if I compare equal, I will defer to the argument." + ^ChainedSortFunction startWith: self then: aSortFunction asSortFunction! - ^(ChainedSortFunction new) - collator: self; - next: aSortFunction asSortFunction! Item was removed: - ----- Method: SortFunction>>collator: (in category 'initailize-release') ----- - collator: aSortFunction - "Used by subclasses for composition." - - collator := aSortFunction! Item was removed: - ----- Method: SortFunction>>initialize (in category 'initailize-release') ----- - initialize - "set the default collator" - - collator := DefaultSortFunction new! Item was added: + ----- Method: SortFunction>>reversed (in category 'converting') ----- + reversed + "Return new sort function with reverse sort order." + + ^ReverseSortFunction on: self! Item was removed: - ----- Method: SortFunction>>toggleDirection (in category 'converting') ----- - toggleDirection - ^ReverseSortFunction new collator: self! Item was changed: ----- Method: SortFunction>>undefinedFirst (in category 'converting') ----- undefinedFirst + "Return a new SortFunction that sort all the nil first, an non nil with myself." + ^(UndefinedSortFunction on: self) undefinedFirst! - ^(UndefinedSortFunction new collator: self) undefinedFirst! Item was changed: ----- Method: SortFunction>>undefinedLast (in category 'converting') ----- undefinedLast + "Return a new SortFunction that sort all the nil last, an non nil with myself." + ^(UndefinedSortFunction on: self) undefinedLast! - ^(UndefinedSortFunction new collator: self) undefinedLast! Item was changed: + ----- Method: Symbol>>asSortFunction (in category '*Collections-SortFunctions-converting') ----- - ----- Method: Symbol>>asSortFunction (in category 'sorting') ----- asSortFunction + "Return a SortFunction around the receiver, where the receiver will be used as a unary message to send to both a and b during sorting, and then the result of said send will be collated in ascending order using the <=> method." + "#('abc' 'de' 'fghi') sorted: #size ascending >>> #('de' 'abc' 'fghi')" + ^PropertySortFunction property: self! - ^self ascending! Item was changed: + ----- Method: Symbol>>ascending (in category '*Collections-SortFunctions-converting') ----- - ----- Method: Symbol>>ascending (in category 'sorting') ----- ascending "Return a SortFunction around the receiver, where the receiver will be used as a unary message to send to both a and b during sorting, and then the result of said send will be collated in ascending order using the <=> method." + "#('abc' 'de' 'fghi') sorted: #size ascending >>> #('de' 'abc' 'fghi')" - "Example: #('abc' 'de' 'fghi') sorted: #size asscending" + ^self asSortFunction ! - ^PropertySortFunction property: self! Item was added: + ----- Method: Symbol>>collatedBy: (in category '*Collections-SortFunctions-converting') ----- + collatedBy: aSortFunction + "Return a SortFunction around the receiver, where the receiver will be used as a unary message to send to both a and b during sorting, and then the result of said send will be collated iusing aSortFunction." + "#('abc' 'de' 'fghi') sorted: (#size collatedWith: [:e|e bitAnd: 1]) , #size >>> #( 'de' 'fghi' 'abc')" + + ^PropertySortFunction property: self collatedWith: aSortFunction asSortFunction! Item was changed: + ----- Method: Symbol>>descending (in category '*Collections-SortFunctions-converting') ----- - ----- Method: Symbol>>descending (in category 'sorting') ----- descending "Return a SortFunction around the receiver, where the receiver will be used as a unary message to send to both a and b during sorting, and then the result of said send will be collated in descending order using the <=> method." + "#('abc' 'de' 'fghi') sorted: #size ascending >>> #('fghi' 'abc' 'de')" - "Example: #('abc' 'de' 'fghi') sorted: #size descending" + ^self asSortFunction reversed! - ^(PropertySortFunction property: self) toggleDirection! Item was removed: - ----- Method: Symbol>>sortedWith: (in category 'sorting') ----- - sortedWith: aSortFunction - "Return a SortFunction around the receiver, where the receiver will be used as a unary message to send to both a and b during sorting, and then the result of said send will be collated in descending order using the aSortFunction." - "Example: #('abc' 'de' 'fghi') sorted: (#size collatedBy: #<=> asSortFunction)" - - ^PropertySortFunction property: self sortedWith: aSortFunction asSortFunction! Item was changed: + ComposedSortFunction subclass: #UndefinedSortFunction - SortFunction subclass: #UndefinedSortFunction instanceVariableNames: 'direction' classVariableNames: '' poolDictionaries: '' + category: 'Collections-SortFunctions'! - category: 'Collections-Support'! + !UndefinedSortFunction commentStamp: 'nice 11/7/2017 22:16' prior: 0! + An UndefinedSortFunction is a specialization usefull for sorting undefined objects (nil), either first or last according to direction. + The non nil objects are sorted according to the baseSortFunction defined in superclass. - !UndefinedSortFunction commentStamp: 'nice 11/5/2017 23:18' prior: 0! - An UndefinedSortFunction is a specialization of SortFunction for sorting UndefinedObject either first or last. + instance variables: + direction <Integer> -1 for sorting nil first, 1 for sorting nil last! - Instance Variables - collator <SortFunction> the SortFunction to be used for non nil values - direction: <Integer> -1 if nil is sorted first, 1 if sorted last - ! Item was added: + ----- Method: UndefinedSortFunction>>= (in category 'comparing') ----- + = anObject + "Answer whether the receiver and anObject represent the same object." + + self == anObject + ifTrue: [ ^ true ]. + self class = anObject class + ifFalse: [ ^ false ]. + ^ baseSortFunction = anObject baseSortFunction + and: [ direction = anObject direction ]! Item was changed: ----- Method: UndefinedSortFunction>>collate:with: (in category 'evaluating') ----- + collate: anObject with: another + "Answer the collation order of anObject and another, with nil first or last according to direction" + anObject ifNil: [^another ifNil: [0] ifNotNil: [direction]]. + another ifNil: [^direction negated]. + ^baseSortFunction collate: anObject with: another! - collate: value1 with: value2 - value1 ifNil: [^value2 ifNil: [0] ifNotNil: [direction]]. - value2 ifNil: [^direction negated]. - ^collator collate: value1 with: value2! Item was added: + ----- Method: UndefinedSortFunction>>direction (in category 'accessing') ----- + direction + ^direction! Item was added: + ----- Method: UndefinedSortFunction>>hash (in category 'comparing') ----- + hash + "Answer an integer value that is related to the identity of the receiver." + + ^ super hash bitXor: direction hash!

1 0

The Trunk: Collections-nice.766.mcz
by commits＠source.squeak.org 26 Nov '17

26 Nov '17

Nicolas Cellier uploaded a new version of Collections to project The Trunk: http://source.squeak.org/trunk/Collections-nice.766.mcz ==================== Summary ==================== Name: Collections-nice.766 Author: nice Time: 5 November 2017, 11:52:17.600192 pm UUID: 0008f12f-55e5-4c73-abcd-0e082a6013d1 Ancestors: Collections-bp.765 Revisit the SortFunction in the spirit of refactorings started by Denis Kudriashov in Pharo, but pushing them further. SortFunction are by nature composable. So make SortFunction abstract, and add different subclasses for different kind of composition. Add the ability of sorting by properties with an odd collator rather than default <=>, which was missing in original implementation Also add the ability to sort undefinedFirst as proposed by Denis. Reversing the direction is now implemented with a subclass. And the main SortFunction message is now collate:with: which must answer the collation order (-1,0,1). =============== Diff against Collections-bp.765 =============== Item was changed: ----- Method: BlockClosure>>ascending (in category '*Collections-Support-sorting') ----- ascending "Return a SortFunction around the receiver. If the receiver is a 2 arg block, it is assumed it will do the collation directly itself, returning -1, 0, or 1. If the receiver is a one arg block, it will be evaluated for each a and b and of the sort input, and the result of sending <=> to those will be used." + self numArgs = 1 ifTrue: [^PropertySortFunction property: self]. + self numArgs = 2 ifTrue: [^CollatorBlockFunction new collator: self]. + self error: 'a block for sorting should have 1 or 2 parameters'! - | function | - function := SortFunction ascend. - self numArgs = 1 ifTrue: [function monadicBlock: self]. - self numArgs = 2 ifTrue: [function collator: self]. - ^function! Item was added: + ----- Method: BlockClosure>>sortedWith: (in category '*Collections-Support-sorting') ----- + sortedWith: aSortFunction + "Return a SortFunction around the receiver. + The receiver is a one arg block. + It will be evaluated for each a and b and of the sort input, and answer the result of collating those with aSortFunction." + + self numArgs = 1 ifTrue: [^PropertySortFunction property: self sortedWith: aSortFunction asSortFunction]. + self error: 'a block for sorting should have 1 or 2 parameters'! Item was changed: SortFunction subclass: #ChainedSortFunction instanceVariableNames: 'next' classVariableNames: '' poolDictionaries: '' category: 'Collections-Support'! + !ChainedSortFunction commentStamp: 'nice 11/5/2017 22:35' prior: 0! - !ChainedSortFunction commentStamp: 'nice 3/13/2014 22:25' prior: 0! I add to my parent the idea of a "next" function to use when two objects are equal by my particular collator. Usage SortFunctions can be chained together in primary, secondary, tertiary, etc order using the comma method. Consider a sequence of customer objects, where each customer object responds to the messages firstName, lastName, and age. If we want to sort them lastName first, then firstName, and finally oldest first, we would use an expression like: customers sort: #lastName ascending, #firstName ascending, #age descending As noted in my super's comment, unary symbols or single arg blocks can be used. One can omit the the ascending methods on arguments (not the receiver), it will default blocks or symbols to be ascending if none is specified. In other words, the above expression could be simplified slightly as customers sort: #lastName ascending, #firstName, #age descending (note the missing ascending on the #firstName argument) Instance Variables + collator <SortFunction> the first SortFunction. + next <SortFunction> the next SortFunction to evaluate in the event the first results in equal values. - next <SortFunction> the next SortFunction to evaluate in the event my evaluator results in equal values. ! Item was changed: ----- Method: ChainedSortFunction>>, (in category 'converting') ----- , aSortFunction + ^self copy next: next , aSortFunction! - self next: next , aSortFunction! Item was added: + ----- Method: ChainedSortFunction>>collate:with: (in category 'evaluating') ----- + collate: anObject with: bObject + "Refinement of the parent behavior. If the result of my collator is 0, then pass on to the next variable to work it out." + + | result | + result := (collator collate: anObject with: bObject). + ^result isZero + ifTrue: [next collate: anObject with: bObject] + ifFalse: [result]! Item was removed: - ----- Method: ChainedSortFunction>>value:value: (in category 'evaluating') ----- - value: anObject value: bObject - "Refinement of the parent behavior. If the result of my collator is 0, then pass on to the next variable to work it out." - - | result | - result := (collator value: anObject value: bObject) * direction. - ^result isZero - ifTrue: [next value: anObject value: bObject] - ifFalse: [result < 0]! Item was added: + SortFunction subclass: #CollatorBlockFunction + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Collections-Support'! + + !CollatorBlockFunction commentStamp: 'nice 11/5/2017 22:57' prior: 0! + A CollatorBlockFunction is a special SortFunction using a dyadic block to collate objects. + + Instance Variables + + collator <Block> a dyadic block that must return a -1, 0, or 1.! Item was added: + ----- Method: CollatorBlockFunction>>collate:with: (in category 'evaluating') ----- + collate: value1 with: value2 + ^collator value: value1 value: value2! Item was removed: - ----- Method: Collection>>median (in category 'math functions') ----- - median - ^ self asSortedCollection median! Item was added: + SortFunction subclass: #DefaultSortFunction + instanceVariableNames: '' + classVariableNames: 'UniqueInstance' + poolDictionaries: '' + category: 'Collections-Support'! + + !DefaultSortFunction commentStamp: 'nice 11/5/2017 21:45' prior: 0! + A DefaultSortFunction is a collator using the default <=> operator. + It is known to work on String and Magnitude. + + ! Item was added: + ----- Method: DefaultSortFunction class>>new (in category 'instance creation') ----- + new + ^UniqueInstance ifNil: [self basicNew initialize]! Item was added: + ----- Method: DefaultSortFunction>>collate:with: (in category 'evaluating') ----- + collate: value1 with: value2 + ^value1 <=> value2! Item was added: + ----- Method: DefaultSortFunction>>initialize (in category 'initailize-release') ----- + initialize + collator := #<=>! Item was added: + SortFunction subclass: #PropertySortFunction + instanceVariableNames: 'property' + classVariableNames: '' + poolDictionaries: '' + category: 'Collections-Support'! + + !PropertySortFunction commentStamp: 'nice 11/5/2017 22:36' prior: 0! + A PropertySortFunction is a SortFunction for sorting by a specific property. + + Instance Variables + collator <SortFunction> the SortFunction to be used for sorting the properties + property <Symbol | Block> a valuable returning the value of property for objects to be sorted! Item was added: + ----- Method: PropertySortFunction class>>property: (in category 'instance creation') ----- + property: aValuable + ^self new property: aValuable! Item was added: + ----- Method: PropertySortFunction class>>property:sortedWith: (in category 'instance creation') ----- + property: aValuable sortedWith: aSortFunction + ^self new property: aValuable; collator: aSortFunction! Item was added: + ----- Method: PropertySortFunction>>collate:with: (in category 'evaluating') ----- + collate: value1 with: value2 + ^collator collate: (property value: value1) with: (property value: value2)! Item was added: + ----- Method: PropertySortFunction>>property: (in category 'initailize-release') ----- + property: aValuable + property := aValuable! Item was added: + ----- Method: PropertySortFunction>>undefinedFirst (in category 'converting') ----- + undefinedFirst + "apply on the property" + ^self class + property: property + sortedWith: (UndefinedSortFunction new collator: collator) undefinedFirst! Item was added: + ----- Method: PropertySortFunction>>undefinedLast (in category 'converting') ----- + undefinedLast + "apply on the property" + ^self class + property: property + sortedWith: (UndefinedSortFunction new collator: collator) undefinedLast! Item was added: + SortFunction subclass: #ReverseSortFunction + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Collections-Support'! + + !ReverseSortFunction commentStamp: 'nice 11/5/2017 22:40' prior: 0! + A ReverseSortFunction is reversing the order of original sortFunction + + Instance Variables + collator <SortFunction> the original SortFunction. + ! Item was added: + ----- Method: ReverseSortFunction>>collate:with: (in category 'evaluating') ----- + collate: value1 with: value2 + ^(collator collate: value1 with: value2) negated! Item was added: + ----- Method: ReverseSortFunction>>toggleDirection (in category 'converting') ----- + toggleDirection + ^collator! Item was added: + ----- Method: ReverseSortFunction>>undefinedFirst (in category 'converting') ----- + undefinedFirst + "apply on the original" + ^collator undefinedFirst toggleDirection! Item was added: + ----- Method: ReverseSortFunction>>undefinedLast (in category 'converting') ----- + undefinedLast + "apply on the original" + ^collator undefinedLast toggleDirection! Item was changed: Object subclass: #SortFunction + instanceVariableNames: 'collator' - instanceVariableNames: 'direction collator' classVariableNames: '' poolDictionaries: '' category: 'Collections-Support'! + !SortFunction commentStamp: 'nice 11/5/2017 22:52' prior: 0! - !SortFunction commentStamp: 'nice 3/13/2014 22:24' prior: 0! I am intended to be used in place of two arg sort blocks. Usage In the following example, an ascending SortFunction is created based on the result of the #first message send to each object. #(#(1 2) #(2 3) #(0 0)) sorted: #first ascending. To sort by the #last element, but descending, the following would be used: #(#(1 2) #(2 3) #(0 0)) sorted: #last descending. One can use blocks as well. The following sorts in descending order, the sub elements based on the sum of their values. | sumBlock | sumBlock := [:sequence | sequence inject: 0 into: [:sum :each | sum + each]]. #(#(1 2) #(2 3) #(0 0)) sorted: sumBlock descending. One can even use 2 arg blocks, for those cases where the function isn't expressible with objects that respond to < and =. The only catch, is that such a function has to return not true and false, but instead a collation order, values of -1 (for before), 0 (the same) or 1 (to follow). For example: | oddBlock | oddBlock := [:a :b | a odd = b odd ifTrue: [0] ifFalse: [a odd ifTrue: [-1] ifFalse: [1]]]. #(1 5 1 3 2 7 9 4 6) asSortedCollection: oddBlock descending Instance Variables + collator <SortFunction> This is the object responsible for collating objetcs, generally a SortFunction. - collator <BlockClosure> This is the collation function that must return a -1, 0, or 1. It is usually composed by an initialization method such as sendMessage: or monadicBlock:, but may be set directly. - direction <SmallInteger> 1 for ascending, -1 for descending ! Item was removed: - ----- Method: SortFunction class>>ascend (in category 'instance creation') ----- - ascend - - ^self new ascend! Item was removed: - ----- Method: SortFunction class>>descend (in category 'instance creation') ----- - descend - - ^self new descend! Item was changed: ----- Method: SortFunction>>, (in category 'converting') ----- , aSortFunction "Return a new SortFunction which is the concatenation of aSortFunction to me, I will be the primary sort, but if I compare equal, I will defer to the argument." ^(ChainedSortFunction new) + collator: self; - collator: collator; - direction: direction; next: aSortFunction asSortFunction! Item was removed: - ----- Method: SortFunction>>ascend (in category 'initailize-release') ----- - ascend - - direction := 1! Item was added: + ----- Method: SortFunction>>collate:with: (in category 'evaluating') ----- + collate: value1 with: value2 + "answer the collation order for the two values -1,0 or 1" + + ^self subclassResponsibility! Item was changed: ----- Method: SortFunction>>collator: (in category 'initailize-release') ----- + collator: aSortFunction + "Used by subclasses for composition." - collator: a2ArgBlock - "a2ArgBlock MUST return the collation order, -1, 0, or 1" + collator := aSortFunction! - collator := a2ArgBlock! Item was removed: - ----- Method: SortFunction>>descend (in category 'initailize-release') ----- - descend - - direction := -1! Item was removed: - ----- Method: SortFunction>>direction: (in category 'initailize-release') ----- - direction: anInteger - - direction := anInteger! Item was added: + ----- Method: SortFunction>>initialize (in category 'initailize-release') ----- + initialize + "set the default collator" + + collator := DefaultSortFunction new! Item was removed: - ----- Method: SortFunction>>isAscending (in category 'testing') ----- - isAscending - - ^direction = 1! Item was removed: - ----- Method: SortFunction>>isDescending (in category 'testing') ----- - isDescending - - ^direction = -1! Item was removed: - ----- Method: SortFunction>>monadicBlock: (in category 'initailize-release') ----- - monadicBlock: aSingleArgBlock - "Initialze the receiver's collation block to compare the results of evaluating aSingleArgBlock with each argument, and then collate the return values with the <=> method." - - collator := [:a :b | (aSingleArgBlock value: a) <=> (aSingleArgBlock value: b)]! Item was removed: - ----- Method: SortFunction>>sendMessage: (in category 'initailize-release') ----- - sendMessage: aUnarySymbol - "Initialze the receiver's collation block to compare the results of sending aUnarySymbol to each argument, and then collate them with the <=> method." - - collator := [:a :b | (a perform: aUnarySymbol) <=> (b perform: aUnarySymbol)]! Item was changed: ----- Method: SortFunction>>toggleDirection (in category 'converting') ----- toggleDirection + ^ReverseSortFunction new collator: self! - "Invert my current direction, if I'm currently ascending, this will cause me to be descending now, and vice-versa." - - direction := direction * -1! Item was added: + ----- Method: SortFunction>>undefinedFirst (in category 'converting') ----- + undefinedFirst + ^(UndefinedSortFunction new collator: self) undefinedFirst! Item was added: + ----- Method: SortFunction>>undefinedLast (in category 'converting') ----- + undefinedLast + ^(UndefinedSortFunction new collator: self) undefinedLast! Item was changed: ----- Method: SortFunction>>value:value: (in category 'evaluating') ----- value: anObject value: bObject "Masquerade as a two argument block, used by many of the sorting APIs, by returning whether anObject should be placed before bObject or not." | result | + result := (self collate: anObject with: bObject). - result := (collator value: anObject value: bObject) * direction. ^result <= 0! Item was changed: ----- Method: Symbol>>ascending (in category 'sorting') ----- ascending "Return a SortFunction around the receiver, where the receiver will be used as a unary message to send to both a and b during sorting, and then the result of said send will be collated in ascending order using the <=> method." "Example: #('abc' 'de' 'fghi') sorted: #size asscending" + ^PropertySortFunction property: self! - ^SortFunction ascend sendMessage: self! Item was changed: ----- Method: Symbol>>descending (in category 'sorting') ----- descending "Return a SortFunction around the receiver, where the receiver will be used as a unary message to send to both a and b during sorting, and then the result of said send will be collated in descending order using the <=> method." "Example: #('abc' 'de' 'fghi') sorted: #size descending" + ^(PropertySortFunction property: self) toggleDirection! - ^SortFunction descend sendMessage: self! Item was added: + ----- Method: Symbol>>sortedWith: (in category 'sorting') ----- + sortedWith: aSortFunction + "Return a SortFunction around the receiver, where the receiver will be used as a unary message to send to both a and b during sorting, and then the result of said send will be collated in descending order using the aSortFunction." + "Example: #('abc' 'de' 'fghi') sorted: (#size collatedBy: #<=> asSortFunction)" + + ^PropertySortFunction property: self sortedWith: aSortFunction asSortFunction! Item was added: + SortFunction subclass: #UndefinedSortFunction + instanceVariableNames: 'direction' + classVariableNames: '' + poolDictionaries: '' + category: 'Collections-Support'! + + !UndefinedSortFunction commentStamp: 'nice 11/5/2017 23:18' prior: 0! + An UndefinedSortFunction is a specialization of SortFunction for sorting UndefinedObject either first or last. + + Instance Variables + collator <SortFunction> the SortFunction to be used for non nil values + direction: <Integer> -1 if nil is sorted first, 1 if sorted last + ! Item was added: + ----- Method: UndefinedSortFunction>>collate:with: (in category 'evaluating') ----- + collate: value1 with: value2 + value1 ifNil: [^value2 ifNil: [0] ifNotNil: [direction]]. + value2 ifNil: [^direction negated]. + ^collator collate: value1 with: value2! Item was added: + ----- Method: UndefinedSortFunction>>initialize (in category 'initailize-release') ----- + initialize + super initialize. + direction := -1! Item was added: + ----- Method: UndefinedSortFunction>>undefinedFirst (in category 'initailize-release') ----- + undefinedFirst + direction := -1! Item was added: + ----- Method: UndefinedSortFunction>>undefinedLast (in category 'initailize-release') ----- + undefinedLast + direction := 1!

1 0

The Trunk: Graphics-nice.385.mcz
by commits＠source.squeak.org 26 Nov '17

26 Nov '17

Nicolas Cellier uploaded a new version of Graphics to project The Trunk: http://source.squeak.org/trunk/Graphics-nice.385.mcz ==================== Summary ==================== Name: Graphics-nice.385 Author: nice Time: 26 November 2017, 5:01:45.616725 pm UUID: 307c6d82-1236-45e1-9a86-c8973901c9f1 Ancestors: Graphics-dtl.384 Fix bad inference of variable type in MiscPrimitivePlugin =============== Diff against Graphics-dtl.384 =============== Item was changed: ----- Method: Bitmap>>decompress:fromByteArray:at: (in category 'filing') ----- decompress: bm fromByteArray: ba at: index "Decompress the body of a byteArray encoded by compressToByteArray (qv)... The format is simply a sequence of run-coded pairs, {N D}*. N is a run-length * 4 + data code. D, the data, depends on the data code... 0 skip N words, D is absent (could be used to skip from one raster line to the next) 1 N words with all 4 bytes = D (1 byte) 2 N words all = D (4 bytes) 3 N words follow in D (4N bytes) S and N are encoded as follows (see decodeIntFrom:)... 0-223 0-223 224-254 (0-30)*256 + next byte (0-7935) 255 next 4 bytes" "NOTE: If fed with garbage, this routine could read past the end of ba, but it should fail before writing past the ned of bm." | i code n anInt data end k pastEnd | <primitive: 'primitiveDecompressFromByteArray' module: 'MiscPrimitivePlugin'> + <var: #bm type: 'int *'> + <var: #ba type: 'unsigned char *'> + <var: #anInt type: 'unsigned int'> "Force the type, otherwise it is inferred as unsigned char because assigned from ba" + <var: #data type: 'unsigned int'> - <var: #bm declareC: 'int *bm'> - <var: #ba declareC: 'unsigned char *ba'> i := index. "byteArray read index" end := ba size. k := 1. "bitmap write index" pastEnd := bm size + 1. [i <= end] whileTrue: ["Decode next run start N" anInt := ba at: i. i := i+1. anInt <= 223 ifFalse: [anInt <= 254 ifTrue: [anInt := (anInt-224)*256 + (ba at: i). i := i+1] ifFalse: [anInt := 0. 1 to: 4 do: [:j | anInt := (anInt bitShift: 8) + (ba at: i). i := i+1]]]. n := anInt >> 2. (k + n) > pastEnd ifTrue: [^ self primitiveFail]. code := anInt bitAnd: 3. code = 0 ifTrue: ["skip"]. code = 1 ifTrue: ["n consecutive words of 4 bytes = the following byte" data := ba at: i. i := i+1. data := data bitOr: (data bitShift: 8). data := data bitOr: (data bitShift: 16). 1 to: n do: [:j | bm at: k put: data. k := k+1]]. code = 2 ifTrue: ["n consecutive words = 4 following bytes" data := 0. 1 to: 4 do: [:j | data := (data bitShift: 8) bitOr: (ba at: i). i := i+1]. 1 to: n do: [:j | bm at: k put: data. k := k+1]]. code = 3 ifTrue: ["n consecutive words from the data..." 1 to: n do: [:m | data := 0. 1 to: 4 do: [:j | data := (data bitShift: 8) bitOr: (ba at: i). i := i+1]. bm at: k put: data. k := k+1]]]!

1 0

Why would (Unix)FileDirectory class>>#checkName:fixErrors: mangle a correctly formatted file path/name?
by tim Rowledge 26 Nov '17

26 Nov '17

At least, UnixFileDirectory seems to - '/home/pi/Squeak/Senders of printPSToFileNamed:.ps’ asFileName results in '#home#pi#Squeak#Senders of printPSToFileNamed:.ps’, which seems very odd. Surely if you have a string that is a correct filename returned by some other code that carefully makes such, then #asFileName etc ought to return the same (or even the original) string? tim -- tim Rowledge; tim(a)rowledge.org; http://www.rowledge.org/tim If you never try anything new, you'll miss out on many of life's great disappointments

2 3

The Inbox: EToys-dtl.314.mcz
by commits＠source.squeak.org 25 Nov '17

25 Nov '17

David T. Lewis uploaded a new version of EToys to project The Inbox: http://source.squeak.org/inbox/EToys-dtl.314.mcz ==================== Summary ==================== Name: EToys-dtl.314 Author: dtl Time: 25 November 2017, 12:18:54.339694 pm UUID: 5d8ae2a6-a8d1-4c96-acc8-69ef66a4aa81 Ancestors: EToys-dtl.313 Remove references to global World from SyntaxMorph. Note: #asMorphicSyntaxIn: is required for SyntaxMorph but not implemented in the ParseNode hierarchy. Presumably this should be harvested from an Etoys image. =============== Diff against EToys-dtl.313 =============== Item was changed: ----- Method: SyntaxMorph>>offerTilesMenuFor:in: (in category 'menus') ----- offerTilesMenuFor: aReceiver in: aLexiconModel "Offer a menu of tiles for assignment and constants" | menu | menu := MenuMorph new addTitle: 'Hand me a tile for...'. menu addLine. menu add: '(accept method now)' target: aLexiconModel selector: #acceptTiles. menu submorphs last color: Color red darker. menu addLine. menu add: 'me, by name' target: self selector: #attachTileForCode:nodeType: argumentList: {'<me by name>'. aReceiver}. menu add: 'self' target: self selector: #attachTileForCode:nodeType: argumentList: {'self'. VariableNode}. menu add: '_ (assignment)' target: self selector: #attachTileForCode:nodeType: argumentList: {'<assignment>'. nil}. menu add: '"a Comment"' target: self selector: #attachTileForCode:nodeType: argumentList: {'"a comment"\' withCRs. CommentNode}. menu submorphs last color: Color blue. menu add: 'a Number' target: self selector: #attachTileForCode:nodeType: argumentList: {'5'. LiteralNode}. menu add: 'a Character' target: self selector: #attachTileForCode:nodeType: argumentList: {'$z'. LiteralNode}. menu add: '''abc''' target: self selector: #attachTileForCode:nodeType: argumentList: {'''abc'''. LiteralNode}. menu add: 'a Symbol constant' target: self selector: #attachTileForCode:nodeType: argumentList: {'#next'. LiteralNode}. menu add: 'true' target: self selector: #attachTileForCode:nodeType: argumentList: {'true'. VariableNode}. menu add: 'a Test' target: self selector: #attachTileForCode:nodeType: argumentList: {'true ifTrue: [self] ifFalse: [self]'. MessageNode}. menu add: 'a Loop' target: self selector: #attachTileForCode:nodeType: argumentList: {'1 to: 10 do: [:index | self]'. MessageNode}. menu add: 'a Block' target: self selector: #attachTileForCode:nodeType: argumentList: {'[self]'. BlockNode}. menu add: 'a Class or Global' target: self selector: #attachTileForCode:nodeType: argumentList: {'Character'. LiteralVariableNode}. menu add: 'a Reply' target: self selector: #attachTileForCode:nodeType: argumentList: {'| temp | temp'. ReturnNode}. + menu popUpAt: ActiveHand position forHand: ActiveHand in: self world. - menu popUpAt: ActiveHand position forHand: ActiveHand in: World. ! Item was changed: ----- Method: SyntaxMorph>>offerVarsMenuFor:in: (in category 'menus') ----- offerVarsMenuFor: aReceiver in: aLexiconModel "Offer a menu of tiles for assignment and constants" | menu instVarList cls | menu := MenuMorph new addTitle: 'Hand me a tile for...'. menu addLine. menu add: '(accept method now)' target: aLexiconModel selector: #acceptTiles. menu submorphs last color: Color red darker. menu addLine. menu add: 'new temp variable' target: self selector: #attachTileForCode:nodeType: argumentList: {'| temp | temp'. TempVariableNode}. instVarList := OrderedCollection new. cls := aReceiver class. [instVarList addAllFirst: cls instVarNames. cls == aLexiconModel limitClass] whileFalse: [cls := cls superclass]. instVarList do: [:nn | menu add: nn target: self selector: #instVarTile: argument: nn]. + menu popUpAt: ActiveHand position forHand: ActiveHand in: self world. - menu popUpAt: ActiveHand position forHand: ActiveHand in: World. ! Item was changed: ----- Method: SyntaxMorph>>showMenu: (in category 'menus') ----- showMenu: evt | menu | menu := MenuMorph new. self rootTile isMethodNode ifTrue: [menu add: 'accept method' target: self selector: #accept. menu addLine. menu add: 'new temp variable' target: self selector: #attachTileForCode:nodeType: argumentList: {'| temp | temp'. TempVariableNode}. menu addLine. self parsedInClass allInstVarNames do: [:nn | menu add: nn,' tile' target: self selector: #instVarTile: argument: nn]. menu addLine. menu add: 'show code' target: self selector: #showCode. menu add: 'try out' target: self selector: #try. + menu popUpAt: evt hand position forHand: evt hand in: self world]. - menu popUpAt: evt hand position forHand: evt hand in: World]. !

1 0

The Inbox: EToys-dtl.313.mcz
by commits＠source.squeak.org 25 Nov '17

25 Nov '17

David T. Lewis uploaded a new version of EToys to project The Inbox: http://source.squeak.org/inbox/EToys-dtl.313.mcz ==================== Summary ==================== Name: EToys-dtl.313 Author: dtl Time: 25 November 2017, 9:54:37.052975 am UUID: af30c57e-305f-4ee3-bf9a-c8e8e46c8b3f Ancestors: EToys-bp.312 Remove most direct references to global World for Etoys. Still to be done: Remove the World references in SyntaxMorph and WiWPasteUpMorph. =============== Diff against EToys-bp.312 =============== Item was changed: ----- Method: DisplayScreen class>>restoreDisplay (in category '*Etoys-Squeakland-screen modes') ----- restoreDisplay "Clear the screen to gray and then redisplay all the scheduled views." + Smalltalk isMorphic ifTrue: [^ Project current world restoreMorphicDisplay]. - Smalltalk isMorphic ifTrue: [^ World restoreMorphicDisplay]. Display extent = DisplayScreen actualScreenSize ifFalse: [DisplayScreen startUp. ScheduledControllers unCacheWindows]. ScheduledControllers restore! Item was changed: ----- Method: EToysLauncher>>onEnterWorld (in category 'event handling') ----- onEnterWorld (owner notNil + and: [Project current world == owner]) - and: [World == owner]) ifTrue: [owner addMorphInLayer: self. self updatePane] + ifFalse: [Project current world removeActionsWithReceiver: self]! - ifFalse: [World removeActionsWithReceiver: self]! Item was changed: ----- Method: EtoysDebugger>>highlight: (in category 'highlighting') ----- highlight: aMorph "| rect | rect := BorderedMorph newBounds: aMorph bounds color: Color transparent. rect openInWorld. + Project current world addAlarm: #delete - World addAlarm: #delete withArguments: #() for: rect at: (Time millisecondClockValue + 200)." highlighter ifNotNil: [highlighter delete]. highlighter := HighlightMorph on: aMorph. highlighter openInWorld! Item was changed: ----- Method: EtoysDebugger>>trailMorph (in category 'accessing') ----- trailMorph + ^ self scriptedPlayer costume ifNil: [Project current world] ifNotNil: [:m | m trailMorph]! - ^ self scriptedPlayer costume ifNil: [World] ifNotNil: [:m | m trailMorph]! Item was changed: ----- Method: FileList2 class>>findAProjectSimple (in category '*Etoys-Squeakland-blue ui') ----- findAProjectSimple "self findAProjectSimple" ^ self + morphicViewProjectLoader2InWorld: Project current world - morphicViewProjectLoader2InWorld: World reallyLoad: true dirFilterType: #limitedSuperSwikiDirectoryList! Item was changed: ----- Method: HTTPProxyEditor class>>activateWindow: (in category 'instance creation') ----- activateWindow: aWindow "private - activate the window" + | world | + world := Project current world. aWindow + right: (aWindow right min: world bounds right); + bottom: (aWindow bottom min: world bounds bottom); + left: (aWindow left max: world bounds left); + top: (aWindow top max: world bounds top). + aWindow comeToFront; flash! - right: (aWindow right min: World bounds right). - aWindow - bottom: (aWindow bottom min: World bounds bottom). - aWindow - left: (aWindow left max: World bounds left). - aWindow - top: (aWindow top max: World bounds top). - "" - aWindow comeToFront. - aWindow flash! Item was changed: ----- Method: HTTPProxyEditor class>>open (in category 'instance creation') ----- open "open the receiver" + Project current world submorphs + do: [:each | (each isKindOf: self) + ifTrue: [self activateWindow: each. - World submorphs - do: [:each | "" - ((each isKindOf: self) - ) - ifTrue: ["" - self activateWindow: each. ^ self]]. - "" ^ self new openInWorld! Item was changed: ----- Method: KedamaMorph>>initialize (in category 'initialization') ----- initialize super initialize. drawRequested := true. changePending := false. + pixelsPerPatch := (Project current world width min: Project current world height) + // (self class defaultDimensions x * 2). "heuristic..." - pixelsPerPatch := (World width min: World height) // (self class defaultDimensions x * 2). "heuristic..." self dimensions: self class defaultDimensions. "dimensions of this StarSqueak world in patches" super extent: dimensions * pixelsPerPatch. self assuredPlayer assureUniClass. self clearAll. "be sure this is done once in case setup fails to do it" autoChanged := true. self leftEdgeMode: #wrap. self rightEdgeMode: #wrap. self topEdgeMode: #wrap. self bottomEdgeMode: #wrap. turtlesDictSemaphore := Semaphore forMutualExclusion. ! Item was changed: ----- Method: Morph>>asWearableCostume (in category '*Etoys-support') ----- asWearableCostume "Return a wearable costume for some player" + ^(Project current world drawingClass withForm: self imageForm) copyCostumeStateFrom: self! - ^(World drawingClass withForm: self imageForm) copyCostumeStateFrom: self! Item was changed: ----- Method: Morph>>showDesignationsOfObjects (in category '*Etoys-card in a stack') ----- showDesignationsOfObjects "Momentarily show the designations of objects on the receiver" | colorToUse | self isStackBackground ifFalse: [^self]. self submorphsDo: [:aMorph | | aLabel | aLabel :=aMorph renderedMorph holdsSeparateDataForEachInstance ifTrue: [colorToUse := Color orange. aMorph externalName] ifFalse: [colorToUse := aMorph isShared ifFalse: [Color red] ifTrue: [Color green]. nil]. Display border: (aMorph fullBoundsInWorld insetBy: -6) width: 6 rule: Form over fillColor: colorToUse. aLabel ifNotNil: [aLabel asString displayOn: Display at: aMorph fullBoundsInWorld bottomLeft + (0 @ 5) textColor: Color blue]]. Sensor anyButtonPressed ifTrue: [Sensor waitNoButton] ifFalse: [Sensor waitButton]. + self world fullRepaintNeeded! - World fullRepaintNeeded! Item was changed: ----- Method: MovingEyeMorph>>step (in category 'stepping and presenter') ----- step | cp | + cp := self globalPointToLocal: self world primaryHand position. - cp := self globalPointToLocal: World primaryHand position. (inner containsPoint: cp) ifTrue: [iris position: (cp - (iris extent // 2))] ifFalse: [self irisPos: cp]. self changed "cover up gribblies if embedded in Flash"! Item was changed: ----- Method: OLPCVirtualScreen>>checkForNewScreenSize (in category 'display') ----- checkForNewScreenSize | aPoint | aPoint := DisplayScreen actualScreenSize. aPoint = display extent ifTrue:[^nil]. display setExtent: aPoint depth: depth. display fillColor: (Color gray: 0.2). self setupWarp; forceToScreen. display forceToScreen. "to capture the borders" + Project current world restoreMorphicDisplay. + Project current world repositionFlapsAfterScreenSizeChange.! - World restoreMorphicDisplay. - World repositionFlapsAfterScreenSizeChange.! Item was changed: ----- Method: OLPCVirtualScreen>>zoomOut: (in category 'display') ----- zoomOut: aBoolean "When the physical display is bigger than the virtual display size, we have two options. One is to zoom in and maximize the visible area and another is to map a pixel to a pixel and show it in smaller area (at the center of screen). This flag governs them." self canZoomOut ifFalse: [^ self]. zoomOut := aBoolean. display fillColor: (Color gray: 0.2). self setupWarp; forceToScreen. display forceToScreen. "to capture the borders" + Project current world restoreMorphicDisplay. + Project current world repositionFlapsAfterScreenSizeChange. - World restoreMorphicDisplay. - World repositionFlapsAfterScreenSizeChange. ! Item was changed: ----- Method: Player>>grabPatchMorph (in category 'slot-kedama') ----- grabPatchMorph + Project current world primaryHand attachMorph: costume renderedMorph. - World primaryHand attachMorph: costume renderedMorph. ! Item was changed: ----- Method: Project class>>interruptName:preemptedProcess: (in category '*Etoys-Squeakland-utilities') ----- interruptName: labelString preemptedProcess: theInterruptedProcess "Create a Notifier on the active scheduling process with the given label." | preemptedProcess projectProcess | Smalltalk isMorphic ifFalse: [^ ScheduledControllers interruptName: labelString]. ActiveHand ifNotNil:[ActiveHand interrupted]. + ActiveWorld := Project current world. "reinstall active globals" + ActiveHand := ActiveWorld primaryHand. - ActiveWorld := World. "reinstall active globals" - ActiveHand := World primaryHand. ActiveHand interrupted. "make sure this one's interrupted too" ActiveEvent := nil. projectProcess := self uiProcess. "we still need the accessor for a while" preemptedProcess := theInterruptedProcess ifNil: [Processor preemptedProcess]. "Only debug preempted process if its priority is >= projectProcess' priority" preemptedProcess priority < projectProcess priority ifTrue:[preemptedProcess := projectProcess]. preemptedProcess suspend. Debugger openInterrupt: labelString onProcess: preemptedProcess ! Item was changed: ----- Method: ProjectLoading class>>loadSexpProjectDict:stream:fromDirectory:withProjectView: (in category '*etoys') ----- loadSexpProjectDict: dict stream: preStream fromDirectory: aDirectoryOrNil withProjectView: existingView | archive anObject newProj d member memberStream members newSet allNames realName oldSet s | (self checkStream: preStream) ifTrue: [^ nil]. ProgressNotification signal: '0.2'. preStream reset. archive := preStream isZipArchive ifTrue:[ZipArchive new readFrom: preStream] ifFalse:[nil]. members := archive membersMatching: '*.cs'. members do: [:e | newSet := ChangeSorter newChangesFromStream: e contentStream named: 'zzTemp', Time totalSeconds printString]. member := (archive membersMatching: '*.sexp') first. memberStream := member contentStream. (self checkSecurity: member name preStream: preStream projStream: memberStream) ifFalse: [^nil]. self flag: #tfel. "load all projects and save them again in the new format, then get rid of the error block!!" s := memberStream basicUpToEnd. d := [(DataStream on: memberStream) next] on: Error do: [:e | (Smalltalk at: #MSExpParser) parse: s with: #ksexp]. anObject := d sissReadObjectsAsEtoysProject. preStream close. "anObject := (MSExpParser parse: (archive membersMatching: '*.sexp') first contents with: #ksexp) sissReadObjects." anObject ifNil: [^ nil]. + (anObject isKindOf: PasteUpMorph) ifFalse: [^ Project current world addMorph: anObject]. - (anObject isKindOf: PasteUpMorph) ifFalse: [^ World addMorph: anObject]. ProgressNotification signal: '0.7'. newProj := MorphicProject new. newProj installPasteUpAsWorld: anObject. newSet ifNotNil: [oldSet := newProj changeSet. newProj setChangeSet: newSet. ChangeSorter removeChangeSet: oldSet]. dict at: 'projectname' ifPresent: [:n | allNames := Project allNames. realName := Utilities keyLike: n satisfying: [:nn | (allNames includes: nn) not]. newProj renameTo: realName. ]. anObject valueOfProperty: #projectVersion ifPresentDo: [:v | newProj version: v]. newProj noteManifestDetailsIn: dict. ProgressNotification signal: '0.8'. ^ newProj.! Item was changed: ----- Method: ScrollableField>>spawn: (in category '*Etoys-Squeakland-as yet unclassified') ----- spawn: aByteString "Hack to open the object catalog when Cmd-O is pressed" self setMyText: aByteString. + (Project current world commandKeySelectors at: $o) value. - (World commandKeySelectors at: $o) value. ! Item was changed: ----- Method: SketchMorph>>asWearableCostume (in category '*Etoys-e-toy support') ----- asWearableCostume "Return a wearable costume for some player" + ^(Project current world drawingClass withForm: originalForm) copyCostumeStateFrom: self! - ^(World drawingClass withForm: originalForm) copyCostumeStateFrom: self! Item was changed: ----- Method: StandardScriptingSystem>>benchmarkCategory (in category '*Etoys-Squeakland-benchmarks') ----- benchmarkCategory "ScriptingSystem benchmarkCategory" + | m v result world | + world := Project current world. - | m v result | m := Morph new openInWorld. m openViewerForArgument. + world doOneCycle. - World doOneCycle. v := m player allOpenViewers first submorphs last. result := [v chosenCategorySymbol: #geometry. + world doOneCycle] timeToRun. - World doOneCycle] timeToRun. m delete. + world doOneCycle. - World doOneCycle. ^ result! Item was changed: ----- Method: StandardScriptingSystem>>benchmarkPainter (in category '*Etoys-Squeakland-benchmarks') ----- benchmarkPainter "ScriptingSystem benchmarkPainter" + | world result | + world := Project current world. + result := [world makeNewDrawing: nil at: 400 @ 300. + world doOneCycle] timeToRun. + (world findA: SketchEditorMorph) cancelOutOfPainting. + world doOneCycle. - | result | - result := [World makeNewDrawing: nil at: 400 @ 300. - World doOneCycle] timeToRun. - (World findA: SketchEditorMorph) cancelOutOfPainting. - World doOneCycle. ^ result! Item was changed: ----- Method: StandardScriptingSystem>>benchmarkScriptor (in category '*Etoys-Squeakland-benchmarks') ----- benchmarkScriptor "ScriptingSystem benchmarkScriptor" "(Picking up third one)" | result m | m := Morph new openInWorld. m openViewerForArgument. m player assureUniClass. m player newScriptorAround: nil. m player newScriptorAround: nil. result := [(m player newScriptorAround: nil) openInWorld. + Project current world doOneCycle] timeToRun. - World doOneCycle] timeToRun. m delete. + Project current world doOneCycle. - World doOneCycle. ^ result! Item was changed: ----- Method: StandardScriptingSystem>>benchmarkViewer (in category '*Etoys-Squeakland-benchmarks') ----- benchmarkViewer "ScriptingSystem benchmarkViewer" + | result m world | - | result m | m := Morph new openInWorld. + world := Project current world. result := [m openViewerForArgument. + world doOneCycle] timeToRun. - World doOneCycle] timeToRun. m delete. + world doOneCycle. - World doOneCycle. ^ result! Item was changed: ----- Method: SugarLauncher>>shutDown (in category 'running') ----- shutDown sharedActivity ifNotNil: [ self leaveSharedActivity. sharedActivity := nil]. Project allSubInstancesDo: [:prj | prj removeParameter: #sugarId]. ServerDirectory inImageServers keysAndValuesDo: [:srvrName :srvr | (srvr isKindOf: SugarDatastoreDirectory) ifTrue: [ ServerDirectory removeServerNamed: srvrName ifAbsent: []]]. Current := nil. + Project current world windowEventHandler: nil. - World windowEventHandler: nil. ! Item was changed: ----- Method: SugarLauncher>>startUp (in category 'running') ----- startUp self class allInstances do: [:ea | ea shutDown]. Current := self. SugarNavigatorBar current ifNotNil: [:bar | bar startUp]. parameters at: 'ACTIVITY_ID' ifPresent: [ :activityId | OLPCVirtualScreen setupIfNeeded. + Project current world windowEventHandler: self. - World windowEventHandler: self. (Smalltalk classNamed: 'DBus') ifNotNil: [:dbus | dbus sessionBus export: (Smalltalk classNamed: 'SugarEtoysActivity') new on: 'org.laptop.Activity', activityId at: '/org/laptop/Activity/', activityId]. Utilities authorName: self ownerBuddy nick. ServerDirectory addServer: (SugarDatastoreDirectory mimetype: 'application/x-squeak-project' extension: '.pr') named: SugarLauncher defaultDatastoreDirName. self joinSharedActivity. self isShared ifFalse: [ parameters at: 'OBJECT_ID' ifPresent: [:id | ^self resumeJournalEntry: id]]. self isShared ifTrue: [^self]. ^self welcome: (parameters at: 'URI' ifAbsent: [''])]. self welcome: '' ! Item was changed: ----- Method: SugarLauncher>>viewSource (in category 'commands') ----- viewSource WorldState addDeferredUIMessage: [ + Project current world showSourceKeyHit]! - World showSourceKeyHit]! Item was changed: ----- Method: SugarNavigatorBar>>putUpInitialBalloonHelp (in category 'initialization') ----- putUpInitialBalloonHelp " SugarNavigatorBar putUpInitialBalloonHelp " | suppliesButton b1 b2 p b | suppliesButton := paintButton owner submorphs detect: [:e | e isButton and: [e actionSelector = #toggleSupplies]]. b1 := BalloonMorph string: self paintButtonInitialExplanation for: paintButton corner: #topRight force: false. b2 := BalloonMorph string: self suppliesButtonInitialExplanation for: suppliesButton corner: #topLeft force: true. p := PasteUpMorph new. p clipSubmorphs: false. p color: Color transparent. p borderWidth: 0. p addMorph: b1. p addMorph: b2. + b := BalloonMorph string: p for: self world corner: #bottomLeft. - b := BalloonMorph string: p for: World corner: #bottomLeft. b color: Color transparent. b borderWidth: 0. [(Delay forSeconds: 1) wait. b popUpForHand: ActiveHand] fork. ! Item was changed: ----- Method: SugarNavigatorBar>>putUpInitialBalloonHelpFor: (in category 'initialization') ----- putUpInitialBalloonHelpFor: quads "Given a list of quads of the form <selector> <help-msg> <corner> <force-boolean> (see senders for examples), put up initial balloon help for them." " SugarNavigatorBar someInstance putUpInitialBalloonHelpFor: #((doNewPainting 'make a new painting' topRight false) (toggleSupplies 'open the supplies bin' topLeft true)) SugarNavigatorBar someInstance putUpInitialBalloonHelpFor: #((showNavBar 'show the tool bar' bottomLeft false) (hideNavBar 'hide the tool bar' bottomLeft false)) " | b1 p b | p := PasteUpMorph new. p clipSubmorphs: false. p color: Color transparent. p borderWidth: 0. quads do: [:aQuad | (submorphs first submorphs detect: [:e | e isButton and: [e actionSelector = aQuad first]] ifNone: [nil]) ifNotNil: [:aButton | b1 := BalloonMorph string: aQuad second for: aButton corner: aQuad third force: aQuad fourth. p addMorph: b1]]. + b := BalloonMorph string: p for: self world corner: #bottomLeft. - b := BalloonMorph string: p for: World corner: #bottomLeft. b color: Color transparent. b borderWidth: 0. [(Delay forSeconds: 1) wait. b popUpForHand: ActiveHand] fork. ! Item was changed: ----- Method: SugarNavigatorBar>>quitSqueak (in category 'button actions') ----- quitSqueak ^SugarLauncher isRunningInSugar ifTrue: [SugarLauncher current quit] ifFalse: [ Preferences eToyFriendly ifTrue: [super quitSqueak] ifFalse: [Smalltalk snapshot: ( UserDialogBoxMorph confirm: 'Save changes before quitting?' translated orCancel: [ ^self ] + at: self world center) - at: World center) andQuit: true]].!

2 1

The Trunk: HelpSystem-Core-bf.101.mcz
by commits＠source.squeak.org 25 Nov '17

25 Nov '17

Bert Freudenberg uploaded a new version of HelpSystem-Core to project The Trunk: http://source.squeak.org/trunk/HelpSystem-Core-bf.101.mcz ==================== Summary ==================== Name: HelpSystem-Core-bf.101 Author: bf Time: 25 November 2017, 2:01:27.559892 pm UUID: 42809126-d9c8-4cdf-8652-c878c4643ced Ancestors: HelpSystem-Core-tpr.100 Fix MNU when search term is a Text instead of a String =============== Diff against HelpSystem-Core-tpr.100 =============== Item was changed: ----- Method: HelpBrowser>>searchTerm: (in category 'searching') ----- + searchTerm: aTextOrString - searchTerm: aString "Spawn a new search topic." + | topic term | - | topic | self okToChange ifFalse: [^ self]. + term := aTextOrString asString. topic := self searchTopic subtopics + detect: [:t | t term = term] - detect: [:t | t term = aString] ifNone: [ | newTopic | newTopic := SearchTopic new + term: term; - term: aString; yourself. self searchTopic addSubtopic: newTopic. newTopic addDependent: self. "Tell me about your updates." newTopic]. "self changed: #searchTerm." "Select results and expand searches node if necessary." self currentTopicPath: {self searchTopic. topic}. self assert: self currentTopic == topic. topic topicsToSearch: self toplevelTopics allButLast; startSearch.!

1 0

← Newer
1
2
3
4
5
6
7
8
9
...
20
Older →

Jump to page: