[squeak-dev] The Trunk: System-ul.932.mczcommits at source.squeak.org commits at source.squeak.orgMon Mar 13 15:00:51 UTC 2017
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'!
More information about the Squeak-dev mailing list |