[squeak-dev] The Trunk: System-ul.932.mcz

Eliot Miranda eliot.miranda at gmail.com
Mon Mar 13 23:41:16 UTC 2017


Hi Levente,

    the SortedCollection whack-a-mole [ :-) :-) ] update appears to have
caused a significant uptick in Squeak trunk test suite errors, from about
26 to over 80.  Are you aware of this?  Are you addressing the errors?

I was a little bit inconvenienced by this because I was testing Slang
changes to the VM and mistook these errors as evidence of bugs in my Slang
changes.  That's life and I'm happy to accept the situation.  But I would
like to see the errors come back down to around 26 or less :-)

Cheers
Eliot

On Mon, Mar 13, 2017 at 8:00 AM, <commits at source.squeak.org> wrote:

> Levente Uzonyi uploaded a new version of System to project The Trunk:
> http://source.squeak.org/trunk/System-ul.932.mcz
>
> ==================== Summary ====================
>
> Name: System-ul.932
> Author: ul
> Time: 13 March 2017, 3:10:17.453603 pm
> UUID: 7a305614-9a4b-47f8-a68f-79fcf6f90a80
> Ancestors: System-eem.931
>
> - SortedCollection Whack-a-mole
> - introduced #classVarNames and #classInstVarNames in PseudoClass, because
> they had senders
> - removed #startTimerInterruptWatcher from messages to keep lists
>
> =============== Diff against System-eem.931 ===============
>
> Item was changed:
>   ----- Method: ChangeSet class>>traitsOrder: (in category 'fileIn/Out')
> -----
>   traitsOrder: aCollection
>         "Answer an OrderedCollection. The traits
>         are ordered so they can be filed in."
>
> +       ^aCollection sorted: [:t1 :t2 |
> -       |  traits |
> -       traits := aCollection asSortedCollection: [:t1 :t2 |
>                 (t1 isBaseTrait and: [t1 classTrait == t2]) or: [
>                         (t2 traitComposition allTraits includes: t1) or: [
> +                               (t1 traitComposition allTraits includes:
> t2) not]]]!
> -                               (t1 traitComposition allTraits includes:
> t2) not]]].
> -       ^traits asArray!
>
> Item was changed:
>   ----- Method: ChangeSet>>changedMessageList (in category 'method
> changes') -----
>   changedMessageList
>         "Used by a message set browser to access the list view
> information."
>
>         | messageList |
>         messageList := OrderedCollection new.
>         changeRecords associationsDo: [:clAssoc | | classNameInParts
> classNameInFull |
>                 classNameInFull := clAssoc key asString.
>                 classNameInParts := classNameInFull findTokens: ' '.
>
>                 (clAssoc value allChangeTypes includes: #comment) ifTrue:
>                         [messageList add:
>                                 (MethodReference new
>                                         setClassSymbol: classNameInParts
> first asSymbol
>                                         classIsMeta: false
>                                         methodSymbol: #Comment
>                                         stringVersion: classNameInFull, '
> Comment')].
>
>                 clAssoc value methodChangeTypes associationsDo: [:mAssoc |
>                         (#(remove addedThenRemoved) includes: mAssoc
> value) ifFalse:
>                                 [messageList add:
>                                         (MethodReference new
>                                                 setClassSymbol:
> classNameInParts first asSymbol
>                                                 classIsMeta:
> classNameInParts size > 1
>                                                 methodSymbol: mAssoc key
>                                                 stringVersion:
> classNameInFull, ' ' , mAssoc key)]]].
> +       ^ messageList sort!
> -       ^ messageList asSortedArray!
>
> Item was changed:
>   ----- Method: ChangeSet>>checkForUncommentedClasses (in category
> 'fileIn/Out') -----
>   checkForUncommentedClasses
>         "Check to see if any classes involved in this change set do not
> have class comments.  Open up a browser showing all such classes."
>
>         | aList |
>         aList := self changedClasses
>                 select:
>                         [:aClass | aClass theNonMetaClass organization
> classComment isEmptyOrNil]
>                 thenCollect:
>                         [:aClass  | aClass theNonMetaClass name].
>
>         aList size > 0
>                 ifFalse:
>                         [^ self inform: 'All classes involved in this
> change set have class comments']
>                 ifTrue:
> +                       [ToolSet openClassListBrowser: aList asSet sorted
> title: 'Classes in Change Set ', self name, ': classes that lack class
> comments']!
> -                       [ToolSet openClassListBrowser: aList asSet
> asSortedArray title: 'Classes in Change Set ', self name, ': classes that
> lack class comments']!
>
> Item was changed:
>   ----- Method: ChangeSet>>fileOutOn: (in category 'fileIn/Out') -----
>   fileOutOn: stream
>         "Write out all the changes the receiver knows about"
>
>         | classList traits classes traitList list |
>         (self isEmpty and: [stream isKindOf: FileStream])
>                 ifTrue: [self inform: 'Warning: no changes to file out'].
>
>         traits := self changedClasses reject: [:each | each isBehavior].
>         classes := self changedClasses select: [:each | each isBehavior].
>         traitList := self class traitsOrder: traits asOrderedCollection.
>         classList := self class superclassOrder: classes
> asOrderedCollection.
>         list := OrderedCollection new
>                 addAll: traitList;
>                 addAll: classList;
>                 yourself.
>
>         "First put out rename, max classDef and comment changes."
>         list do: [:aClass | self fileOutClassDefinition: aClass on:
> stream].
>
>         "Then put out all the method changes"
>         list do: [:aClass | self fileOutChangesFor: aClass on: stream].
>
>         "Finally put out removals, final class defs and reorganization if
> any"
>         list reverseDo: [:aClass | self fileOutPSFor: aClass on: stream].
>
> +       self classRemoves sort do:
> -       self classRemoves asSortedCollection do:
>                 [:aClassName | stream nextChunkPut: 'Smalltalk
> removeClassNamed: #', aClassName; cr].!
>
> Item was changed:
>   ----- Method: InternalTranslator>>fileOutOn:keys:withBOM: (in category
> 'fileIn/fileOut') -----
>   fileOutOn: aStream keys: keys withBOM: bomFlag
>         "self current fileOutOn: Transcript. Transcript endEntry"
>         self fileOutHeaderOn: aStream withBOM: bomFlag.
>         (keys
> +               ifNil: [generics keys sort])
> -               ifNil: [generics keys asSortedCollection])
>                 do: [:key | self
>                                 nextChunkPut: (generics associationAt: key)
>                                 on: aStream].
>         keys
>                 ifNil: [self untranslated
>                                 do: [:each | self nextChunkPut: each -> ''
> on: aStream]].
>         aStream nextPut: $!!;
>                  cr!
>
> Item was changed:
>   ----- Method: MczInstaller>>install (in category 'installation') -----
>   install
> +
> -       | sources |
>         zip := ZipArchive new.
>         zip readFrom: stream.
>         self checkDependencies ifFalse: [^false].
>         self recordVersionInfo.
> +       (zip membersMatching: 'snapshot/*')
> +               sort: [:a :b | a fileName < b fileName];
> +               do: [:src | self installMember: src].!
> -       sources := (zip membersMatching: 'snapshot/*')
> -                               asSortedCollection: [:a :b | a fileName <
> b fileName].
> -       sources do: [:src | self installMember: src].!
>
> Item was changed:
>   ----- Method: Preferences class>>giveHelpWithPreferences (in category
> 'support') -----
>   giveHelpWithPreferences
>         "Open up a workspace with explanatory info in it about Preferences"
>
>         | aString |
>         aString := String streamContents: [:aStream |
>                 aStream nextPutAll:
>
>   'Many aspects of the system are governed by the settings of various
> "Preferences".
>
>   Click on any of brown tabs at the top of the panel to see all the
> preferences in that category.
>   Or type in to the box above the Search button, then hit Search, and all
> Preferences matching whatever you typed in will appear in the "search
> results" category.  A preference is considered to match your search if
> either its name matches the characters *or* if anything in the balloon help
> provided for the preferences matches the search text.
>
>   To find out more about any particular Preference, hold the mouse over it
> for a moment and balloon help will appear.  Also, a complete list of all
> the Preferences, with documentation for each, is included below.
>
>   Preferences whose names are in shown in bold in the Preferences Panel
> are designated as being allowed to vary from project to project; those
> whose name are not in bold are "global", which is to say, they apply
> equally whatever project you are in.
>
>   Click on the name of any preference to get a menu which allows you to
> *change* whether the preference should vary from project to project or
> should be global, and also allows you to browse all the senders of the
> preference, and to discover all the categories under which the preference
> has been classified, and to be handed a button that you can drop wherever
> you please that will control the preference.
>
>   If you like all your current Preferences settings, you may wish to hit
> the "Save Current Settings as my Personal Preferences" button.  Once you
> have done that, you can at any point in the future hit "Restore my Personal
> Preferences" and all your saved settings will get restored immediately.
>
>   Also, you can use "themes" to set multiple preferences all at once;
> click on the "change theme..." button in the Squeak flap or in the
> Preferences panel, or seek out the themes item in the Appearance menu.'
> translated.
>
>         aStream cr; cr; nextPutAll: '-----------------------------
> ------------------------------------';
>                 cr; cr; nextPutAll:  'Alphabetical listing of all
> Preferences' translated; cr; cr.
> +    (Preferences allPreferences sort: [:a :b | a name < b name]) do:
> -    (Preferences allPreferences asSortedCollection: [:a :b | a name < b
> name]) do:
>         [:pref | | aHelpString |
>                 aStream nextPutAll: pref name; cr.
>                 aHelpString := pref helpString translated.
>                 (aHelpString beginsWith: pref name) ifTrue:
>                         [aHelpString := aHelpString copyFrom: (pref name
> size ) to: aHelpString size].
>                 aHelpString := (aHelpString copyReplaceAll: String cr
> with: ' ')  copyWithout: Character tab.
>                 aStream nextPutAll: aHelpString capitalized.
>                 (aHelpString isEmpty or: [aHelpString last == $.])
> ifFalse: [aStream nextPut: $.].
>           aStream cr; cr]].
>
>         UIManager default edit: aString label: 'About Preferences'
> translated
>
>   "Preferences giveHelpWithPreferences"!
>
> Item was changed:
>   ----- Method: Project class>>allNames (in category 'utilities') -----
>   allNames
> +
> +       ^(self allProjects collect: [:p | p name]) sort: [:n1 :n2 | n1
> caseInsensitiveLessOrEqual: n2]!
> -       ^ (self allProjects collect: [:p | p name]) asSortedCollection:
> [:n1 :n2 | n1 asLowercase < n2 asLowercase]!
>
> Item was changed:
>   ----- Method: Project class>>allNamesAndProjects (in category
> 'utilities') -----
>   allNamesAndProjects
> +
> +       ^(self allProjects
> +               sorted: [ :p1 :p2 | p1 name caseInsensitiveLessOrEqual: p2
> name ])
> +               replace: [ :aProject | Array with: aProject name with:
> aProject ]!
> -       ^ (self allProjects asSortedCollection: [:p1 :p2 | p1 name
> asLowercase < p2 name asLowercase]) collect:
> -               [:aProject | Array with: aProject name with: aProject]!
>
> Item was changed:
>   ----- Method: Project class>>sweep: (in category 'squeaklet on server')
> -----
>   sweep: aServerDirectory
>         | repository list parts ind entry projectName versions |
>         "On the server, move all but the three most recent versions of
> each Squeaklet to a folder called 'older'"
>         "Project sweep: ((ServerDirectory serverNamed: 'DaniOnJumbo') clone
>                                 directory: '/vol0/people/dani/Squeaklets/
> 2.7')"
>
>         "Ensure the 'older' directory"
>         (aServerDirectory includesKey: 'older')
>                 ifFalse: [aServerDirectory createDirectory: 'older'].
>         repository := aServerDirectory clone directory: aServerDirectory
> directory, '/older'.
>
>         "Collect each name, and decide on versions"
>         list := aServerDirectory fileNames.
>         list isString ifTrue: [^ self inform: 'server is unavailable'
> translated].
> +       list sort.
> -       list := list asSortedCollection asOrderedCollection.
>         parts := list collect: [:en | Project parseProjectFileName: en].
>         parts := parts select: [:en | en third = 'pr'].
>         ind := 1.
>         [entry := list at: ind.
>                 projectName := entry first asLowercase.
>                 versions := OrderedCollection new.  versions add: entry.
>                 [(ind := ind + 1) > list size
>                         ifFalse: [(parts at: ind) first asLowercase =
> projectName
>                                 ifTrue: [versions add: (parts at: ind).
> true]
>                                 ifFalse: [false]]
>                         ifTrue: [false]] whileTrue.
>                 aServerDirectory moveYoungest: 3 in: versions to:
> repository.
>                 ind > list size] whileFalse.
>   !
>
> Item was added:
> + ----- Method: PseudoClass>>classInstVarNames (in category 'accessing')
> -----
> + classInstVarNames
> +
> +       self realClass ifNotNil: [ :realClass | ^realClass instVarNames ].
> +       ^#()!
>
> Item was added:
> + ----- Method: PseudoClass>>classVarNames (in category 'accessing') -----
> + classVarNames
> +
> +       self realClass ifNotNil: [ :realClass | ^realClass classVarNames ].
> +       ^#()!
>
> Item was changed:
>   ----- Method: SmalltalkImage>>presumedSentMessages (in category
> 'shrinking') -----
>   presumedSentMessages   | sent |
>   "Smalltalk presumedSentMessages"
>
>         "The following should be preserved for doIts, etc"
>         sent := IdentitySet new.
>         #(compactSymbolTable rebuildAllProjects
>                 browseAllSelect:  lastRemoval
>                 scrollBarValue: vScrollBarValue:
> scrollBarMenuButtonPressed:
>                 withSelectionFrom:  to: removeClassNamed:
>                 dragon: hilberts: mandala: web test3 factorial
> tinyBenchmarks benchFib
>                 newDepth: restoreAfter: zapAllMethods obsoleteClasses
>                 removeAllUnSentMessages abandonSources
> removeUnreferencedKeys
>                 reclaimDependents zapOrganization condenseChanges
> browseObsoleteReferences
>                 subclass:instanceVariableNames:classVariableNames:
> poolDictionaries:category:
>                 methodsFor:stamp: methodsFor:stamp:prior:
> instanceVariableNames:
> +               unusedClasses) do:
> -               startTimerInterruptWatcher unusedClasses) do:
>                 [:sel | sent add: sel].
>         "The following may be sent by perform: in dispatchOnChar..."
>         Smalltalk at: #ParagraphEditor ifPresent: [:paragraphEditor |
>                 (paragraphEditor classPool at: #CmdActions) asSet do:
>                         [:sel | sent add: sel].
>                 (paragraphEditor classPool at: #ShiftCmdActions) asSet do:
>                         [:sel | sent add: sel]].
>         ^ sent!
>
> Item was changed:
>   ----- Method: SmalltalkImage>>removeAllUnSentMessages (in category
> 'shrinking') -----
>   removeAllUnSentMessages
>         "Smalltalk removeAllUnSentMessages"
>         "[Smalltalk unusedClasses do: [:c | (Smalltalk at: c)
> removeFromSystem].
>         Smalltalk removeAllUnSentMessages > 0] whileTrue."
>         "Remove all implementations of unsent messages."
>         | sels n |
>         sels := self systemNavigation allUnSentMessages.
>         "The following should be preserved for doIts, etc"
>         "needed even after #majorShrink is pulled"
> +       #(#compactSymbolTable #rebuildAllProjects #browseAllSelect:
> #lastRemoval #scrollBarValue: vScrollBarValue: #scrollBarMenuButtonPressed:
> #withSelectionFrom: #to: #removeClassNamed: #dragon: #hilberts: #mandala:
> #web #test3 #factorial #tinyBenchmarks #benchFib #newDepth: #restoreAfter:
> #zapAllMethods #obsoleteClasses #removeAllUnSentMessages #abandonSources
> #removeUnreferencedKeys #reclaimDependents #zapOrganization
> #condenseChanges #browseObsoleteReferences #subclass:
> instanceVariableNames:classVariableNames:poolDictionaries:category:
> #methodsFor:stamp: #methodsFor:stamp:prior: #instanceVariableNames:
> #unusedClasses )
> -       #(#compactSymbolTable #rebuildAllProjects #browseAllSelect:
> #lastRemoval #scrollBarValue: vScrollBarValue: #scrollBarMenuButtonPressed:
> #withSelectionFrom: #to: #removeClassNamed: #dragon: #hilberts: #mandala:
> #web #test3 #factorial #tinyBenchmarks #benchFib #newDepth: #restoreAfter:
> #zapAllMethods #obsoleteClasses #removeAllUnSentMessages #abandonSources
> #removeUnreferencedKeys #reclaimDependents #zapOrganization
> #condenseChanges #browseObsoleteReferences #subclass:
> instanceVariableNames:classVariableNames:poolDictionaries:category:
> #methodsFor:stamp: #methodsFor:stamp:prior: #instanceVariableNames:
> #startTimerInterruptWatcher #unusedClasses )
>                 do: [:sel | sels
>                                 remove: sel
>                                 ifAbsent: []].
>         "The following may be sent by perform: in dispatchOnChar..."
>         (Smalltalk at: #ParagraphEditor) ifNotNilDo: [:paragraphEditor |
>                 (paragraphEditor classPool at: #CmdActions) asSet
>                         do: [:sel | sels
>                                         remove: sel
>                                         ifAbsent: []].
>                 (paragraphEditor classPool at: #ShiftCmdActions) asSet
>                         do: [:sel | sels
>                                         remove: sel
>                                         ifAbsent: []]].
>         sels size = 0
>                 ifTrue: [^ 0].
>         n := 0.
>         self systemNavigation
>                 allBehaviorsDo: [:x | n := n + 1].
>         'Removing ' , sels size printString , ' messages . . .'
>                 displayProgressFrom: 0
>                 to: n
>                 during: [:bar |
>                         n := 0.
>                         self systemNavigation
>                                 allBehaviorsDo: [:class |
>                                         bar value: (n := n + 1).
>                                         sels
>                                                 do: [:sel | class
> basicRemoveSelector: sel]]].
>         ^ sels size!
>
> Item was changed:
>   ----- Method: SpaceTally>>compareTallyIn:to: (in category 'fileOut')
> -----
>   compareTallyIn: beforeFileName to: afterFileName
>         "SpaceTally new compareTallyIn: 'tally' to: 'tally2'"
>
>         | answer s beforeDict a afterDict allKeys |
>         beforeDict := Dictionary new.
>         s := FileDirectory default fileNamed: beforeFileName.
>         [s atEnd] whileFalse: [
>                 a := Array readFrom: s nextLine.
>                 beforeDict at: a first put: a allButFirst.
>         ].
>         s close.
>         afterDict := Dictionary new.
>         s := FileDirectory default fileNamed: afterFileName.
>         [s atEnd] whileFalse: [
>                 a := Array readFrom: s nextLine.
>                 afterDict at: a first put: a allButFirst.
>         ].
>         s close.
>         answer := WriteStream on: String new.
> +       allKeys := (Set new addAll: beforeDict keys; addAll: afterDict
> keys; yourself) sorted.
> -       allKeys := (Set new addAll: beforeDict keys; addAll: afterDict
> keys; yourself) asSortedCollection.
>         allKeys do: [ :each |
>                 | before after diff |
>                 before := beforeDict at: each ifAbsent: [#(0 0 0)].
>                 after := afterDict at: each ifAbsent: [#(0 0 0)].
>                 diff := before with: after collect: [ :vBefore :vAfter |
> vAfter - vBefore].
>                 diff = #(0 0 0) ifFalse: [
>                         answer nextPutAll: each,'  ',diff printString; cr.
>                 ].
>         ].
>         StringHolder new contents: answer contents; openLabel: 'space
> diffs'.
>
>
>
>   !
>
> Item was changed:
>   ----- Method: SystemNavigation>>allMethodsInCategory: (in category
> 'browse') -----
>   allMethodsInCategory: category
>         | aCollection |
> +       aCollection := OrderedCollection new.
> -       aCollection := SortedCollection new.
>         Cursor wait showWhile:
>                 [self allBehaviorsDo:
>                         [:x | (x allMethodsInCategory: category) do:
>                                 [:sel | aCollection add: x name , ' ' ,
> sel]]].
> +       ^aCollection sort.
> -       ^aCollection.
>         !
>
> Item was changed:
>   ----- Method: SystemNavigation>>allSelectorsWithAnyImplementorsIn: (in
> category 'query') -----
>   allSelectorsWithAnyImplementorsIn: selectorList
>         "Answer the subset of the given list which represent method
> selectors
>         which have at least one implementor in the system."
>         | good |
> +       good := Set new.
> -       good := OrderedCollection new.
>         self allBehaviorsDo: [:class | selectorList
>                                 do: [:aSelector | (class includesSelector:
> aSelector)
>                                                 ifTrue: [good add:
> aSelector]]].
> +       ^good sorted
> +
> +       "
> -       ^ good asSet asSortedArray"
>         SystemNavigation new selectorsWithAnyImplementorsIn: #( contents
>         contents: nuts)
>         "!
>
> Item was changed:
>   ----- Method: SystemNavigation>>browseAllImplementorsOf:localToPackage:
> (in category 'browse') -----
>   browseAllImplementorsOf: selector localToPackage: packageNameOrInfo
>         "Create and schedule a message browser on each method in the given
> package
>         that implements the message whose selector is the argument,
> selector. For example,
>         SystemNavigation new browseAllImplementorsOf: #at:put:
> localToPackage: 'Collections'."
>
>         self browseMessageList: (self
>
> allImplementorsOf: selector
> +
>  localToPackage: packageNameOrInfo)
> -
>  localToPackage: packageNameOrInfo) asSortedCollection
>                 name: 'Implementors of ' , selector,
>                                 ' local to package ', (self
> packageInfoFor: packageNameOrInfo) name!
>
> Item was changed:
>   ----- Method: SystemNavigation>>browseAllSelect:localTo: (in category
> 'browse') -----
>   browseAllSelect: aBlock localTo: aClass
>         "Create and schedule a message browser on each method in or below
> the given class
>          that, when used as the block argument to aBlock gives a true
> result. For example,
>          SystemNavigation default browseAllSelect: [:m | m numLiterals >
> 10] localTo: Morph."
>         aClass ifNil: [^self inform: 'no class selected'].
>         ^self
> +               browseMessageList: (self allMethodsSelect: aBlock localTo:
> aClass) sorted
> -               browseMessageList: (self allMethodsSelect: aBlock localTo:
> aClass) asSortedCollection
>                 name: 'selected messages local to ', aClass name!
>
> Item was changed:
>   ----- Method: SystemNavigation>>browseClassCommentsWithString: (in
> category 'browse') -----
>   browseClassCommentsWithString: aString
>         "Smalltalk browseClassCommentsWithString: 'my instances' "
>         "Launch a message list browser on all class comments containing
> aString as a substring."
>
>         | caseSensitive suffix list |
>
>         suffix := (caseSensitive := Sensor shiftPressed)
>                 ifTrue: [' (case-sensitive)']
>                 ifFalse: [' (use shift for case-sensitive)'].
>         list := Set new.
>         Cursor wait showWhile: [
>                 Smalltalk allClassesDo: [:class |
>                         (class organization classComment asString
> findString: aString
>                                                         startingAt: 1
> caseSensitive: caseSensitive) > 0 ifTrue: [
>                                                                 list add: (
>
> MethodReference
>
>       class: class
>
>       selector: #Comment
>                                                                 )
>                                                         ]
>                 ]
>         ].
>         ^ self
> +               browseMessageList: list sorted
> -               browseMessageList: list asSortedCollection
>                 name: 'Class comments containing ' , aString printString ,
> suffix
>                 autoSelect: aString!
>
> Item was changed:
>   ----- Method: SystemNavigation>>browseClassesWithNamesContaining:caseSensitive:
> (in category 'browse') -----
>   browseClassesWithNamesContaining: aString caseSensitive: caseSensitive
>         "Smalltalk browseClassesWithNamesContaining: 'eMorph'
> caseSensitive: true "
>         "Launch a class-list list browser on all classes whose names
> containg aString as a substring."
>
>         | suffix aList |
>         suffix := caseSensitive
>                                 ifTrue: [' (case-sensitive)']
>                                 ifFalse: [' (use shift for
> case-sensitive)'].
>         aList := OrderedCollection new.
>         Cursor wait
>                 showWhile: [Smalltalk
>                                 allClassesDo: [:class | (class name
> includesSubstring: aString caseSensitive: caseSensitive)
>                                                 ifTrue: [aList add: class
> name]]].
>         aList size > 0
> +               ifTrue: [ToolSet openClassListBrowser: aList asSet sorted
> title: 'Classes whose names contain ' , aString , suffix]!
> -               ifTrue: [ToolSet openClassListBrowser: aList asSet
> asSortedArray title: 'Classes whose names contain ' , aString , suffix]!
>
> Item was changed:
>   ----- Method: SystemNavigation>>showMenuOf:withFirstItem:ifChosenDo:withCaption:
> (in category 'ui') -----
>   showMenuOf: selectorCollection withFirstItem: firstItem ifChosenDo:
> choiceBlock withCaption: aCaption
>         "Show a sorted menu of the given selectors, preceded by firstItem,
> and all abbreviated to 40 characters.  Use aCaption as the menu title, if
> it is not nil.  Evaluate choiceBlock if a message is chosen."
>
>         | index menuLabels sortedList |
> +       sortedList := selectorCollection sorted.
> -       sortedList := selectorCollection asSortedCollection.
>         menuLabels := Array streamContents:
>                 [:strm | strm nextPut: (firstItem contractTo: 40).
>                 sortedList do: [:sel | strm nextPut: (sel contractTo:
> 40)]].
>         index := UIManager default chooseFrom: menuLabels lines: #(1).
>         index = 1 ifTrue: [choiceBlock value: firstItem].
>         index > 1 ifTrue: [choiceBlock value: (sortedList at: index - 1)]!
>
> Item was changed:
>   ----- Method: SystemVersion>>highestUpdate (in category 'accessing')
> -----
>   highestUpdate
> +
> +       ^highestUpdate ifNil: [
> +               highestUpdate := self updates isEmpty
> +                       ifTrue: [ 0 ]
> +                       ifFalse: [ self updates max ] ]!
> -       | sortedUpdates |
> -       highestUpdate ifNil: [
> -               sortedUpdates := self updates asSortedCollection.
> -               highestUpdate := (sortedUpdates isEmpty
> -                       ifTrue: [0]
> -                       ifFalse: [sortedUpdates last])].
> -       ^highestUpdate!
>
> Item was changed:
>   ----- Method: TranslatedReceiverFinder class>>browseNonLiteralReceivers
> (in category 'utilities') -----
>   browseNonLiteralReceivers
>         "TranslatedReceiverFinder browseNonLiteralReceivers"
>         SystemNavigation default
> +               browseMessageList: self new nonLiteralReceivers
> -               browseMessageList: self new nonLiteralReceivers
> asSortedCollection
>                 name: 'Non literal receivers of #translated'
>                 autoSelect: 'translated'!
>
>
>


-- 
_,,,^..^,,,_
best, Eliot
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://lists.squeakfoundation.org/pipermail/squeak-dev/attachments/20170313/fd0c3662/attachment-0001.html>


More information about the Squeak-dev mailing list