c30943@tansei.cc.u-tokyo.ac.jp (max ott) (03/21/90)
One day I got frustrated scrolling through classes with millions of methods especially when debugging methods aaa: and zzz:. Then I heard about categories and protocols in the browser of the big brother and started to add some kind of grouping at least within a class. I also added a few methods to keep track of what classes or methods I add or change. We are working on two different locations on a single project. A single file containing all the changes can also be used as "substitute" for a documentation. There is now also a way to store a docu string for each variable and the class itself. Anyone wants to type in the appendix of the manual? If you find any bugs or if you add some gadgets, please let me know. -max ------------------------------------------------------------------------------ Max Ott e-mail: Hatori Laboratory ott%piyopiyo.hatori.t.u-tokyo.ac.jp Dept. of E.E.; U of Tokyo I am not a tourist, I live here, but +(81)-(03) 812 2111 Ext. 6761 would not mind being one. #--------------------------------CUT HERE------------------------------------- #! /bin/sh # # This is a shell archive. Save this into a file, edit it # and delete all lines above this comment. Then give this # file to sh by executing the command "sh file". The files # will be extracted into the current directory owned by # you with default permissions. # # The files contained herein are: # # -rw-r--r-- 1 ott 3619 Mar 21 15:53 README # -rw-rw-rw- 1 ott 13455 Mar 21 15:52 catinit.cls # echo 'x - README' if test -f README; then echo 'shar: not overwriting README'; else sed 's/^X//' << '________This_Is_The_END________' > README X XThe accompanying 2 files X X -rw-rw-rw- 1 ott 13455 Mar 21 15:52 catinit.cls X -rw-rw-rw- 1 ott 48521 Mar 21 15:52 prjct_br.cls X Xinclude code for a simple project browser. It is actually a enhanced Xversion of the class hierarchy browser. It makes it possible to group Xmethods of a class into categories. It further keeps track of Xclasses newly created and methods changed. One can then file out all Xthe changes onto a single file. X XThere doesn't exist any documentation beside the code and a terse Xexplanation with the variables. When you have started the browser get Xthe menu in the text pane when it shows the class header ( ... Xsubclass: ... instanceVar...). The menu is different to the usual one, Xjust click on Documentation and you get a browser on the comments for Xthe class and the variables. But they entire browser is very similar Xto the class hierarchy browser, so just explore and enjoy (hopefully). XDon't forget there is also a topPane menu. X XWARNING: X======== X XBefore you install this program, check out the file catInit.cls. This Xfile contains most of the changes to the standard classes. There might Xbe a few you will not like. Or you added some yourself with the same Xname. I have a strange habbit of marking those methods with my name to Xlater distinguish them from digitalk's program. So they don't get all Xthe blame. X XInstallation: X============= X XFirst read in prjct_br.cls. If this file is in your default directory, Xjust execute the 2 lines at the beginning of this file. X X!!! WARNING catinit.cls makes some changes to the existing classes X Behavior, Dictionary and Pane. You better check the code, if X you can live with the changes. X XThe actual browser is in the second file prjctbrw.cls. As before, just Xexecute the code at the beginning of the file. Below the loading code, Xyou'll find one line of code to test the stuff. First you will be Xprompted for a project name. Type in something, and after the return, Xsomething similar to the class hierarchy browser will pop up. The Xdifferences are the project name in the top label, the top middle pane Xfor the category name and a small pane under the class pane, showing Xthe category of the currently in the text pane displayed method. X XThere are not too many changes, so play around and check out the Xmenus. There is also a different top menu. You might also want to Xcheck out the history command in the method pane. Before you do so Xlook at a few method ( you need a history). X XIn prjctbrw.cls you'll also find code to install this application as Xthe default in the system menu for <browse classes> X XBUGS X==== X XNo, no, they are features. Actually there should be quite a few. I Xdidn't test it too long on an original image, so I might have forgotten Xto add a few methods. The code itself was "developed(???)" on the fly, Xso who knows. X XJust eval >ProjectClassHBrowser bugs<, you should get a string Xdescribing some of the problems. I always remember them when I sit in Xthe cafeteria and forget most of them by the time I return to the Xterminal. X XPlease let me know of bugs, improvements, new fancy gadgets, ... X XToDo X==== X XHeaps.. XThe class project browser doesn't really deserve its name yet. Need a Xway to remove projects, remove methods from a project, a editable Xheader should be filed out with any project. ..... X X------------------------------------------------------------------------------ XMax Ott e-mail: XHatori Laboratory ott%piyopiyo.hatori.t.u-tokyo.ac.jp XDept. of E.E.; U of Tokyo I am not a tourist, I live here, but X+(81)-(03) 812 2111 Ext. 6761 would not mind being one. ________This_Is_The_END________ if test `wc -c < README` -ne 3619; then echo 'shar: README was damaged during transit (should have been 3619 bytes)' fi fi ; : end of overwriting check echo 'x - catinit.cls' if test -f catinit.cls; then echo 'shar: not overwriting catinit.cls'; else sed 's/^X//' << '________This_Is_The_END________' > catinit.cls X" X* ProjectClassHBrowser X* Copyright (c) 1990 X* By Max Ott (ott%piyopiyo.hatori.t.u-tokyo.ac.jp) X* All rights reserved. X* X* This program is provided for UNRESTRICTED use provided that this X* copyright message is preserved on all copies and derivative works. X* This is provided without any warranty. No author or distributor X* accepts any responsibility whatsoever to any person or any entity X* with respect to any loss or damage caused or alleged to be caused X* directly or indirectly by this program. This includes, but is not X* limited to, any interruption of service, loss of business, loss of X* information, loss of anticipated profits, core dumps, abuses of the X* virtual memory system, or any consequential or incidental damages X* resulting from the use of this program. X* X**************************** X* X* Project: categorized class browser X* X X (Disk file: 'catInit.cls') fileIn; close. X X" X XSmalltalk at: #GlobalCategoryDictionary put: Dictionary new.! X XClassReader subclass: #CategoryClassReader X instanceVariableNames: X 'category ' X classVariableNames: '' X poolDictionaries: '' ! X X!Behavior methods! X XaddSelector: aSelector category: aCategory X "add a selector to aCategory. Store this association X in GlobalCategoryDictionary. As this is also used to X file in new methods, better make sure that aSelector X is not stored under a different category. X!!!!!! max." X | categories | X categories := self allCategories. X categories do: [ :cat | X cat remove: aSelector ifAbsent: [ nil ] X ]. X ( categories at: aCategory X ifAbsent: [ categories at: aCategory put: Set new ]) X add: aSelector. ! X XallCategories X "Return a dictionary with all the categories as keys. X Each corresponding value contains a set of all X the methods in this category. X I used the basicHash as identifier for the class. X I am not sure but storing self will put an instance X into the global dictionary. It will then be impossible X to add new instance variables to a method. This is X at least the way I think this variable adding business X works. X Plain hash does not work as it uses the hash of the name X which is not exclusive. X If you change to another form of key, also change X removeAllCategories. (should have its own method, though) X!!!!!! max" X | categories | X categories := GlobalCategoryDictionary at: self basicHash X ifAbsent: [ nil ]. X categories isNil X ifTrue: [ X "put every method in default category" X categories := Dictionary new. X self selectors size = 0 X ifFalse: [ "there is something to put" X categories at: #etc put: self selectors X ]. X GlobalCategoryDictionary at: self basicHash X put: categories. X ]. X ^categories! X Xcategory: aSelector X "returns the category for aSelector. If X none is found return nil. X!!!!!! max" X | classDict answer | X classDict := self allCategories. X answer := ( classDict select: [ :aSet | X aSet includes: aSelector ]) keys. X answer size = 0 ifTrue: [ ^nil ]. X answer size = 1 ifTrue: [ ^answer asArray at: 1 ]. X self error: aSelector print, ' is stored under 2 different categories.'! X XcategoryFor: aSelector X "return the category of aSelector. X!!!!!! max" X self allCategories keysValuesDo: [ :aCategory :aSet | X ( aSet detect: [ :sample | sample = aSelector ] X ifNone: [ nil ]) X isNil X ifFalse: [ ^aCategory ] X ]. X self error: 'no category found for <', X aSelector printString, '>'! X XchangeCategoryFor: aSelector X from: currentCategory X to: newCategory X "change the category of aSelector to newCategory. X Don't check if everything is around. X!!!!!! max" X | categories | X categories := self allCategories. X ( categories at: currentCategory) remove: aSelector. X ( categories at: newCategory) add: aSelector.! X Xcompile: codeString category: aCategory X "Compile the Smalltalk method contained in codeString. X The class to use for resolving variables is the receiver. X If there are no errors, add the method to the receiver X messageDictionary and also store the category. Further X answer the Association with the X message selector as the key and the compiled method X as the value. If there is an error, answer nil. X!!!! max" X | answer | X answer := Compiler X compile: codeString X in: self. X answer notNil X ifTrue: [ X self X addSelector: answer key category: aCategory; X addSelector: answer key withMethod: answer value X ]. X ^answer! X X XmethodsInCategory: aCategory X "Answer an instance of ClassReader X initialized for the receiver. X!!!!!! max" X ^CategoryClassReader forClass: self category: aCategory asSymbol! X XmethodsOrig X "Answer an instance of ClassReader X initialized for the receiver." X ^ClassReader forClass: self! X XremoveAllCategories X "remove all categories for this class. Remove it from X GlobalCategoryDictionary. This will be called X when class is removed. X!!!!!! max" X GlobalCategoryDictionary X removeKey: self basicHash X ifAbsent: [ nil ]! X XremoveCategory: aSymbol X "remove a category from this class. Remove it from X GlobalCategoryDictionary. X!!!!!! max" X self allCategories removeKey: aSymbol! X XremoveSelector: aSelector category: aCategory X "remove a selector from aCategory. Remove this association X in GlobalCategoryDictionary. X!!!!!! max." X | categories | X categories := self allCategories. X ( categories at: aCategory) remove: aSelector.! X XrenameCategoryFrom: oldCategory to: newCategory X "rename category oldCategory to newCategory. Change it in X GlobalCategoryDictionary. X!!!!!! max" X | classDict | X classDict := self allCategories. X classDict at: newCategory X put: ( classDict at: oldCategory). X classDict removeKey: oldCategory! X XselectorsForCategory: aCategory X "Answer a Set of symbols of the names X of the methods defined by the receiver X which are in category aCategory. X!!!!!! max" X ^self allCategories at: aCategory! ! X X XClassReader subclass: #CategoryClassReader X instanceVariableNames: X 'category ' X classVariableNames: '' X poolDictionaries: '' ! X X!CategoryClassReader methods! X XfileInFrom: aStream X "Read chunks from aStream until an empty chunk X (a single '!!') is found. Compile each chunk X as a method for the class described by the X receiver. Log the source code of the method X to the change log." X | aString result stream | X stream := Sources at: 2. X stream setToEnd. X self instanceHeaderOn: stream category: category. X [(aString := aStream nextChunk zapCrs) isEmpty] X whileFalse:[ X result := class compile: aString category: category. X result notNil X ifTrue: [result value sourceString: aString]]. X stream X nextChunkPut: ''; X flush! ! X X!CategoryClassReader class methods! X XforClass: aClass category: aCategory X "Answer an instance of the X receiver for aClass." X ^self new X setClass: aClass; X setCategory: aCategory.! ! X X X!CategoryClassReader methods! X XfileInFrom: aStream X "Read chunks from aStream until an empty chunk X (a single '!!') is found. Compile each chunk X as a method for the class described by the X receiver. Log the source code of the method X to the change log." X | aString result stream | X stream := Sources at: 2. X stream setToEnd. X self instanceHeaderOn: stream category: category. X [(aString := aStream nextChunk zapCrs) isEmpty] X whileFalse:[ X result := class compile: aString category: category. X result notNil X ifTrue: [result value sourceString: aString]]. X stream X nextChunkPut: ''; X flush! X XfileOutOnWithCategories: aStream X "File out all the methods for the class described X by the receiver to aStream, in chunk format. X Also add category names. X!!!!!! don't forget to add Dictionary's keysValuesDo: " X class allCategories keysValuesDo: [ :category :selectors | X aStream cr. X self instanceHeaderOn: aStream category: category. X selectors asSortedCollection do: [ :selector | X aStream X cr; X nextChunkPut: (class sourceCodeAt: selector) X ]. X aStream nextChunkPut: ''; cr X ].! X XfileOutOnWithCategories: aStream selection: aSet X "File out all the methods mentioned in aSet X for the class described X by the receiver to aStream, in chunk format. X Also add category names. X!!!!!! don't forget to add Dictionary's keysValuesDo: " X ( self sortIntoCategories: aSet) X keysValuesDo: [ :category :selectors | X aStream cr. X self instanceHeaderOn: aStream category: category. X selectors asSortedCollection do: [ :selector | X aStream X cr; X nextChunkPut: (class sourceCodeAt: selector) X ]. X aStream nextChunkPut: ''; cr X ].! X XinstanceHeaderOn: aStream category: aCategory X "Private - Write a header to aStream which identifies X the class described by the receiver. The header X precedes the source code for the methods. X Add category too." X aStream X cr; X nextPut: $!!; X nextPutAll: class name; X space; X nextPutAll: 'methodsInCategory: '; X nextPutAll: aCategory asString printString; X nextPut: $!!! X XsortIntoCategories: aSet X "private - put all the methods in aSet into X a dictionary where the key is the category X and the value is a set containing all the methods X belonging to the same category." X | dictionary category | X dictionary := Dictionary new. X aSet do: [ :aSelector | X category := class categoryFor: aSelector. X dictionary at: category X ifAbsent: [ dictionary at: category put: Set new ]. X ( dictionary at: category) add: aSelector. X ]. X ^dictionary! X XsetCategory: aCategory X "Private - Set the category of the next read methods." X category := aCategory. X ^self! ! X X!Behavior methods ! X Xmethods X "Answer an instance of ClassReader X initialized for the receiver. X This is an old script with no category, X so we better put it in one. X!!!!!! max" X ^CategoryClassReader forClass: self category: #etc! X XcheckCategories X "Just to be sure. Check stored categories for double entries X or selectors without categories. X In case of a double entry, keep one and throw away the rest. X Very simple. Too simple? Should not happen anyway. X In case of no category, create xERRORx category and throw X it in there. In this case update the category pane. X Return set containing all the lost children." X | set errorSet | X set := Set new. X self allCategories keysValuesDo: [ :cat :selectors | X selectors do: [ :method | X (set includes: method) X ifTrue: [ "double entry; remove this one" X selectors remove: method. X Terminal bell X ] X ifFalse: [ "first time; store it" X set add: method X ] X ] X ]. X errorSet := Set new. X self selectors do: [ :method | X (set includes: method) X ifFalse: [ "this method has no category" X errorSet add: method X ] X ]. X ^errorSet! X Xcomment X "return comment X!!!!!! max" X ^comment! X Xcomment: anObject X "store anObject as comment X!!!!!! max" X ^comment := anObject! X XmethodsOrig X "Answer an instance of ClassReader X initialized for the receiver." X ^ClassReader forClass: self! ! X X!Dictionary methods ! X XkeysValuesDo: aBlock X "Answer the receiver. For each key X in the receiver, evaluate aBlock with X the key and the value as the arguments." X self associationsDo: [ :anAssociation | X aBlock value: anAssociation key value: anAssociation value]! ! X X!Pane methods ! X XpopUp: aMenu at: aPoint X "Display aMenu at aPoint. If the user X choice is nil, do nothing. If the model X can respond to the choice, let it perform X the choice. Else, let the dispatcher perform it. X!!max return immediatly if aMenu is nil. ( model X doesn't want it.) X deactivate pane before calling menu." X | aSymbol | X aMenu isNil X ifTrue: [ ^self ]. X self hasZoomedPane "deactivating zoomed pane causes dezooming" X ifFalse: [ self deactivatePane ]. X aSymbol := aMenu popUpAt: aPoint. X self hasZoomedPane X ifFalse: [ self activatePane ]. X aSymbol isNil X ifFalse: [ X (model respondsTo: aSymbol) X ifTrue: [model perform: aSymbol] X ifFalse:[dispatcher perform: aSymbol]] ! ! X ________This_Is_The_END________ if test `wc -c < catinit.cls` -ne 13455; then echo 'shar: catinit.cls was damaged during transit (should have been 13455 bytes)' fi fi ; : end of overwriting check exit 0