'From Squeak3.4 of 1 March 2003 [latest update: #5170] on 7 May 2003 at 10:05:48 am'! "Change Set: KCP-0062-fixlSendersOfAlClassesImplementing Date: 6 May 2003 Author: noury bouraqadi Changes messages 'Smalltalk allClassesImplementing:' to make use of SystemNavigation"! !Browser methodsFor: 'class functions' stamp: 'nb 5/6/2003 16:49'! explainSpecial: string "Answer a string explaining the code pane selection if it is displaying one of the special edit functions." | classes whole lits reply | (editSelection == #editClass or: [editSelection == #newClass]) ifTrue: ["Selector parts in class definition" string last == $: ifFalse: [^nil]. lits _ Array with: #subclass:instanceVariableNames:classVariableNames:poolDictionaries:category:. (whole _ lits detect: [:each | (each keywords detect: [:frag | frag = string] ifNone: []) ~~ nil] ifNone: []) ~~ nil ifTrue: [reply _ '"' , string , ' is one part of the message selector ' , whole , '.'] ifFalse: [^nil]. classes _ self systemNavigation allClassesImplementing: whole. classes _ 'these classes ' , classes printString. ^reply , ' It is defined in ' , classes , '." Smalltalk browseAllImplementorsOf: #' , whole]. editSelection == #hierarchy ifTrue: ["Instance variables in subclasses" classes _ self selectedClassOrMetaClass allSubclasses. classes _ classes detect: [:each | (each instVarNames detect: [:name | name = string] ifNone: []) ~~ nil] ifNone: [^nil]. classes _ classes printString. ^'"is an instance variable in class ' , classes , '." ' , classes , ' browseAllAccessesTo: ''' , string , '''.']. editSelection == #editSystemCategories ifTrue: [^nil]. editSelection == #editMessageCategories ifTrue: [^nil]. ^nil! ! !DeepCopier methodsFor: 'like fullCopy' stamp: 'nb 5/6/2003 16:50'! checkDeep "Write exceptions in the Transcript. Every class that implements veryDeepInner: must copy all its inst vars. Danger is that a user will add a new instance variable and forget to copy it. This check is only run by hand once in a while to make sure nothing was forgotten. (Please do not remove this method.) DeepCopier new checkDeep " | mm | Transcript cr; show: 'Instance variables shared with the original object when it is copied'. (SystemNavigation new allClassesImplementing: #veryDeepInner:) do: [:aClass | (mm _ aClass instVarNames size) > 0 ifTrue: [ (aClass instSize - mm + 1) to: aClass instSize do: [:index | ((aClass compiledMethodAt: #veryDeepInner:) writesField: index) ifFalse: [ Transcript cr; show: aClass name; space; show: (aClass allInstVarNames at: index)]]]]. ! ! !DeepCopier methodsFor: 'like fullCopy' stamp: 'nb 5/6/2003 16:51'! checkVariables "Check that no indexes of instance vars have changed in certain classes. If you get an error in this method, an implementation of veryDeepCopyWith: needs to be updated. The idea is to catch a change while it is still in the system of the programmer who made it. DeepCopier new checkVariables " | meth | self checkBasicClasses. "Every class that implements veryDeepInner: must copy all its inst vars. Danger is that a user will add a new instance variable and forget to copy it. So check that the last one is mentioned in the copy method." (SystemNavigation new allClassesImplementing: #veryDeepInner:) do: [:aClass | ((aClass compiledMethodAt: #veryDeepInner:) writesField: aClass instSize) ifFalse: [ aClass instSize > 0 ifTrue: [ self warnIverNotCopiedIn: aClass sel: #veryDeepInner:]]]. (SystemNavigation new allClassesImplementing: #veryDeepCopyWith:) do: [:aClass | meth _ aClass compiledMethodAt: #veryDeepCopyWith:. (meth size > 20) & (meth literals includes: #veryDeepCopyWith:) not ifTrue: [ (meth writesField: aClass instSize) ifFalse: [ self warnIverNotCopiedIn: aClass sel: #veryDeepCopyWith:]]]. ! ! !FileList class methodsFor: 'class initialization' stamp: 'nb 5/7/2003 10:05'! initialize "FileList initialize" RecentDirs := OrderedCollection new. (SystemNavigation new allClassesImplementing: #fileReaderServicesForFile:suffix:) do: [:providerMetaclass | self registerFileReader: providerMetaclass soleInstance]! ! !ParagraphEditor methodsFor: 'explain' stamp: 'nb 5/6/2003 16:54'! explainAnySel: symbol "Is this any message selector?" | list reply | list _ self systemNavigation allClassesImplementing: symbol. list size = 0 ifTrue: [^nil]. list size < 12 ifTrue: [reply _ ' is a message selector which is defined in these classes ' , list printString] ifFalse: [reply _ ' is a message selector which is defined in many classes']. ^'"' , symbol , reply , '."' , '\' withCRs, 'Smalltalk browseAllImplementorsOf: #' , symbol! ! !ParagraphEditor methodsFor: 'explain' stamp: 'nb 5/6/2003 16:54'! explainMySel: symbol "Is symbol the selector of this method? Is it sent by this method? If not, then expalin will call (explainPartSel:) to see if it is a fragment of a selector sent here. If not, explain will call (explainAnySel:) to catch any selector. " | lits classes msg | (model respondsTo: #selectedMessageName) ifFalse: [^ nil]. (msg _ model selectedMessageName) ifNil: [^nil]. "not in a message" classes _ self systemNavigation allClassesImplementing: symbol. classes size > 12 ifTrue: [classes _ 'many classes'] ifFalse: [classes _ 'these classes ' , classes printString]. msg = symbol ifTrue: [^ '"' , symbol , ' is the selector of this very method!! It is defined in ', classes , '. To see the other definitions, go to the message list pane, get the menu from the top of the scroll bar, and select ''implementors of...''."'] ifFalse: [lits _ (model selectedClassOrMetaClass compiledMethodAt: msg) messages. (lits detect: [:each | each == symbol] ifNone: []) == nil ifTrue: [^nil]. ^ '"' , symbol , ' is a message selector which is defined in ', classes , '. To see the definitions, go to the message list pane, get the menu from the top of the scroll bar, and select ''implementors of...''."'].! ! !ParagraphEditor methodsFor: 'explain' stamp: 'nb 5/6/2003 16:54'! explainPartSel: string "Is this a fragment of a multiple-argument selector sent in this method?" | lits whole reply classes s msg | (model respondsTo: #selectedMessageName) ifFalse: [^ nil]. (msg _ model selectedMessageName) ifNil: [^ nil]. "not in a message" string last == $: ifFalse: [^ nil]. "Name of this method" lits _ Array with: msg. (whole _ lits detect: [:each | (each keywords detect: [:frag | frag = string] ifNone: []) ~~ nil] ifNone: []) ~~ nil ifTrue: [reply _ ', which is the selector of this very method!!'. s _ '. To see the other definitions, go to the message list pane, get the menu from the top of the scroll bar, and select ''implementors of...''."'] ifFalse: ["Selectors called from this method" lits _ (model selectedClassOrMetaClass compiledMethodAt: msg) messages. (whole _ lits detect: [:each | (each keywords detect: [:frag | frag = string] ifNone: []) ~~ nil] ifNone: []) ~~ nil ifFalse: [string = 'primitive:' ifTrue: [^self explainChar: '<'] ifFalse: [^nil]]. reply _ '.'. s _ '. To see the definitions, go to the message list pane, get the menu from the top of the scroll bar, and select ''implementors of...''."']. classes _ self systemNavigation allClassesImplementing: whole. classes size > 12 ifTrue: [classes _ 'many classes'] ifFalse: [classes _ 'these classes ' , classes printString]. ^ '"' , string , ' is one part of the message selector ' , whole, reply , ' It is defined in ' , classes , s! ! !Preferences class methodsFor: 'window colors' stamp: 'nb 5/6/2003 16:55'! windowColorTable "Answer a list of WindowColorSpec objects, one for each tool to be represented in the window-color panel" ^ (((SystemNavigation new allClassesImplementing: #windowColorSpecification) collect: [:aClass | aClass theNonMetaClass windowColorSpecification]) asSortedCollection: [:specOne :specTwo | specOne wording < specTwo wording]) asArray "Preferences windowColorTable"! ! !SmartRefStream class methodsFor: 'as yet unclassified' stamp: 'nb 5/6/2003 17:03'! cleanUpCategories | list valid removed newList newVers | "Look for all conversion methods that can't be used any longer. Delete them." " SmartRefStream cleanUpCategories " "Two part selectors that begin with convert and end with a digit." "convertasossfe0: varDict asossfeu0: smartRefStrm" list _ Symbol selectorsContaining: 'convert'. list _ list select: [:symb | (symb beginsWith: 'convert') & (symb allButLast last isDigit) ifTrue: [(symb numArgs = 2)] ifFalse: [false]]. valid _ 0. removed _ 0. list do: [:symb | (SystemNavigation new allClassesImplementing: symb) do: [:newClass | newList _ (Array with: newClass classVersion), (newClass allInstVarNames). newVers _ self new versionSymbol: newList. (symb endsWith: (':',newVers,':')) ifFalse: [ "method is useless because can't convert to current shape" newClass removeSelector: symb. "get rid of it" removed _ removed + 1] ifTrue: [valid _ valid + 1]]]. Transcript cr; show: 'Removed: '; print: removed; show: ' Kept: '; print: valid; show: ' '.! ! FileList initialize!