'From Squeak3.7alpha of 11 September 2003 [latest update: #5816] on 15 April 2004 at 12:34:43 pm'! "Change Set: KCP-0220-ClassOrganizerFixAndCleanup Date: 15 April 2004 Author: Nathanael Schaerli This changeset cleans up the ClassOrganizer hierarchy and fixes some bugs in the SystemNotification framework. Furthermore, it fixes some other bugs that got appearent while I was working on this cleanup. In detail: - Cleans up the ClassOrganizer hierarchy. This was necessary because the old hierarchy was conceptually wrong and made it therefore unnecessarily hard to extend it. - Makes sure that changes to the class organizer always trigger the corresponding system change notifier event. (This was not the case so far). - All the system change notification triggers are in the kernel where they actually happen. In particular, I removed all the triggers in the class Browser. - Removes a few minor problems with nil values in the SystemChangeNotification framework. - Removes a bug when using drag and drop between classes without having message categories selected. IMPORTANT: - This changeset has been modified by hand in order to make it file in properly. - Close all the browser windows before filing this changeset in." "This script closes all the browser windows." PopUpMenu inform: 'This changeset will now close all your browser windows. This is necessary to avoid errors after filing it in.'. SystemWindow allInstancesDo: [:each | (each model isKindOf: Browser) ifTrue:[ each delete]].! Object subclass: #Categorizer instanceVariableNames: 'categoryArray categoryStops elementArray' classVariableNames: 'Default NullCategory' poolDictionaries: '' category: 'Kernel-Classes'! Categorizer subclass: #BasicClassOrganizer instanceVariableNames: 'subject classComment commentStamp' classVariableNames: '' poolDictionaries: '' category: 'Kernel-Classes'! BasicClassOrganizer subclass: #ClassOrganizerNew instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Kernel-Classes'! !ClassOrganizerNew commentStamp: 'NS 4/6/2004 16:13' prior: 0! I represent method categorization information for classes. The handling of class comments has gone through a tortuous evolution. Grandfathered class comments (before late aug 98) have no time stamps, and historically, fileouts of class comments always substituted the timestamp reflecting the author and date/time at the moment of fileout; and historically any timestamps in a filed out class comment were dropped on the floor, with the author & time prevailing at the moment of filein being substituted. Such grandfathered comments now go out on fileouts with '' timestamp; class comments created after the 8/98 changes will have their correct timestamps preserved, though there is not yet a decent ui for reading those stamps other than filing out and looking at the file; nor is there yet any ui for browsing and recovering past versions of such comments. Everything in good time!!! BasicClassOrganizer subclass: #PseudoClassOrganizerNew instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Tools-File Contents Browser'! !ClassOrganizer methodsFor: 'temporary' stamp: 'NS 4/6/2004 15:25'! setSubject: aClassDescription ^ self! ! !Browser methodsFor: 'drag and drop' stamp: 'NS 4/7/2004 13:27'! acceptDroppingMorph: transferMorph event: evt inMorph: dstListMorph "Here we are fetching informations from the dropped transferMorph and performing the correct action for this drop." | srcType success srcBrowser srcClass srcSelector srcCategory | success _ false. srcType _ transferMorph dragTransferType. srcBrowser _ transferMorph source model. srcClass _ transferMorph passenger key. srcSelector _ transferMorph passenger value. srcCategory _ srcBrowser selectedMessageCategoryName. srcCategory ifNil: [srcCategory _ srcClass organization categoryOfElement: srcSelector]. srcType == #messageList ifTrue: [success _ self acceptMethod: srcSelector messageCategory: srcCategory class: srcClass atListMorph: dstListMorph internal: self == srcBrowser copy: transferMorph shouldCopy]. srcType == #classList ifTrue: [success _ self changeCategoryForClass: transferMorph passenger srcSystemCategory: srcBrowser selectedSystemCategoryName atListMorph: dstListMorph internal: self == srcBrowser copy: transferMorph shouldCopy]. ^success! ! !Browser methodsFor: 'message category functions' stamp: 'NS 4/7/2004 22:47'! alphabetizeMessageCategories classListIndex = 0 ifTrue: [^ false]. self okToChange ifFalse: [^ false]. self classOrMetaClassOrganizer sortCategories. self clearUserEditFlag. self editClass. self classListIndex: classListIndex. ^ true! ! !Browser methodsFor: 'message category functions' stamp: 'NS 4/7/2004 22:56'! changeMessageCategories: aString "The characters in aString represent an edited version of the the message categories for the selected class. Update this information in the system and inform any dependents that the categories have been changed. This message is invoked because the user had issued the categories command and edited the message categories. Then the user issued the accept command." self classOrMetaClassOrganizer changeFromString: aString. self clearUserEditFlag. self editClass. self classListIndex: classListIndex. ^ true! ! !Browser methodsFor: 'message category functions' stamp: 'NS 4/7/2004 23:01'! renameCategory "Prompt for a new category name and add it before the current selection, or at the end if no current selection" | oldIndex oldName newName | classListIndex = 0 ifTrue: [^ self]. self okToChange ifFalse: [^ self]. (oldIndex _ messageCategoryListIndex) = 0 ifTrue: [^ self]. oldName _ self selectedMessageCategoryName. newName _ self request: 'Please type new category name' initialAnswer: oldName. newName isEmpty ifTrue: [^ self] ifFalse: [newName _ newName asSymbol]. newName = oldName ifTrue: [^ self]. self classOrMetaClassOrganizer renameCategory: oldName toBe: newName. self classListIndex: classListIndex. self messageCategoryListIndex: oldIndex. self changed: #messageCategoryList. ! ! !Categorizer methodsFor: 'accessing' stamp: 'NS 4/5/2004 17:44'! addCategory: newCategory ^ self addCategory: newCategory before: nil ! ! !Categorizer methodsFor: 'accessing' stamp: 'NS 4/5/2004 17:44'! addCategory: catString before: nextCategory "Add a new category named heading. If default category exists and is empty, remove it. If nextCategory is nil, then add the new one at the end, otherwise, insert it before nextCategory." | index newCategory | newCategory _ catString asSymbol. (categoryArray indexOf: newCategory) > 0 ifTrue: [^self]. "heading already exists, so done" index _ categoryArray indexOf: nextCategory ifAbsent: [categoryArray size + 1]. categoryArray _ categoryArray copyReplaceFrom: index to: index-1 with: (Array with: newCategory). categoryStops _ categoryStops copyReplaceFrom: index to: index-1 with: (Array with: (index = 1 ifTrue: [0] ifFalse: [categoryStops at: index-1])). "remove empty default category" (newCategory ~= Default and: [(self listAtCategoryNamed: Default) isEmpty]) ifTrue: [self removeCategory: Default]! ! !Categorizer methodsFor: 'accessing' stamp: 'NS 4/5/2004 17:44'! allMethodSelectors "give a list of all method selectors." ^ elementArray copy sort! ! !Categorizer methodsFor: 'accessing' stamp: 'NS 4/7/2004 10:29'! categories "Answer an Array of categories (names)." categoryArray isNil ifTrue: [^ nil]. (categoryArray size = 1 and: [categoryArray first = Default & (elementArray size = 0)]) ifTrue: [^Array with: NullCategory]. ^categoryArray! ! !Categorizer methodsFor: 'accessing' stamp: 'NS 4/5/2004 17:44'! categories: anArray "Reorder my categories to be in order of the argument, anArray. If the resulting organization does not include all elements, then give an error." | newCategories newStops newElements catName list runningTotal | newCategories _ Array new: anArray size. newStops _ Array new: anArray size. newElements _ Array new: 0. runningTotal _ 0. 1 to: anArray size do: [:i | catName _ (anArray at: i) asSymbol. list _ self listAtCategoryNamed: catName. newElements _ newElements, list. newCategories at: i put: catName. newStops at: i put: (runningTotal _ runningTotal + list size)]. elementArray do: [:element | "check to be sure all elements are included" (newElements includes: element) ifFalse: [^self error: 'New categories must match old ones']]. "Everything is good, now update my three arrays." categoryArray _ newCategories. categoryStops _ newStops. elementArray _ newElements! ! !Categorizer methodsFor: 'accessing' stamp: 'NS 4/5/2004 17:44'! categoryOfElement: element "Answer the category associated with the argument, element." | index | index _ self numberOfCategoryOfElement: element. index = 0 ifTrue: [^nil] ifFalse: [^categoryArray at: index]! ! !Categorizer methodsFor: 'accessing' stamp: 'NS 4/7/2004 10:36'! changeFromCategorySpecs: categorySpecs "Tokens is an array of categorySpecs as scanned from a browser 'reorganize' pane, or built up by some other process, such as a scan of an environment." | oldElements newElements newCategories newStops currentStop temp ii cc catSpec | oldElements _ elementArray asSet. newCategories _ Array new: categorySpecs size. newStops _ Array new: categorySpecs size. currentStop _ 0. newElements _ WriteStream on: (Array new: 16). 1 to: categorySpecs size do: [:i | catSpec _ categorySpecs at: i. newCategories at: i put: catSpec first asSymbol. catSpec allButFirst asSortedCollection do: [:elem | (oldElements remove: elem ifAbsent: [nil]) notNil ifTrue: [newElements nextPut: elem. currentStop _ currentStop+1]]. newStops at: i put: currentStop]. "Ignore extra elements but don't lose any existing elements!!" oldElements _ oldElements collect: [:elem | Array with: (self categoryOfElement: elem) with: elem]. newElements _ newElements contents. categoryArray _ newCategories. (cc _ categoryArray asSet) size = categoryArray size ifFalse: ["has duplicate element" temp _ categoryArray asOrderedCollection. temp removeAll: categoryArray asSet asOrderedCollection. temp do: [:dup | ii _ categoryArray indexOf: dup. [dup _ (dup,' #2') asSymbol. cc includes: dup] whileTrue. cc add: dup. categoryArray at: ii put: dup]]. categoryStops _ newStops. elementArray _ newElements. oldElements do: [:pair | self classify: pair last under: pair first].! ! !Categorizer methodsFor: 'accessing' stamp: 'NS 4/5/2004 17:44'! changeFromString: aString "Parse the argument, aString, and make this be the receiver's structure." | categorySpecs | categorySpecs _ Scanner new scanTokens: aString. "If nothing was scanned and I had no elements before, then default me" (categorySpecs isEmpty and: [elementArray isEmpty]) ifTrue: [^ self setDefaultList: Array new]. ^ self changeFromCategorySpecs: categorySpecs! ! !Categorizer methodsFor: 'accessing' stamp: 'NS 4/5/2004 17:44'! classify: element under: heading self classify: element under: heading suppressIfDefault: true! ! !Categorizer methodsFor: 'accessing' stamp: 'NS 4/5/2004 17:54'! classify: element under: heading suppressIfDefault: aBoolean "Store the argument, element, in the category named heading. If aBoolean is true, then invoke special logic such that the classification is NOT done if the new heading is the Default and the element already had a non-Default classification -- useful for filein" | catName catIndex elemIndex realHeading | ((heading = NullCategory) or: [heading == nil]) ifTrue: [realHeading _ Default] ifFalse: [realHeading _ heading asSymbol]. (catName _ self categoryOfElement: element) = realHeading ifTrue: [^ self]. "done if already under that category" catName ~~ nil ifTrue: [(aBoolean and: [realHeading = Default]) ifTrue: [^ self]. "return if non-Default category already assigned in memory" self removeElement: element]. "remove if in another category" (categoryArray indexOf: realHeading) = 0 ifTrue: [self addCategory: realHeading]. catIndex _ categoryArray indexOf: realHeading. elemIndex _ catIndex > 1 ifTrue: [categoryStops at: catIndex - 1] ifFalse: [0]. [(elemIndex _ elemIndex + 1) <= (categoryStops at: catIndex) and: [element >= (elementArray at: elemIndex)]] whileTrue. "elemIndex is now the index for inserting the element. Do the insertion before it." elementArray _ elementArray copyReplaceFrom: elemIndex to: elemIndex-1 with: (Array with: element). "add one to stops for this and later categories" catIndex to: categoryArray size do: [:i | categoryStops at: i put: (categoryStops at: i) + 1]. (self listAtCategoryNamed: Default) size = 0 ifTrue: [self removeCategory: Default]! ! !Categorizer methodsFor: 'accessing' stamp: 'NS 4/5/2004 17:44'! classifyAll: aCollection under: heading aCollection do: [:element | self classify: element under: heading]! ! !Categorizer methodsFor: 'accessing' stamp: 'NS 4/7/2004 10:20'! elementCategoryDict | dict firstIndex lastIndex | elementArray isNil ifTrue: [^ nil]. dict _ Dictionary new: elementArray size. 1to: categoryStops size do: [:cat | firstIndex _ self firstIndexOfCategoryNumber: cat. lastIndex _ self lastIndexOfCategoryNumber: cat. firstIndex to: lastIndex do: [:el | dict at: (elementArray at: el) put: (categoryArray at: cat)]. ]. ^ dict.! ! !Categorizer methodsFor: 'accessing' stamp: 'NS 4/15/2004 12:33'! isEmptyCategoryNamed: categoryName | i | i _ categoryArray indexOf: categoryName ifAbsent: [^false]. ^self isEmptyCategoryNumber: i! ! !Categorizer methodsFor: 'accessing' stamp: 'NS 4/15/2004 12:33'! isEmptyCategoryNumber: anInteger | firstIndex lastIndex | (anInteger < 1 or: [anInteger > categoryStops size]) ifTrue: [^ true]. firstIndex _ self firstIndexOfCategoryNumber: anInteger. lastIndex _ self lastIndexOfCategoryNumber: anInteger. ^ firstIndex > lastIndex! ! !Categorizer methodsFor: 'accessing' stamp: 'NS 4/5/2004 17:44'! listAtCategoryNamed: categoryName "Answer the array of elements associated with the name, categoryName." | i | i _ categoryArray indexOf: categoryName ifAbsent: [^Array new]. ^self listAtCategoryNumber: i! ! !Categorizer methodsFor: 'accessing' stamp: 'NS 4/6/2004 13:51'! listAtCategoryNumber: anInteger "Answer the array of elements stored at the position indexed by anInteger. Answer nil if anInteger is larger than the number of categories." | firstIndex lastIndex | (anInteger < 1 or: [anInteger > categoryStops size]) ifTrue: [^ nil]. firstIndex _ self firstIndexOfCategoryNumber: anInteger. lastIndex _ self lastIndexOfCategoryNumber: anInteger. ^elementArray copyFrom: firstIndex to: lastIndex! ! !Categorizer methodsFor: 'accessing' stamp: 'NS 4/5/2004 17:44'! numberOfCategoryOfElement: element "Answer the index of the category with which the argument, element, is associated." | categoryIndex elementIndex | categoryIndex _ 1. elementIndex _ 0. [(elementIndex _ elementIndex + 1) <= elementArray size] whileTrue: ["point to correct category" [elementIndex > (categoryStops at: categoryIndex)] whileTrue: [categoryIndex _ categoryIndex + 1]. "see if this is element" element = (elementArray at: elementIndex) ifTrue: [^categoryIndex]]. ^0! ! !Categorizer methodsFor: 'accessing' stamp: 'NS 4/5/2004 17:44'! removeCategory: cat "Remove the category named, cat. Create an error notificiation if the category has any elements in it." | index lastStop | index _ categoryArray indexOf: cat ifAbsent: [^self]. lastStop _ index = 1 ifTrue: [0] ifFalse: [categoryStops at: index - 1]. (categoryStops at: index) - lastStop > 0 ifTrue: [^self error: 'cannot remove non-empty category']. categoryArray _ categoryArray copyReplaceFrom: index to: index with: Array new. categoryStops _ categoryStops copyReplaceFrom: index to: index with: Array new. categoryArray size = 0 ifTrue: [categoryArray _ Array with: Default. categoryStops _ Array with: 0] ! ! !Categorizer methodsFor: 'accessing' stamp: 'NS 4/5/2004 17:44'! removeElement: element "Remove the selector, element, from all categories." | categoryIndex elementIndex nextStop newElements | categoryIndex _ 1. elementIndex _ 0. nextStop _ 0. "nextStop keeps track of the stops in the new element array" newElements _ WriteStream on: (Array new: elementArray size). [(elementIndex _ elementIndex + 1) <= elementArray size] whileTrue: [[elementIndex > (categoryStops at: categoryIndex)] whileTrue: [categoryStops at: categoryIndex put: nextStop. categoryIndex _ categoryIndex + 1]. (elementArray at: elementIndex) = element ifFalse: [nextStop _ nextStop + 1. newElements nextPut: (elementArray at: elementIndex)]]. [categoryIndex <= categoryStops size] whileTrue: [categoryStops at: categoryIndex put: nextStop. categoryIndex _ categoryIndex + 1]. elementArray _ newElements contents! ! !Categorizer methodsFor: 'accessing' stamp: 'NS 4/5/2004 17:44'! removeEmptyCategories "Remove empty categories." | categoryIndex currentStop keptCategories keptStops | keptCategories _ WriteStream on: (Array new: 16). keptStops _ WriteStream on: (Array new: 16). currentStop _ categoryIndex _ 0. [(categoryIndex _ categoryIndex + 1) <= categoryArray size] whileTrue: [(categoryStops at: categoryIndex) > currentStop ifTrue: [keptCategories nextPut: (categoryArray at: categoryIndex). keptStops nextPut: (currentStop _ categoryStops at: categoryIndex)]]. categoryArray _ keptCategories contents. categoryStops _ keptStops contents. categoryArray size = 0 ifTrue: [categoryArray _ Array with: Default. categoryStops _ Array with: 0] "ClassOrganizer allInstancesDo: [:co | co removeEmptyCategories]."! ! !Categorizer methodsFor: 'accessing' stamp: 'NS 4/5/2004 17:44'! renameCategory: oldCatString toBe: newCatString "Rename a category. No action if new name already exists, or if old name does not exist." | index oldCategory newCategory | oldCategory _ oldCatString asSymbol. newCategory _ newCatString asSymbol. (categoryArray indexOf: newCategory) > 0 ifTrue: [^ self]. "new name exists, so no action" (index _ categoryArray indexOf: oldCategory) = 0 ifTrue: [^ self]. "old name not found, so no action" categoryArray _ categoryArray copy. "need to change identity so smart list update will notice the change" categoryArray at: index put: newCategory! ! !Categorizer methodsFor: 'accessing' stamp: 'NS 4/5/2004 17:44'! sortCategories | privateCategories publicCategories newCategories | privateCategories _ self categories select: [:one | (one findString: 'private' startingAt: 1 caseSensitive: false) = 1]. publicCategories _ self categories copyWithoutAll: privateCategories. newCategories _ publicCategories asSortedCollection asOrderedCollection addAll: privateCategories asSortedCollection; asArray. self categories: newCategories! ! !Categorizer methodsFor: 'printing' stamp: 'NS 4/5/2004 17:44'! printOn: aStream "Refer to the comment in Object|printOn:." | elementIndex | elementIndex _ 1. 1 to: categoryArray size do: [:i | aStream nextPut: $(. (categoryArray at: i) asString printOn: aStream. [elementIndex <= (categoryStops at: i)] whileTrue: [aStream space; nextPutAll: (elementArray at: elementIndex). elementIndex _ elementIndex + 1]. aStream nextPut: $); cr]! ! !Categorizer methodsFor: 'printing' stamp: 'NS 4/5/2004 17:44'! printOnStream: aStream "Refer to the comment in Object|printOn:." | elementIndex | elementIndex _ 1. 1 to: categoryArray size do: [:i | aStream print: '('; write:(categoryArray at:i). " is the asString redundant? " [elementIndex <= (categoryStops at: i)] whileTrue: [aStream print:' '; write:(elementArray at: elementIndex). elementIndex _ elementIndex + 1]. aStream print:')'. aStream cr]! ! !Categorizer methodsFor: 'fileIn/Out' stamp: 'NS 4/5/2004 17:44'! scanFrom: aStream "Reads in the organization from the next chunk on aStream. Categories or elements not found in the definition are not affected. New elements are ignored." self changeFromString: aStream nextChunk. aStream skipStyleChunk.! ! !Categorizer methodsFor: 'private' stamp: 'NS 4/5/2004 17:44'! elementArray ^ elementArray! ! !Categorizer methodsFor: 'private' stamp: 'NS 4/6/2004 13:51'! firstIndexOfCategoryNumber: anInteger anInteger < 1 ifTrue: [^ nil]. ^ (anInteger > 1 ifTrue: [(categoryStops at: anInteger - 1) + 1] ifFalse: [1]).! ! !Categorizer methodsFor: 'private' stamp: 'NS 4/6/2004 13:52'! lastIndexOfCategoryNumber: anInteger anInteger > categoryStops size ifTrue: [^ nil]. ^ categoryStops at: anInteger! ! !Categorizer methodsFor: 'private' stamp: 'NS 4/5/2004 17:50'! setDefaultList: aSortedCollection categoryArray _ Array with: Default. categoryStops _ Array with: aSortedCollection size. elementArray _ aSortedCollection asArray! ! !BasicClassOrganizer methodsFor: 'accessing' stamp: 'NS 4/7/2004 16:02'! classComment classComment ifNil: [^ '']. ^ classComment text ifNil: ['']! ! !BasicClassOrganizer methodsFor: 'accessing' stamp: 'NS 4/7/2004 16:03'! classComment: aString "Store the comment, aString, associated with the object that refers to the receiver." (aString isKindOf: RemoteString) ifTrue: [classComment _ aString] ifFalse: [(aString == nil or: [aString size = 0]) ifTrue: [classComment _ nil] ifFalse: [ self error: 'use aClass classComment:'. classComment _ RemoteString newString: aString onFileNumber: 2]] "Later add priorSource and date and initials?"! ! !BasicClassOrganizer methodsFor: 'accessing' stamp: 'NS 4/7/2004 16:03'! classComment: aString stamp: aStamp "Store the comment, aString, associated with the object that refers to the receiver." self commentStamp: aStamp. (aString isKindOf: RemoteString) ifTrue: [classComment _ aString] ifFalse: [(aString == nil or: [aString size = 0]) ifTrue: [classComment _ nil] ifFalse: [self error: 'use aClass classComment:'. classComment _ RemoteString newString: aString onFileNumber: 2]] "Later add priorSource and date and initials?"! ! !BasicClassOrganizer methodsFor: 'accessing' stamp: 'NS 4/7/2004 16:03'! commentRemoteStr ^ classComment! ! !BasicClassOrganizer methodsFor: 'accessing' stamp: 'NS 4/7/2004 16:03'! commentStamp "Answer the comment stamp for the class" ^ commentStamp! ! !BasicClassOrganizer methodsFor: 'accessing' stamp: 'NS 4/7/2004 16:03'! commentStamp: aStamp commentStamp _ aStamp! ! !BasicClassOrganizer methodsFor: 'accessing' stamp: 'NS 4/7/2004 16:03'! dateCommentLastSubmitted "Answer a Date object indicating when my class comment was last submitted. If there is no date stamp, or one of the old-time guys, return nil" "RecentMessageSet organization dateCommentLastSubmitted" | aStamp tokens | (aStamp _ self commentStamp) isEmptyOrNil ifTrue: [^ nil]. tokens _ aStamp findBetweenSubStrs: ' '. "space is expected delimiter, but cr is sometimes seen, though of mysterious provenance" ^ tokens size > 1 ifTrue: [[tokens second asDate] ifError: [nil]] ifFalse: [nil]! ! !BasicClassOrganizer methodsFor: 'accessing' stamp: 'NS 4/7/2004 16:03'! hasNoComment "Answer whether the class classified by the receiver has a comment." ^classComment == nil! ! !BasicClassOrganizer methodsFor: 'accessing' stamp: 'NS 4/7/2004 16:04'! hasSubject ^ self subject notNil! ! !BasicClassOrganizer methodsFor: 'accessing' stamp: 'NS 4/7/2004 16:04'! subject ^ subject.! ! !BasicClassOrganizer methodsFor: 'fileIn/Out' stamp: 'NS 4/7/2004 16:03'! fileOutCommentOn: aFileStream moveSource: moveSource toFile: fileIndex "Copy the class comment to aFileStream. If moveSource is true (as in compressChanges or compressSources, then update classComment to point to the new file." | fileComment | classComment ifNotNil: [aFileStream cr. fileComment _ RemoteString newString: classComment text onFileNumber: fileIndex toFile: aFileStream. moveSource ifTrue: [classComment _ fileComment]]! ! !BasicClassOrganizer methodsFor: 'fileIn/Out' stamp: 'NS 4/7/2004 16:04'! moveChangedCommentToFile: aFileStream numbered: fileIndex "If the comment is in the changes file, then move it to a new file." (classComment ~~ nil and: [classComment sourceFileNumber > 1]) ifTrue: [self fileOutCommentOn: aFileStream moveSource: true toFile: fileIndex]! ! !BasicClassOrganizer methodsFor: 'fileIn/Out' stamp: 'NS 4/7/2004 16:04'! objectForDataStream: refStrm | dp | "I am about to be written on an object file. Write a path to me in the other system instead." self hasSubject ifTrue: [ (refStrm insideASegment and: [self subject isSystemDefined not]) ifTrue: [ ^ self]. "do trace me" (self subject isKindOf: Class) ifTrue: [ dp _ DiskProxy global: self subject name selector: #organization args: #(). refStrm replace: self with: dp. ^ dp]]. ^ self "in desparation" ! ! !BasicClassOrganizer methodsFor: 'fileIn/Out' stamp: 'NS 4/7/2004 16:04'! putCommentOnFile: aFileStream numbered: sourceIndex moveSource: moveSource forClass: aClass "Store the comment about the class onto file, aFileStream." | header | classComment ifNotNil: [aFileStream cr; nextPut: $!!. header _ String streamContents: [:strm | strm nextPutAll: aClass name; nextPutAll: ' commentStamp: '. commentStamp ifNil: [commentStamp _ '']. commentStamp storeOn: strm. strm nextPutAll: ' prior: '; nextPutAll: '0']. aFileStream nextChunkPut: header. aClass organization fileOutCommentOn: aFileStream moveSource: moveSource toFile: sourceIndex. aFileStream cr]! ! !BasicClassOrganizer methodsFor: 'private' stamp: 'NS 4/7/2004 16:04'! setSubject: aClassDescription subject _ aClassDescription! ! !ChangeSet methodsFor: 'change logging' stamp: 'NS 4/12/2004 22:44'! event: anEvent "Hook for SystemChangeNotifier" (anEvent isRemoved and: [anEvent itemKind = SystemChangeNotifier classKind]) ifTrue: [self noteRemovalOf: anEvent item]. (anEvent isAdded and: [anEvent itemKind = SystemChangeNotifier classKind]) ifTrue: [self addClass: anEvent item]. (anEvent isModified and: [anEvent itemKind = SystemChangeNotifier classKind]) ifTrue: [anEvent anyChanges ifTrue: [self changeClass: anEvent item from: anEvent oldItem]]. (anEvent isCommented and: [anEvent itemKind = SystemChangeNotifier classKind]) ifTrue: [self commentClass: anEvent item]. (anEvent isAdded and: [anEvent itemKind = SystemChangeNotifier methodKind]) ifTrue: [self noteNewMethod: anEvent item forClass: anEvent itemClass selector: anEvent itemSelector priorMethod: nil]. (anEvent isModified and: [anEvent itemKind = SystemChangeNotifier methodKind]) ifTrue: [self noteNewMethod: anEvent item forClass: anEvent itemClass selector: anEvent itemSelector priorMethod: anEvent oldItem]. (anEvent isRemoved and: [anEvent itemKind = SystemChangeNotifier methodKind]) ifTrue: [self removeSelector: anEvent itemSelector class: anEvent itemClass priorMethod: anEvent item lastMethodInfo: {anEvent item sourcePointer. anEvent itemProtocol}]. (anEvent isRenamed and: [anEvent itemKind = SystemChangeNotifier classKind]) ifTrue: [self renameClass: anEvent item as: anEvent newName]. (anEvent isReorganized and: [anEvent itemKind = SystemChangeNotifier classKind]) ifTrue: [self reorganizeClass: anEvent item]. (anEvent isRecategorized and: [anEvent itemKind = SystemChangeNotifier methodKind]) ifTrue: [self reorganizeClass: anEvent itemClass].! ! !ClassDescription methodsFor: 'initialize-release' stamp: 'NS 4/6/2004 15:32'! obsolete "Make the receiver obsolete." superclass removeSubclass: self. self organization: nil. super obsolete.! ! !ClassDescription methodsFor: 'initialize-release' stamp: 'NS 4/6/2004 15:31'! superclass: aClass methodDictionary: mDict format: fmt "Basic initialization of the receiver" super superclass: aClass methodDictionary: mDict format: fmt. instanceVariables _ nil. self organization: nil.! ! !ClassDescription methodsFor: 'copying' stamp: 'NS 4/6/2004 15:31'! copyMethodDictionaryFrom: donorClass "Copy the method dictionary of the donor class over to the receiver" methodDict _ donorClass copyOfMethodDictionary. self organization: donorClass organization deepCopy.! ! !ClassDescription methodsFor: 'accessing method dictionary' stamp: 'NS 4/7/2004 13:33'! removeSelector: selector | priorMethod priorProtocol | "Remove the message whose selector is given from the method dictionary of the receiver, if it is there. Answer nil otherwise." priorMethod _ self compiledMethodAt: selector ifAbsent: [^ nil]. priorProtocol _ self whichCategoryIncludesSelector: selector. SystemChangeNotifier uniqueInstance doSilently: [ self organization removeElement: selector]. super removeSelector: selector. SystemChangeNotifier uniqueInstance methodRemoved: priorMethod selector: selector inProtocol: priorProtocol class: self.! ! !ClassDescription methodsFor: 'organization' stamp: 'NS 4/7/2004 13:33'! forgetDoIts "get rid of old DoIt methods and bogus entries in the ClassOrganizer." SystemChangeNotifier uniqueInstance doSilently: [ self organization removeElement: #DoIt; removeElement: #DoItIn:. ]. super forgetDoIts.! ! !ClassDescription methodsFor: 'organization' stamp: 'NS 4/6/2004 15:46'! organization "Answer the instance of ClassOrganizer that represents the organization of the messages of the receiver." organization ifNil: [self organization: (ClassOrganizer defaultList: self methodDict keys asSortedCollection asArray)]. (organization isMemberOf: Array) ifTrue: [self recoverFromMDFaultWithTrace]. "Making sure that subject is set correctly. It should not be necessary." organization ifNotNil: [organization setSubject: self]. ^ organization! ! !ClassDescription methodsFor: 'organization' stamp: 'NS 4/6/2004 15:26'! organization: aClassOrg "Install an instance of ClassOrganizer that represents the organization of the messages of the receiver." aClassOrg ifNotNil: [aClassOrg setSubject: self]. organization _ aClassOrg! ! !ClassDescription methodsFor: 'organization' stamp: 'NS 4/6/2004 15:30'! zapOrganization "Remove the organization of this class by message categories. This is typically done to save space in small systems. Classes and methods created or filed in subsequently will, nonetheless, be organized" self organization: nil. self isMeta ifFalse: [self class zapOrganization]! ! !ClassDescription methodsFor: 'fileIn/Out' stamp: 'NS 4/8/2004 11:35'! classComment: aString stamp: aStamp "Store the comment, aString or Text or RemoteString, associated with the class we are organizing. Empty string gets stored only if had a non-empty one before." | ptr header file oldCommentRemoteStr | (aString isKindOf: RemoteString) ifTrue: [SystemChangeNotifier uniqueInstance classCommented: self. ^ self organization classComment: aString stamp: aStamp]. oldCommentRemoteStr _ self organization commentRemoteStr. (aString size = 0) & (oldCommentRemoteStr == nil) ifTrue: [^ self organization classComment: nil]. "never had a class comment, no need to write empty string out" ptr _ oldCommentRemoteStr ifNil: [0] ifNotNil: [oldCommentRemoteStr sourcePointer]. SourceFiles ifNotNil: [(file _ SourceFiles at: 2) ifNotNil: [file setToEnd; cr; nextPut: $!!. "directly" "Should be saying (file command: 'H3') for HTML, but ignoring it here" header _ String streamContents: [:strm | strm nextPutAll: self name; nextPutAll: ' commentStamp: '. aStamp storeOn: strm. strm nextPutAll: ' prior: '; nextPutAll: ptr printString]. file nextChunkPut: header]]. self organization classComment: (RemoteString newString: aString onFileNumber: 2) stamp: aStamp. SystemChangeNotifier uniqueInstance classCommented: self. ! ! !ClassDescription methodsFor: 'fileIn/Out' stamp: 'NS 4/8/2004 11:32'! putClassCommentToCondensedChangesFile: aFileStream "Called when condensing changes. If the receiver has a class comment, and if that class comment does not reside in the .sources file, then write it to the given filestream, with the resulting RemoteString being reachable from the source file #2. Note that any existing backpointer into the .sources file is lost by this process -- a situation that maybe should be fixed someday." | header aStamp aCommentRemoteStr | self isMeta ifTrue: [^ self]. "bulletproofing only" ((aCommentRemoteStr _ self organization commentRemoteStr) isNil or: [aCommentRemoteStr sourceFileNumber == 1]) ifTrue: [^ self]. aFileStream cr; nextPut: $!!. header _ String streamContents: [:strm | strm nextPutAll: self name; nextPutAll: ' commentStamp: '. (aStamp _ self organization commentStamp ifNil: ['']) storeOn: strm. strm nextPutAll: ' prior: 0']. aFileStream nextChunkPut: header. aFileStream cr. self organization classComment: (RemoteString newString: self organization classComment onFileNumber: 2 toFile: aFileStream) stamp: aStamp! ! !ClassDescription methodsFor: 'fileIn/Out' stamp: 'NS 4/7/2004 23:01'! reorganize "During fileIn, !!Rectangle reorganize!! allows Rectangle to seize control and treat the next chunk as its organization. See the transfer of control where ReadWriteStream fileIn calls scanFrom:" ^self organization! ]style[(10 156 22 38)f1b,f1,f1LReadWriteStream fileIn;,f1! ! !ClassDescription methodsFor: 'deprecated' stamp: 'NS 4/7/2004 13:33'! removeSelectorUnlogged: aSymbol "Remove the message whose selector is aSymbol from the method dictionary of the receiver, if it is there. Answer nil otherwise. Do not log the action either to the current change set or to the changes log" self deprecated: 'Use removeSelectorSilently: instead'. (self methodDict includesKey: aSymbol) ifFalse: [^ nil]. SystemChangeNotifier uniqueInstance doSilently: [ self organization removeElement: aSymbol]. super removeSelector: aSymbol.! ! !Class methodsFor: 'initialize-release' stamp: 'NS 4/6/2004 15:32'! superclass: sup methodDict: md format: ft name: nm organization: org instVarNames: nilOrArray classPool: pool sharedPools: poolSet "Answer an instance of me, a new class, using the arguments of the message as the needed information. Must only be sent to a new instance; else we would need Object flushCache." superclass _ sup. methodDict _ md. format _ ft. name _ nm. instanceVariables _ nilOrArray. classPool _ pool. sharedPools _ poolSet. self organization: org.! ! !Categorizer class methodsFor: 'class initialization' stamp: 'NS 4/5/2004 17:44'! allCategory "Return a symbol that represents the virtual all methods category." ^ '-- all --' asSymbol! ! !Categorizer class methodsFor: 'class initialization' stamp: 'NS 4/5/2004 17:44'! default ^ Default! ! !Categorizer class methodsFor: 'class initialization' stamp: 'NS 4/6/2004 11:48'! initialize " self initialize " Default _ 'as yet unclassified' asSymbol. NullCategory _ 'no messages' asSymbol.! ! !Categorizer class methodsFor: 'class initialization' stamp: 'NS 4/5/2004 17:44'! nullCategory ^ NullCategory! ! !Categorizer class methodsFor: 'instance creation' stamp: 'NS 4/5/2004 17:44'! defaultList: aSortedCollection "Answer an instance of me with initial elements from the argument, aSortedCollection." ^self new setDefaultList: aSortedCollection! ! !Categorizer class methodsFor: 'documentation' stamp: 'NS 4/5/2004 17:44'! documentation "Instances consist of an Array of category names (categoryArray), each of which refers to an Array of elements (elementArray). This association is made through an Array of stop indices (categoryStops), each of which is the index in elementArray of the last element (if any) of the corresponding category. For example: categories _ Array with: 'firstCat' with: 'secondCat' with: 'thirdCat'. stops _ Array with: 1 with: 4 with: 4. elements _ Array with: #a with: #b with: #c with: #d. This means that category firstCat has only #a, secondCat has #b, #c, and #d, and thirdCat has no elements. This means that stops at: stops size must be the same as elements size." ! ! !Categorizer class methodsFor: 'housekeeping' stamp: 'NS 4/6/2004 11:48'! sortAllCategories self allSubInstances do: [:x | x sortCategories]! ! !BasicClassOrganizer class methodsFor: 'instance creation' stamp: 'NS 4/7/2004 16:04'! class: aClassDescription ^ self new setSubject: aClassDescription! ! !BasicClassOrganizer class methodsFor: 'instance creation' stamp: 'NS 4/7/2004 16:04'! class: aClassDescription defaultList: aSortedCollection | inst | inst _ self defaultList: aSortedCollection. inst setSubject: aClassDescription. ^ inst! ! !ClassOrganizer methodsFor: 'temporary' stamp: 'NS 4/6/2004 13:59'! newOrganizer | newOrg | newOrg _ self newOrganizerClass new. newOrg instVarNamed: 'classComment' put: globalComment. newOrg instVarNamed: 'commentStamp' put: commentStamp. newOrg instVarNamed: 'categoryArray' put: categoryArray. newOrg instVarNamed: 'categoryStops' put: categoryStops. newOrg instVarNamed: 'elementArray' put: elementArray. ^ newOrg! ! !ClassOrganizer methodsFor: 'temporary' stamp: 'NS 4/6/2004 13:57'! newOrganizerClass ^ ClassOrganizerNew ! ! !ClassOrganizer methodsFor: 'temporary' stamp: 'NS 4/6/2004 12:41'! subject | subject | subject _ nil. SystemNavigation new allBehaviorsDo: [:each | (each organization == self) ifTrue: [subject _ each]]. ^ subject! ! !ClassOrganizerNew methodsFor: 'private' stamp: 'NS 4/7/2004 10:15'! notifyOfChangedCategoriesFrom: oldCollectionOrNil to: newCollectionOrNil (self hasSubject and: [oldCollectionOrNil ~= newCollectionOrNil]) ifTrue: [SystemChangeNotifier uniqueInstance classReorganized: self subject].! ! !ClassOrganizerNew methodsFor: 'private' stamp: 'NS 4/7/2004 23:02'! notifyOfChangedCategoryFrom: oldNameOrNil to: newNameOrNil (self hasSubject and: [oldNameOrNil ~= newNameOrNil]) ifTrue: [SystemChangeNotifier uniqueInstance classReorganized: self subject].! ! !ClassOrganizerNew methodsFor: 'private' stamp: 'NS 4/7/2004 22:52'! notifyOfChangedSelector: element from: oldCategory to: newCategory (self hasSubject and: [(oldCategory ~= newCategory)]) ifTrue: [ SystemChangeNotifier uniqueInstance selector: element recategorizedFrom: oldCategory to: newCategory inClass: self subject ].! ! !ClassOrganizerNew methodsFor: 'private' stamp: 'NS 4/12/2004 20:56'! notifyOfChangedSelectorsOldDict: oldDictionaryOrNil newDict: newDictionaryOrNil | newCat | (oldDictionaryOrNil isNil and: [newDictionaryOrNil isNil]) ifTrue: [^ self]. oldDictionaryOrNil isNil ifTrue: [ newDictionaryOrNil keysAndValuesDo: [:el :cat | self notifyOfChangedSelector: el from: nil to: cat]. ^ self. ]. newDictionaryOrNil isNil ifTrue: [ oldDictionaryOrNil keysAndValuesDo: [:el :cat | self notifyOfChangedSelector: el from: cat to: nil]. ^ self. ]. oldDictionaryOrNil keysAndValuesDo: [:el :cat | newCat _ newDictionaryOrNil at: el. self notifyOfChangedSelector: el from: cat to: newCat. ].! ! !ClassOrganizerNew methodsFor: 'accessing' stamp: 'NS 4/7/2004 10:37'! addCategory: catString before: nextCategory | oldCategories | oldCategories _ self categories copy. SystemChangeNotifier uniqueInstance doSilently: [ super addCategory: catString before: nextCategory]. self notifyOfChangedCategoriesFrom: oldCategories to: self categories.! ! !ClassOrganizerNew methodsFor: 'accessing' stamp: 'NS 4/15/2004 12:28'! changeFromCategorySpecs: categorySpecs | oldDict oldCategories | oldDict _ self elementCategoryDict. oldCategories _ self categories copy. SystemChangeNotifier uniqueInstance doSilently: [ super changeFromCategorySpecs: categorySpecs]. self notifyOfChangedSelectorsOldDict: oldDict newDict: self elementCategoryDict. self notifyOfChangedCategoriesFrom: oldCategories to: self categories.! ! !ClassOrganizerNew methodsFor: 'accessing' stamp: 'NS 4/7/2004 10:37'! classify: element under: heading suppressIfDefault: aBoolean | oldCat newCat | oldCat _ self categoryOfElement: element. SystemChangeNotifier uniqueInstance doSilently: [ super classify: element under: heading suppressIfDefault: aBoolean]. newCat _ self categoryOfElement: element. self notifyOfChangedSelector: element from: oldCat to: newCat.! ! !ClassOrganizerNew methodsFor: 'accessing' stamp: 'NS 4/7/2004 10:37'! removeCategory: cat | oldCategories | oldCategories _ self categories copy. SystemChangeNotifier uniqueInstance doSilently: [ super removeCategory: cat]. self notifyOfChangedCategoriesFrom: oldCategories to: self categories.! ! !ClassOrganizerNew methodsFor: 'accessing' stamp: 'NS 4/7/2004 10:37'! removeElement: element | oldCat | oldCat _ self categoryOfElement: element. SystemChangeNotifier uniqueInstance doSilently: [ super removeElement: element]. self notifyOfChangedSelector: element from: oldCat to: (self categoryOfElement: element).! ! !ClassOrganizerNew methodsFor: 'accessing' stamp: 'NS 4/7/2004 10:38'! removeEmptyCategories | oldCategories | oldCategories _ self categories copy. SystemChangeNotifier uniqueInstance doSilently: [ super removeEmptyCategories]. self notifyOfChangedCategoriesFrom: oldCategories to: self categories.! ! !ClassOrganizerNew methodsFor: 'accessing' stamp: 'NS 4/7/2004 10:38'! renameCategory: oldCatString toBe: newCatString | oldCat newCat oldElementsBefore oldElementsAfter | oldCat _ oldCatString asSymbol. newCat _ newCatString asSymbol. oldElementsBefore _ self listAtCategoryNamed: oldCat. SystemChangeNotifier uniqueInstance doSilently: [ super renameCategory: oldCatString toBe: newCatString]. oldElementsAfter _ (self listAtCategoryNamed: oldCat) asSet. oldElementsBefore do: [:each | (oldElementsAfter includes: each) ifFalse: [self notifyOfChangedSelector: each from: oldCat to: newCat]. ]. self notifyOfChangedCategoryFrom: oldCat to: newCat.! ! !ClassOrganizerNew methodsFor: 'accessing' stamp: 'NS 4/12/2004 20:57'! setDefaultList: aSortedCollection | oldDict oldCategories | oldDict _ self elementCategoryDict. oldCategories _ self categories copy. SystemChangeNotifier uniqueInstance doSilently: [ super setDefaultList: aSortedCollection]. self notifyOfChangedSelectorsOldDict: oldDict newDict: self elementCategoryDict. self notifyOfChangedCategoriesFrom: oldCategories to: self categories.! ! !ClassOrganizerNew methodsFor: 'accessing' stamp: 'NS 4/7/2004 10:38'! sortCategories | oldCategories | oldCategories _ self categories copy. SystemChangeNotifier uniqueInstance doSilently: [ super sortCategories]. self notifyOfChangedCategoriesFrom: oldCategories to: self categories.! ! !PseudoClass methodsFor: 'accessing' stamp: 'NS 4/6/2004 15:46'! organization organization ifNil: [organization _ PseudoClassOrganizer defaultList: SortedCollection new]. "Making sure that subject is set correctly. It should not be necessary." organization setSubject: self. ^ organization! ! !PseudoClassOrganizer methodsFor: 'temporary' stamp: 'NS 4/6/2004 13:59'! newOrganizerClass ^ PseudoClassOrganizerNew ! ! !PseudoClassOrganizerNew methodsFor: 'comment accessing' stamp: 'NS 4/6/2004 16:44'! classComment "Answer the comment associated with the object that refers to the receiver." classComment == nil ifTrue: [^'']. ^classComment! ! !PseudoClassOrganizerNew methodsFor: 'comment accessing' stamp: 'NS 4/6/2004 16:44'! classComment: aChangeRecord classComment := aChangeRecord! ! !PseudoClassOrganizerNew methodsFor: 'accessing' stamp: 'NS 4/6/2004 12:27'! setDefaultList: aCollection super setDefaultList: aCollection. self classComment: nil.! ! !SystemChangeNotifier methodsFor: 'system triggers' stamp: 'NS 4/7/2004 13:35'! selector: selector recategorizedFrom: oldCategory to: newCategory inClass: aClass self trigger: (RecategorizedEvent method: (aClass compiledMethodAt: selector ifAbsent: [nil]) protocol: newCategory class: aClass oldProtocol: oldCategory)! ! !Utilities class methodsFor: 'recent method submissions' stamp: 'NS 4/12/2004 22:47'! event: anEvent "Hook for SystemChangeNotifier" (anEvent isCommented and: [anEvent itemKind = SystemChangeNotifier classKind]) ifTrue: [self noteMethodSubmission: #Comment forClass: anEvent item]. ((anEvent isAdded or: [anEvent isModified]) and: [anEvent itemKind = SystemChangeNotifier methodKind]) ifTrue: [anEvent itemRequestor ifNotNil: [self noteMethodSubmission: anEvent itemSelector forClass: anEvent itemClass]]. ((anEvent isAdded or: [anEvent isModified]) and: [anEvent itemKind = SystemChangeNotifier methodKind]) ifTrue:[ InMidstOfFileinNotification signal ifFalse: [Utilities changed: #recentMethodSubmissions]. ].! ! Categorizer subclass: #SystemOrganizer instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'System-Support'! !PseudoClassOrganizerNew reorganize! ('comment accessing' classComment classComment:) ('accessing' setDefaultList:) ! !ClassOrganizerNew reorganize! ('private' notifyOfChangedCategoriesFrom:to: notifyOfChangedCategoryFrom:to: notifyOfChangedSelector:from:to: notifyOfChangedSelectorsOldDict:newDict:) ('accessing' addCategory:before: changeFromCategorySpecs: classify:under:suppressIfDefault: removeCategory: removeElement: removeEmptyCategories renameCategory:toBe: setDefaultList: sortCategories) ! !ClassOrganizer reorganize! ('accessing' categories categories: categoryOfElement: changeFromCategorySpecs: changeFromString: classComment classComment: classComment:stamp: commentRemoteStr commentStamp commentStamp: dateCommentLastSubmitted hasNoComment listAtCategoryNamed: listAtCategoryNumber: numberOfCategoryOfElement: removeCategory: removeElement: removeEmptyCategories sortCategories) ('compiler access' classify:under: classifyAll:under:) ('method dictionary' addCategory: addCategory:before: allMethodSelectors classify:under:suppressIfDefault: renameCategory:toBe:) ('printing' printOn: printOnStream:) ('fileIn/Out' fileOutCommentOn:moveSource:toFile: moveChangedCommentToFile:numbered: objectForDataStream: putCommentOnFile:numbered:moveSource:forClass: scanFrom:) ('private' elementArray ifClassOrganizerDo: setDefaultList:) ('temporary' newOrganizer newOrganizerClass setSubject: subject) ! Categorizer initialize! Class removeSelector: #noteCompilationOf:meta:! "Postscript:" | oldOrg old new refs | "Replacing instances of PseudoClassOrganizer" PseudoClass allSubInstancesDo: [:each | oldOrg _ each organization. oldOrg ifNotNil: [each organization: oldOrg newOrganizer]. ]. "Replacing instances of ClassOrganizer" ClassDescription allSubInstancesDo: [:each | oldOrg _ each organization. oldOrg ifNotNil: [each organization: oldOrg newOrganizer]. ]. "Replacing the class PseudoClassOrganizer" old _ PseudoClassOrganizer. new _ PseudoClassOrganizerNew. refs _ old allCallsOn. old removeFromSystem. new rename: 'PseudoClassOrganizer'. refs do: [:each | each actualClass recompile: each methodSymbol ]. "Replacing the class ClassOrganizer" old _ ClassOrganizer. new _ ClassOrganizerNew. refs _ old allCallsOn. old removeFromSystem. new rename: 'ClassOrganizer'. refs do: [:each | each actualClass recompile: each methodSymbol ]. Smalltalk garbageCollect.!